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	#
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