nl.nikhef.pdp.fetchcrl/trunk/FCLog.pm

#
# @(#)$Id$
#
# ###########################################################################
#
# Fetch-CRL3 logging support
package FCLog;
use Sys::Syslog;

# Syntax:
#   $log = CL->new( [outputmode=qualified,cache,direct,syslog] )
#   $log->destadd( destination [,facility] )
#   $log->destremove ( destination )
#   $log->setverbose( level )
#   $log->setdebug( level )
#   $log->setwarnings( 0|1 )
#   $log->debug( level, message ...)
#   $log->verb( level, message ...)
#   $log->warn( level, message ...)
#   $log->err( level, message ...)
#   $log->clear( )
#   $log->flush( )
#   $log->exitstatus( )
#
sub new { 
  my $self = shift;
  my $obref = {}; bless $obref;
  $obref->{"debug"} = 0;
  $obref->{"verbose"} = 0;
  $obref->{"messagecache"} = ();
  $obref->{"warnings"} = 1;
  $obref->{"errors"} = 1;
  $obref->{"warncount"} = 0;
  $obref->{"errorcount"} = 0;
  $obref->{"syslogfacility"} = "daemon";

  while ( my $mode = shift ) {
    $obref->destadd($mode);
  }

  return $obref;
}

sub destadd { 
  my $self = shift;
  my $mode = shift;
  my $facility = (shift or $self->{"syslogfacility"});

  return 0 unless defined $mode;

  $self->{"logmode"}{$mode} = 1;
  if ( $mode eq "syslog" ) {
    my $progname = $0;
    $progname =~ s/^.*\///;
    $self->{"syslogfacility"} = $facility;
    openlog($progname,"nowait,pid", $facility);
  }
  return 1;
}

sub destremove {
  my $self = shift;
  my $ok = 1;

  my $mode = shift;
  $self->{"logmode"} = {} and return 1 if (defined $mode and $mode eq "all");
  unshift @_,$mode;

  while ( my $mode = shift ) {
    if ( defined $self->{"logmode"}{$mode} ) {
      closelog() if $mode eq "syslog";
      delete $self->{"logmode"}{$mode};
    } else {
      $ok=0;
    }
  }
  return $ok;
}

sub setverbose {
  my ($self,$level) = @_;
  my $oldlevel = $self->{"verbose"};
  $self->{"verbose"} = 0+$level;
  return $oldlevel;
}

sub getverbose {
  my ($self) = @_;
  return $self->{"verbose"};
}

sub setdebug {
  my ($self,$level) = @_;
  my $oldlevel = $self->{"debug"};
  $self->{"debug"} = $level;
  return $oldlevel;
}

sub getdebug {
  my ($self) = @_;
  return $self->{"debug"};
}

sub setwarnings {
  my ($self,$level) = @_;
  my $oldlevel = $self->{"warnings"};
  $self->{"warnings"} = $level;
  return $oldlevel;
}

sub getwarnings {
  my ($self) = @_;
  return $self->{"warnings"};
}

sub geterrors {
  my ($self) = @_;
  return $self->{"errors"};
}

sub seterrors {
  my ($self,$level) = @_;
  my $oldlevel = $self->{"errors"};
  $self->{"errors"} = $level;
  return $oldlevel;
}

sub verb($$$) {
  my $self = shift;
  my $level = shift;
  return 1 unless ( $level <= $self->{"verbose"} );
  my $message = "@_";
  $self->output("VERBOSE($level)",$message);
  return 1;
}

sub debug($$$) {
  my $self = shift;
  my $level = shift;
  return 1 unless ( $level <= $self->{"debug"} );
  my $message = "@_";
  $self->output("DEBUG($level)",$message);
  return 1;
}

sub warn($@) {
  my $self = shift;
  return 1 unless ( $self->{"warnings"} );
  $self->{"warningcount"}++;
  my $message = "@_";
  $self->output("WARN",$message);
  return 1;
}

sub err($@) {
  my $self = shift;
  my $message = "@_";
  return 1 unless ( $self->{"errors"} );
  $self->output("ERROR",$message);
  $self->{"errorcount"}++;
  return 1;
}

