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->{"rcmode"} = "normal";
  $obref->{"warncount"} = 0;
  $obref->{"errorcount"} = 0;
  $obref->{"retrerrorcount"} = 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 getrcmode {
  my ($self) = @_;
  return $self->{"rcmode"};
}

sub setrcmode {
  my ($self,$level) = @_;

  if ( $level !~ /^(normal|differentiated|noretrievalerrors)$/ ) {
    $self->err("Attempt to set rcmode to invalid value of $level");
    return undef;
  }

  my $oldlevel = $self->{"rcmode"};
  $self->{"rcmode"} = $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 retr_err($@) {
  my $self = shift;
  my $message = "@_";
  return 1 unless ( $self->{"errors"} );
  $self->output("ERROR",$message);
  $self->{"retrerrorcount"}++;
  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"} + $self->{"retrerrorcount"}) 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->{"retrerrorcount"} = 0;
  $self->{"warningcount"} = 0;
  $self->{"logmode"} = {};
  return 1;
}


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

  if ( $self->{"rcmode"} eq "normal" ) {
    $self->{"errorcount"} and $self->{"errors"} and return 1;
    $self->{"retrerrorcount"} and $self->{"errors"} and return 1;
  } elsif ( $self->{"rcmode"} eq "differentiated" ) {
    $self->{"errorcount"} and $self->{"errors"} and return 1;
    $self->{"retrerrorcount"} and $self->{"errors"} and return 2;
  } elsif ( $self->{"rcmode"} eq "noretrievalerrors" ) {
    $self->{"errorcount"} and $self->{"errors"} and return 1;
  } else {
    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	davidg	2692	$obref->{"rcmode"} = "normal";
34	davidg	1758	$obref->{"warncount"} = 0;
35			$obref->{"errorcount"} = 0;
36	davidg	2692	$obref->{"retrerrorcount"} = 0;
37	davidg	1758	$obref->{"syslogfacility"} = "daemon";
38
39			while ( my $mode = shift ) {
40			$obref->destadd($mode);
41			}
42
43			return $obref;
44			}
45
46			sub destadd {
47			my $self = shift;
48			my $mode = shift;
49			my $facility = (shift or $self->{"syslogfacility"});
50
51			return 0 unless defined $mode;
52
53			$self->{"logmode"}{$mode} = 1;
54			if ( $mode eq "syslog" ) {
55			my $progname = $0;
56			$progname =~ s/^.*\///;
57			$self->{"syslogfacility"} = $facility;
58			openlog($progname,"nowait,pid", $facility);
59			}
60			return 1;
61			}
62
63			sub destremove {
64			my $self = shift;
65			my $ok = 1;
66
67			my $mode = shift;
68			$self->{"logmode"} = {} and return 1 if (defined $mode and $mode eq "all");
69			unshift @_,$mode;
70
71			while ( my $mode = shift ) {
72			if ( defined $self->{"logmode"}{$mode} ) {
73			closelog() if $mode eq "syslog";
74			delete $self->{"logmode"}{$mode};
75			} else {
76			$ok=0;
77			}
78			}
79			return $ok;
80			}
81
82			sub setverbose {
83			my ($self,$level) = @_;
84			my $oldlevel = $self->{"verbose"};
85			$self->{"verbose"} = 0+$level;
86			return $oldlevel;
87			}
88
89			sub getverbose {
90			my ($self) = @_;
91			return $self->{"verbose"};
92			}
93
94			sub setdebug {
95			my ($self,$level) = @_;
96			my $oldlevel = $self->{"debug"};
97			$self->{"debug"} = $level;
98			return $oldlevel;
99			}
100
101			sub getdebug {
102			my ($self) = @_;
103			return $self->{"debug"};
104			}
105
106			sub setwarnings {
107			my ($self,$level) = @_;
108			my $oldlevel = $self->{"warnings"};
109			$self->{"warnings"} = $level;
110			return $oldlevel;
111			}
112
113			sub getwarnings {
114			my ($self) = @_;
115			return $self->{"warnings"};
116			}
117
118			sub geterrors {
119			my ($self) = @_;
120			return $self->{"errors"};
121			}
122
123			sub seterrors {
124			my ($self,$level) = @_;
125			my $oldlevel = $self->{"errors"};
126			$self->{"errors"} = $level;
127			return $oldlevel;
128			}
129
130	davidg	2690	sub getrcmode {
131			my ($self) = @_;
132			return $self->{"rcmode"};
133			}
134
135			sub setrcmode {
136			my ($self,$level) = @_;
137	davidg	2692
138			if ( $level !~ /^(normal\|differentiated\|noretrievalerrors)$/ ) {
139			$self->err("Attempt to set rcmode to invalid value of $level");
140			return undef;
141			}
142
143	davidg	2690	my $oldlevel = $self->{"rcmode"};
144			$self->{"rcmode"} = $level;
145			return $oldlevel;
146			}
147
148	davidg	1758	sub verb($$$) {
149			my $self = shift;
150			my $level = shift;
151			return 1 unless ( $level <= $self->{"verbose"} );
152			my $message = "@_";
153			$self->output("VERBOSE($level)",$message);
154			return 1;
155			}
156
157			sub debug($$$) {
158			my $self = shift;
159			my $level = shift;
160			return 1 unless ( $level <= $self->{"debug"} );
161			my $message = "@_";
162			$self->output("DEBUG($level)",$message);
163			return 1;
164			}
165
166			sub warn($@) {
167			my $self = shift;
168			return 1 unless ( $self->{"warnings"} );
169			$self->{"warningcount"}++;
170			my $message = "@_";
171			$self->output("WARN",$message);
172			return 1;
173			}
174
175			sub err($@) {
176			my $self = shift;
177			my $message = "@_";
178			return 1 unless ( $self->{"errors"} );
179			$self->output("ERROR",$message);
180			$self->{"errorcount"}++;
181			return 1;
182			}
183
184	davidg	2690	sub retr_err($@) {
185			my $self = shift;
186			my $message = "@_";
187			return 1 unless ( $self->{"errors"} );
188			$self->output("ERROR",$message);
189	davidg	2692	$self->{"retrerrorcount"}++;
190	davidg	2690	return 1;
191			}
192
193	davidg	1758	sub output($$@) {
194			my ($self,$label,@message) = @_;
195			return 0 unless defined $label and @message;
196
197			my $message = join " ",@message;
198
199			print "" . ($label?"$label ":"") . "$message\n"
200			if ( defined $self->{"logmode"}{"qualified"} );
201			push @{$self->{"messagecache"}},"" . ($label?"$label ":"") . "$message\n"
202			if ( defined $self->{"logmode"}{"cache"} );
203			print "$message\n"
204			if ( defined $self->{"logmode"}{"direct"} );
205
206			if ( defined $self->{"logmode"}{"syslog"} ) {
207			my $severity = "LOG_INFO";
208			$severity = "LOG_NOTICE" if $label eq "WARN";
209			$severity = "LOG_ERR" if $label eq "ERROR";
210			$severity = "LOG_DEBUG" if $label =~ /^VERBOSE/;
211			$severity = "LOG_DEBUG" if $label =~ /^DEBUG/;
212			syslog($severity, "%s", $message);
213			}
214
215			return 1;
216			}
217
218			sub clear($) {
219			my $self = shift;
220
221			$self->{"messagecache"} = ();
222			return 1;
223			}
224
225			sub flush($) {
226			my $self = shift;
227
228			foreach my $s ( @{$self->{"messagecache"}} ) {
229			print $s;
230			}
231			$self->{"messagecache"} = ();
232
233	davidg	2692	($self->{"errorcount"} + $self->{"retrerrorcount"}) and $self->{"errors"} and return 0;
234	davidg	1758	$self->{"warningcount"} and $self->{"warnings"} and return 1;
235			return 1;
236			}
237
238			sub cleanse($) {
239			my $self = shift;
240			$self->{"messagecache"} = ();
241			$self->{"errorcount"} = 0;
242	davidg	2692	$self->{"retrerrorcount"} = 0;
243	davidg	1758	$self->{"warningcount"} = 0;
244			$self->{"logmode"} = {};
245			return 1;
246			}
247
248
249			sub exitstatus($) {
250			my $self = shift;
251
252	davidg	2692	if ( $self->{"rcmode"} eq "normal" ) {
253			$self->{"errorcount"} and $self->{"errors"} and return 1;
254			$self->{"retrerrorcount"} and $self->{"errors"} and return 1;
255			} elsif ( $self->{"rcmode"} eq "differentiated" ) {
256			$self->{"errorcount"} and $self->{"errors"} and return 1;
257			$self->{"retrerrorcount"} and $self->{"errors"} and return 2;
258			} elsif ( $self->{"rcmode"} eq "noretrievalerrors" ) {
259			$self->{"errorcount"} and $self->{"errors"} and return 1;
260			} else {
261			return 1;
262			}
263
264	davidg	1758	return 0;
265			}
266
267			1;
grid.support@nikhef.nl	ViewVC Help
Powered by ViewVC 1.1.28