sub output($$@) {
  my ($self,$label,@message) = @_;
  return 0 unless defined $label and @message;

  my $message = join " ",@message;

  print "" . ($label?"$label ":"") . "$message\n"
    if ( defined $self->{"logmode"}{"qualified"} );
  push @{$self->{"messagecache"}},"" . ($label?"$label ":"") . "$message\n"
    if ( defined $self->{"logmode"}{"cache"} );
  print "$message\n"
    if ( defined $self->{"logmode"}{"direct"} );

  if ( defined $self->{"logmode"}{"syslog"} ) {
    my $severity = "LOG_INFO";
    $severity = "LOG_NOTICE" if $label eq "WARN";
    $severity = "LOG_ERR" if $label eq "ERROR";
    $severity = "LOG_DEBUG" if $label =~ /^VERBOSE/;
    $severity = "LOG_DEBUG" if $label =~ /^DEBUG/;
    syslog($severity, "%s", $message);
  }

  return 1;
}

sub clear($) {
  my $self = shift;

  $self->{"messagecache"} = ();
  return 1;
}

sub flush($) {
  my $self = shift;

  foreach my $s ( @{$self->{"messagecache"}} ) {
    print $s;
  }
  $self->{"messagecache"} = ();

  $self->{"errorcount"} and $self->{"errors"} and return 0;
  $self->{"warningcount"} and $self->{"warnings"} and return 1;
  return 1;
}

sub cleanse($) {
  my $self = shift;
  $self->{"messagecache"} = ();
  $self->{"errorcount"} = 0;
  $self->{"warningcount"} = 0;
  $self->{"logmode"} = {};
  return 1;
}


sub exitstatus($) {
  my $self = shift;

  $self->{"errorcount"} and $self->{"errors"} and return 1;
  return 0;
}

1;
1	davidg	1758	#
2			# @(#)$Id$
3			#
4			# ###########################################################################
5			#
6			# Fetch-CRL3 logging support
7			package FCLog;
8			use Sys::Syslog;
9
10			# Syntax:
11			# $log = CL->new( [outputmode=qualified,cache,direct,syslog] )
12			# $log->destadd( destination [,facility] )
13			# $log->destremove ( destination )
14			# $log->setverbose( level )
15			# $log->setdebug( level )
16			# $log->setwarnings( 0\|1 )
17			# $log->debug( level, message ...)
18			# $log->verb( level, message ...)
19			# $log->warn( level, message ...)
20			# $log->err( level, message ...)
21			# $log->clear( )
22			# $log->flush( )
23			# $log->exitstatus( )
24			#
25			sub new {
26			my $self = shift;
27			my $obref = {}; bless $obref;
28			$obref->{"debug"} = 0;
29			$obref->{"verbose"} = 0;
30			$obref->{"messagecache"} = ();
31			$obref->{"warnings"} = 1;
32			$obref->{"errors"} = 1;
33			$obref->{"warncount"} = 0;
34			$obref->{"errorcount"} = 0;
35			$obref->{"syslogfacility"} = "daemon";
36
37			while ( my $mode = shift ) {
38			$obref->destadd($mode);
39			}
40
41			return $obref;
42			}
43
44			sub destadd {
45			my $self = shift;
46			my $mode = shift;
47			my $facility = (shift or $self->{"syslogfacility"});
48
49			return 0 unless defined $mode;
50
51			$self->{"logmode"}{$mode} = 1;
52			if ( $mode eq "syslog" ) {
53			my $progname = $0;
54			$progname =~ s/^.*\///;
55			$self->{"syslogfacility"} = $facility;
56			openlog($progname,"nowait,pid", $facility);
57			}
58			return 1;
59			}
60
61			sub destremove {
62			my $self = shift;
63			my $ok = 1;
64
65			my $mode = shift;
66			$self->{"logmode"} = {} and return 1 if (defined $mode and $mode eq "all");
67			unshift @_,$mode;
68
69			while ( my $mode = shift ) {
70			if ( defined $self->{"logmode"}{$mode} ) {
71			closelog() if $mode eq "syslog";
72			delete $self->{"logmode"}{$mode};
73			} else {
74			$ok=0;
75			}
76			}
77			return $ok;
78			}
79
80			sub setverbose {
81			my ($self,$level) = @_;
82			my $oldlevel = $self->{"verbose"};
83			$self->{"verbose"} = 0+$level;
84			return $oldlevel;
85			}
86
87			sub getverbose {
88			my ($self) = @_;
89			return $self->{"verbose"};
90			}
91
92			sub setdebug {
93			my ($self,$level) = @_;
94			my $oldlevel = $self->{"debug"};
95			$self->{"debug"} = $level;
96			return $oldlevel;
97			}
98
99			sub getdebug {
100			my ($self) = @_;
101			return $self->{"debug"};
102			}
103
104			sub setwarnings {
105			my ($self,$level) = @_;
106			my $oldlevel = $self->{"warnings"};
107			$self->{"warnings"} = $level;
108			return $oldlevel;
109			}
110
111			sub getwarnings {
112			my ($self) = @_;
113			return $self->{"warnings"};
114			}
115
116			sub geterrors {
117			my ($self) = @_;
118			return $self->{"errors"};
119			}
120
121			sub seterrors {
122			my ($self,$level) = @_;
123			my $oldlevel = $self->{"errors"};
124			$self->{"errors"} = $level;
125			return $oldlevel;
126			}
127
128			sub verb($$$) {
129			my $self = shift;
130			my $level = shift;
131			return 1 unless ( $level <= $self->{"verbose"} );
132			my $message = "@_";
133			$self->output("VERBOSE($level)",$message);
134			return 1;
135			}
136
137			sub debug($$$) {
138			my $self = shift;
139			my $level = shift;
140			return 1 unless ( $level <= $self->{"debug"} );
141			my $message = "@_";
142			$self->output("DEBUG($level)",$message);
143			return 1;
144			}
145
146			sub warn($@) {
147			my $self = shift;
148			return 1 unless ( $self->{"warnings"} );
149			$self->{"warningcount"}++;
150			my $message = "@_";
151			$self->output("WARN",$message);
152			return 1;
153			}
154
155			sub err($@) {
156			my $self = shift;
157			my $message = "@_";
158			return 1 unless ( $self->{"errors"} );
159			$self->output("ERROR",$message);
160			$self->{"errorcount"}++;
161			return 1;
162			}
163
164			sub output($$@) {
165			my ($self,$label,@message) = @_;
166			return 0 unless defined $label and @message;
167
168			my $message = join " ",@message;
169
170			print "" . ($label?"$label ":"") . "$message\n"
171			if ( defined $self->{"logmode"}{"qualified"} );
172			push @{$self->{"messagecache"}},"" . ($label?"$label ":"") . "$message\n"
173			if ( defined $self->{"logmode"}{"cache"} );
174			print "$message\n"
175			if ( defined $self->{"logmode"}{"direct"} );
176
177			if ( defined $self->{"logmode"}{"syslog"} ) {
178			my $severity = "LOG_INFO";
179			$severity = "LOG_NOTICE" if $label eq "WARN";
180			$severity = "LOG_ERR" if $label eq "ERROR";
181			$severity = "LOG_DEBUG" if $label =~ /^VERBOSE/;
182			$severity = "LOG_DEBUG" if $label =~ /^DEBUG/;
183			syslog($severity, "%s", $message);
184			}
185
186			return 1;
187			}
188
189			sub clear($) {
190			my $self = shift;
191
192			$self->{"messagecache"} = ();
193			return 1;
194			}
195
196			sub flush($) {
197			my $self = shift;
198
199			foreach my $s ( @{$self->{"messagecache"}} ) {
200			print $s;
201			}
202			$self->{"messagecache"} = ();
203
204			$self->{"errorcount"} and $self->{"errors"} and return 0;
205			$self->{"warningcount"} and $self->{"warnings"} and return 1;
206			return 1;
207			}
208
209			sub cleanse($) {
210			my $self = shift;
211			$self->{"messagecache"} = ();
212			$self->{"errorcount"} = 0;
213			$self->{"warningcount"} = 0;
214			$self->{"logmode"} = {};
215			return 1;
216			}
217
218
219			sub exitstatus($) {
220			my $self = shift;
221
222			$self->{"errorcount"} and $self->{"errors"} and return 1;
223			return 0;
224			}
225
226			1;
grid.support@nikhef.nl	ViewVC Help
Powered by ViewVC 1.1.28