Log-Agent-1.005/0000755000000000000000000000000014034707532011777 5ustar rootrootLog-Agent-1.005/META.json0000644000000000000000000000136214034707532013422 0ustar rootroot{ "abstract" : "A general logging framework", "author" : [ "Mark Rogaski " ], "dynamic_config" : 0, "license" : [ "artistic_2" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Log-Agent", "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0", "Test::More" : "0" } }, "runtime" : { "recommends" : { "Callback" : "0" }, "requires" : { "Tie::Array" : "0" } } }, "release_status" : "stable", "version" : "1.004", "x_installdirs" : "site", "x_version_from" : "Agent.pm" } Log-Agent-1.005/Agent/0000755000000000000000000000000014034707532013035 5ustar rootrootLog-Agent-1.005/Agent/Driver.pm0000644000000000000000000004101414034707532014626 0ustar rootroot########################################################################### # # Driver.pm # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use strict; ######################################################################## package Log::Agent::Driver; # # Ancestor for all Log::Agent drivers. # # # Common attribute acccess, initialized via _init(). # # prefix the common (static) string info to prepend to messages # penalty the skip Carp penalty to offset to the fixed one # sub prefix { $_[0]->{'prefix'} } sub penalty { $_[0]->{'penalty'} } # # is_deferred # # Report routine as being deferred # sub is_deferred { require Carp; Carp::confess("deferred"); } # # ->make -- deferred # # Creation routine. # sub make { &is_deferred; } # # ->channel_eq # # Compare two channels and return true if they go to the same output. # sub channel_eq { &is_deferred; } # # ->_init # # Common initilization routine # sub _init { my $self = shift; my ($prefix, $penalty) = @_; $self->{'prefix'} = $prefix; # Prefix info to prepend $self->{'penalty'} = $penalty; # Carp stack skip penalty } # # ->add_penalty -- "exported" only to Log::Agent::Driver::Datum # # Add offset to current driver penalty # sub add_penalty { my $self = shift; my ($offset) = @_; $self->{penalty} += $offset; } my %level = ( 'c' => 1, 'e' => 2, 'w' => 4, 'n' => 6, ); # # ->priority -- frozen # # Return proper priority for emit() based on one of the following strings: # "critical", "error", "warning", "notice". Those correspond to the hardwired # strings for logconfess()/logdie(), logerr(), logwarn() and logsay(). # # This routine is intended to be "frozen", i.e. it MUST NOT be redefined. # Redefine map_pri() if needed, or don't call it in the first place. # sub priority { my $self = shift; my ($prio) = @_; my $level = $level{lc(substr($prio, 0, 1))} || 8; return $self->map_pri($prio, $level); } # # ->write -- deferred # # Write log entry, physically. # A trailing "\n" is to be added if needed. # # $channel is one of 'debug', 'output', 'error' and can be used to determine # where the emission of the log message should be done. # sub write { my $self = shift; my ($channel, $priority, $logstring) = @_; &is_deferred; } # # ->emit -- may be redefined # # Routine to call to emit log, resolve priority and prefix logstring. # Ulitimately calls ->write() to perform the physical write. # sub emit { my $self = shift; my ($channel, $prio, $msg) = @_; $self->write($channel, $self->priority($prio), $self->prefix_msg($msg)); return; } # # ->map_pri -- may be redefined # # Convert a ("priority", level) tupple to a single priority token suitable # for `emit'. # # This is driver-specific: drivers may ignore priority altogether thanks to # the previous level-based filtering done (-trace and -debug switches in the # Log::Agent configuration), choose to give precedence to levels over priority # when "priority:level" was specified, or always ignore levels and only use # "priority". # # The default is to ignore "priority" and "levels", which is suitable to basic # drivers. Only those (ala syslog) which rely on post-filtering need to be # concerned. # sub map_pri { my $self = shift; my ($priority, $level) = @_; return ''; # ignored for basic drivers } # # ->prefix_msg -- deferred # # Prefix message with driver-specific string, if necessary. # # This routine may or may not use common attributes like the fixed # static prefix or the process's pid. # sub prefix_msg { my $self = shift; my ($str) = @_; &is_deferred; } # # ->carpmess # # Utility routine for logconfess and logcroak which builds the "die" message # by calling the appropriate routine in Carp, and offseting the stack # according to our call stack configuration, plus any offset. # sub carpmess { my $self = shift; my ($offset, $str, $fn) = @_; # # While confessing, we have basically tell $fn() to skip 2 stack frames: # this call, and our caller chain back to Log::Agent (calls within the # same hierarchy are automatically stripped by Carp). # # To that, we add any additional penalty level, as told us by the creation # routine of each driver, which accounts for extra levels used before # calling us. # require Carp; my $skip = $offset + 2 + $self->penalty; $Carp::CarpLevel += $skip; my $original = $str->str; # Original user message my $msg = &$fn('__MESSAGE__'); $Carp::CarpLevel -= $skip; # # If we have a newline in the message, we have a full stack trace. # Replace the original message string with the first line, and # append the remaining. # chomp($msg); # Remove final "\n" added if ($msg =~ s/^(.*?)\n//) { my $first = $1; # # Patch incorrect computation by Carp, which occurs when we request # a short message and we get a long one. In that case, what we # want is the first line of the extra message. # # This bug manifests when the whole call chain above Log::Agent # lies in "main". When objects are involved, it seems to work # correctly. # # The kludge here is valid for perl 5.005_03. If some day Carp is # fixed, we will have to test for the Perl version. The right fix, # I believe, would be to have Carp skip frame first, and not last # as it currently does. # -- RAM, 30/09/2000 # if ($fn == \&Carp::shortmess) { # Kludge alert!! # # And things just got a little uglier with 5.8.0 # # -- mrogaski, 1 Aug 2002 # my $index = $] >= 5.008 ? 1 : 0; $first =~ s/(at (.+) line \d+)$//; my $bad = $1; my @stack = split(/\n/, $msg); my ($at) = $stack[$index] =~ /(at \S+ line \d+)$/ if defined $stack[$index]; $at = "$bad (Log::Agent could not fix it)" unless $at; $first .= $at; $str->set_str($first); } else { $str->set_str($first); $str->append_last("\n"); $str->append_last($msg); # Stack at the very tail of message } } else { $str->set_str($msg); # Change original message inplace } $msg = $str->str; # Another Carp workaround kludge. $msg =~ s/ at .*\d\.at / at /; $msg =~ s/__MESSAGE__/$original/; $str->set_str($msg); return $str; } # # ->logcluck # # Warn with a full backtraace. # sub logcluck { my $self = shift; my ($str) = @_; my $msg = $self->carpmess(0, $str, \&Carp::longmess); $self->emit('error', 'warning', $msg); } # # ->logconfess # # Confess fatal error # Error is logged, and then we confess. # sub logconfess { my $self = shift; my ($str) = @_; my $msg = $self->carpmess(0, $str, \&Carp::longmess); $self->emit('error', 'critical', $msg); die "$msg\n"; } # # ->logxcroak # # Fatal error, from the perspective of the caller. # Error is logged, and then we confess. # sub logxcroak { my $self = shift; my ($offset, $str) = @_; my $msg = $self->carpmess($offset, $str, \&Carp::shortmess); $self->emit('error', 'critical', $msg); die "$msg\n"; } # # ->logdie # # Fatal error # Error is logged, and then we die. # sub logdie { my $self = shift; my ($str) = @_; $self->emit('error', 'critical', $str); die "$str\n"; } # # logerr # # Log error # sub logerr { my $self = shift; my ($str) = @_; $self->emit('error', 'error', $str); } # # ->logxcarp # # Log warning, from the perspective of the caller. # sub logxcarp { my $self = shift; my ($offset, $str) = @_; my $msg = $self->carpmess($offset, $str, \&Carp::shortmess); $self->emit('error', 'warning', $msg); } # # logwarn # # Log warning # sub logwarn { my $self = shift; my ($str) = @_; $self->emit('error', 'warning', $str); } # # logsay # # Log message at the "notice" level. # sub logsay { my $self = shift; my ($str) = @_; $self->emit('output', 'notice', $str); } # # loginfo # # Log message at the "info" level. # sub loginfo { my $self = shift; my ($str) = @_; $self->emit('output', 'info', $str); } # # logdebug # # Log message at the "debug" level. # sub logdebug { my $self = shift; my ($str) = @_; $self->emit('output', 'debug', $str); } # # logwrite # # Emit the message to the specified channel # sub logwrite { my $self = shift; my ($chan, $prio, $level, $str) = @_; $self->write($chan, $self->map_pri($prio, $level), $self->prefix_msg($str)); } 1; # for require __END__ =head1 NAME Log::Agent::Driver - ancestor class for all Log::Agent drivers =head1 SYNOPSIS @Log::Agent::Driver::XXX::ISA = qw(Log::Agent::Driver); =head1 DESCRIPTION The Log::Agent::Driver class is the root class from which all Log::Agent drivers inherit. It is a I class, meaning that it cannot be instantiated directly. All the deferred routines need to be implemented by its heirs to form a valid driver. A I routine is a routine whose signature and semantics (pre and post conditions, formally) are specified, but not implemented. It allows specification of high-level processings in terms of them, thereby factorizing common code in the ancestors without loosing specialization benefits. =head1 DRIVER LIST The following drivers are currently fully implemented: =over 4 =item Log::Agent::Driver::Default This is the default driver which remaps to simple print(), warn() and die() Perl calls. =item Log::Agent::Driver::File This driver redirects logs to files. Each logging channel may go to a dedicated file. =item Log::Agent::Driver::Silent Silence all the logxxx() routines. =item Log::Agent::Driver::Syslog This driver redirects logs to the syslogd(8) daemon, which will then handle the dispatching to various logfiles, based on its own configuration. =back =head1 INTERFACE You need not read this section if you're only B Log::Agent. However, if you wish to B another driver, then you should probably read it a few times. The following routines are B and therefore need to be defined by the heir: =over 4 =item channel_eq($chan1, $chan2) Returns true when both channels $chan1 and $chan2 send their output to the same place. The purpose is not to have a 100% accurate comparison, which is almost impossible for the Log::Agent::Driver::File driver, but to reasonably detect similarities to avoid duplicating messages to the same output when Carp::Datum is installed and activated. =item write($channel, $priority, $logstring) Emit the log entry held in $logstring, at priority $priority and through the specfied $channel name. A trailing "\n" is to be added if needed, but the $logstring should not already have one. The $channel name is just a string, and it is up to the driver to map that name to an output device using its own configuration information. The generic logxxx() routines use only C, C or C for channel names. The $priority entry is assumed to have passed through the map_pri() routine, which by default returns an empty string (only the Log::Agent::Driver::Syslog driver needs a priority, for now). Ignore if you don't need that, or redefine map_pri(). The $logstring may not really be a plain string. It can actually be a Log::Agent::Message object with an overloaded stringification routine, so the illusion should be complete. =item make This is the creation routine. Its signature varies for each driver, naturally. =item prefix_msg($str) Prefix the log message string (a Log::Agent::Message object) with driver-specific information (like the configured prefix, the PID of the process, etc...). Must return the prefixed string, either as a Log::Agent::Message object or as a plain string. This means you may use normal string operations on the $str variable and let the overloaded stringification perform its magic. Or you may return the $str parameter without modification. There is no default implementation here because this is too driver-specific to choose one good default. And I like making things explicit sometimes. =back The following routines are implemented in terms of write(), map_pri() and prefix_msg(). The default implementation may need to be redefined for performance or tuning reasons, but simply defining the deferred routines above should bring a reasonable behaviour. As an example, here is the default logsay() implementation, which uses the emit() wrapper (see below): sub logsay { my $self = shift; my ($str) = @_; $self->emit('output', 'notice', $str); } Yes, we do show the gory details in a manpage, but inheriting from a class is not for the faint of heart, and requires getting acquainted with the implementation, most of the time. The order is not alphabetical here but by increased level of severity (as expected, anyway): =over 4 =item logwrite($channel, $priority, $level, $str) Log message to the given channel, at the specified priority/level, obtained through a call to map_pri(). =item logsay($str) Log message to the C channel, at the C priority. =item logwarn($str) Log warning to the C channel at the C priority. =item logxcarp($offset, $str) Log warning to the C channel at the C priority, from the perspective of the caller. An additional $offset stack frames are skipped to find the caller (added to the hardwired fixed offset imposed by the overall Log::Agent architecture). =item logerr($str) Log error to the C channel at the C priority. =item logdie($str) Log fatal error to the C channel at the C priority and then call die() with "$str\n" as argument. =item logxcroak($offset, $str) Log a fatal error, from the perspective of the caller. The error is logged to the C channel at the C priority and then Carp::croak() is called with "$str\n" as argument. An additional $offset stack frames are skipped to find the caller (added to the hardwired fixed offset imposed by the overall Log::Agent architecture). =item logconfess($str) Confess a fatal error. The error is logged to the C channel at the C priority and then Carp::confess() is called with "$str\n" as argument. =item logcluck($str) Emit a warning with a backtrace. The message is logged to the C channel at the C priority. =back The following routines have a default implementation but may be redefined for specific drivers: =over 4 =item emit($channel, $prio, $str) This is a convenient wrapper that calls: write($channel, $self->priority($prio), $self->prefix_msg($str)) using dynamic binding. =item map_pri($priority, $level) Converts a ("priority", level) tupple to a single priority token suitable for emit(). By default, returns an empty string, which is OK only when emit() does not care! =back The following routine is B. There is no way in Perl to freeze a routine, i.e. to explicitly forbid any redefinition, so this is an informal notification: =over 4 =item priority($priority) This routine returns the proper priority for emit() for each of the following strings: "critical", "error", "warning" and "notice", which are the hardwired priority strings, as documented above. It derives a logging level from the $priority given and then returns the result of: map_pri($priority, $level); Therefore, only map_pri() should be redefined. =back Finally, the following initialization routine is provided: to record the =over 4 =item _init($prefix, $penalty) Records the C attribute, as well as the Carp C (amount of extra stack frames to skip). Should be called in the constructor of all the drivers. =back =head1 AUTHORS Originally written by Raphael Manfredi ERaphael_Manfredi@pobox.comE, currently maintained by Mark Rogaski Emrogaski@cpan.orgE. =head1 LICENSE Copyright (C) 1999 Raphael Manfredi. Copyright (C) 2002 Mark Rogaski; all rights reserved. See L or the README file included with the distribution for license information. =head1 SEE ALSO Log::Agent(3), Log::Agent::Driver::Default(3), Log::Agent::Driver::File(3), Log::Agent::Driver::Fork(3), Log::Agent::Driver::Silent(3), Log::Agent::Driver::Syslog(3), Carp::Datum(3). =cut Log-Agent-1.005/Agent/File/0000755000000000000000000000000014034707532013714 5ustar rootrootLog-Agent-1.005/Agent/File/Native.pm0000644000000000000000000000353214034707532015503 0ustar rootroot########################################################################### # # Native.pm # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use strict; ######################################################################## package Log::Agent::File::Native; # # A native Perl filehandle. # # I'm no longer using the IO::* hierarchy because it is not adapted # to what we're trying to achieve here. # # # ->make # # Creation routine. # Turns on autoflush as a side effect. # sub make { my $class = shift; my ($glob) = @_; select((select($glob), $| = 1)[0]); # autoflush turned on return bless $glob, $class; } # # ->print # # Print to file, propagates print() status. # sub print { my $glob = shift; local $\ = undef; return CORE::print $glob @_; } # # ->close # # Close file. # sub close { my $glob = shift; CORE::close $glob; } # # ->DESTROY # sub DESTROY { my $glob = shift; CORE::close $glob; } 1; # for require __END__ =head1 NAME Log::Agent::File::Native - low-overhead IO::File =head1 SYNOPSIS require Log::Agent::File::Native; my $fh = Log::Agent::File::Native->make(\*main::STDERR); =head1 DESCRIPTION This class is a stripped down implementation of IO::File, to avoid using the IO::* hierarchy which does not work properly for my simple needs. =over 4 =item make I This is the creation routine. Encapsulates the I reference so that we can use object-oriented calls on it. =item print I Prints I to the file. =back =head1 AUTHOR Raphael Manfredi FRaphael_Manfredi@pobox.comE> =head1 SEE ALSO Log::Agent::File::Rotate(3), Log::Agent::Driver::File(3). =cut Log-Agent-1.005/Agent/Tag.pm0000644000000000000000000001235014034707532014107 0ustar rootroot########################################################################### # # Tag.pm # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use strict; ######################################################################## package Log::Agent::Tag; # # ->make # # Creation routine. # sub make { my $self = bless {}, shift; require Carp; Carp::confess("deferred"); } # # Attribute access # sub postfix { $_[0]->{'postfix'} } sub name { $_[0]->{'name'} } sub separator { $_[0]->{'separator'} } # # ->_init # # Initialization routine for common attributes: # # postfix if true, appends tag to message, otherwise prepends # name the tag name # separator the string to use before or after tag (defaults to " ") # # Called by each creation routine in heirs. # sub _init { my $self = shift; my ($name, $postfix, $separator) = @_; $separator = " " unless defined $separator; $self->{name} = $name; $self->{postfix} = $postfix; $self->{separator} = $separator; return; } # # ->string -- deferred # # Build tag string. # Must be implemented by heirs. # sub string { require Carp; Carp::confess("deferred"); } # # ->insert -- frozen # # Merge string into the log message, according to our configuration. # sub insert { my $self = shift; my ($str) = @_; # A Log::Agent::Message object my $string = $self->string; my $separator = $self->separator; # # Merge into the Log::Agent::Message object string. # if ($self->postfix) { $str->append($separator . $string); } else { $str->prepend($string . $separator); } return; } 1; # for "require" __END__ =head1 NAME Log::Agent::Tag - formats caller information =head1 SYNOPSIS Intended to be inherited from =head1 DESCRIPTION This class is meant to be inherited by all the classes implementing a log message tag. A message tag is a little string that is either appended or prepended to all log messages. For instance, and oversimplifying a bit, a tag meant to be prepended will be inserted in front of the current log message, separated by I, which defaults to a single space: +------------+-----------+---------------------------------+ | tag string | separator | current log message | +------------+-----------+---------------------------------+ This operation is called I. The whole string then becomes the I, and can be the target of another tag insertion. The reality is a little bit more complex, to allow successive tags to be prepended or appended in the order they are specified, and not in reverse order as they would be if naively implemented. See L for the exact semantics of append() and prepend() operations. =head1 FEATURES This section documents the interface provided to heirs, in case you wish to implement your own tag class. =over 4 =item _init(I, I, I) Initialization routine that should be called by all heirs during creation to initialize the common attributes. =item postfix When true, the tag is meant to be appended to the log message. Otherwise, it is prepended. =item name The name of this tag. It is meant to provide by-name access to tags, check whether a given tag is recorded, etc... The names "caller" and "priority" are architecturally defined to refer to C and C objects. B: Currently unused by any client code. =item separator The sperating string inserted between the tag and the log message. It defaults to C<" "> if not specified, i.e. left to C when calling _init(). =item string() A B routine, to be implemented by heirs. Returns the tag string only, without the separator, since its exact placement depends on the value of the C attribute. =item insert(I) Insert this tag withing the C I, according to the tag specifications (placement, separator). Calls string() to produce the tag string. This routine is B and should not be redefined by heirs. =back =head1 STANDARD TAGGING CLASSES Tagging classes define via their C routine what is the string to be used as a tag. The insertion of the tag within the log message is done via a frozen routine from the C ancestor. The following classes are provided by C: =over 4 =item C The C routine invokes a user-supplied callback, given as a C object. You need the Callback module from CPAN if you wish to use this class. =item C Used internally to compute the caller and format it according to user specifications. =item C Used internally to format message priorities and add them to the log messages. =item C Defines a constant tagging string that should be added in all the log messages, e.g. a web session ID. =back =head1 AUTHOR Raphael Manfredi FRaphael_Manfredi@pobox.comE> =head1 SEE ALSO Log::Agent::Message(3). =cut Log-Agent-1.005/Agent/Formatting.pm0000644000000000000000000000600414034707532015505 0ustar rootroot########################################################################### # # Formatting.pm # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use strict; require Exporter; ######################################################################## package Log::Agent::Formatting; use vars qw(@ISA @EXPORT_OK); @ISA = qw(Exporter); @EXPORT_OK = qw(format_args tag_format_args); require Log::Agent::Message; # # adjust_fmt # # We process syslog's %m macro as being the current error message ($!) in # the first argument only. Doing it at this level means it will be supported # independently from the driver they'll choose. It's also done BEFORE any # log-related system call, thus ensuring that $! retains its original value. # if ($] >= 5.005) { eval q{ # if VERSION >= 5.005 # 5.005 and later version grok /(?= 5.005 */ # # whine # # This is a local hack of carp # sub whine { my $msg = shift; unless (chomp $msg) { my($package, $filename, $line) = caller 2; $msg .= " at $filename line $line."; } warn "$msg\n"; } # # tag_format_args # # Arguments: # # $caller caller information, done firstly # $priority priority information, done secondly # $tags list of user-defined tags, done lastly # $ary arguments for sprintf() # # Returns a Log::Agent::Message object, which, when stringified, prints # the string itself. # sub tag_format_args { my ($caller, $priority, $tags, $ary) = @_; my $msg = adjust_fmt(shift @$ary); # This bit of tomfoolery is intended to make debugging of # programs a bit easier by prechecking input to sprintf() # for errors. I usually prefer lazy error checking, but # this seems to be an appropriate exception. if (my @arglist = $msg =~ /\%[^\%]*[csduoxefgXEGbpniDUOF]|\%\%/g) { BEGIN { no warnings } my $argcnt = grep !/\%\%/, @arglist; if (grep {! defined} @$ary[0..($argcnt - 1)]) { whine("Use of uninitialized value in sprintf"); } $msg = sprintf $msg, @$ary; } my $str = Log::Agent::Message->make($msg); $caller->insert($str) if defined $caller; $priority->insert($str) if defined $priority; if (defined $tags) { foreach my $tag (@$tags) { $tag->insert($str); } } return $str; } 1; Log-Agent-1.005/Agent/Prefixer.pm0000644000000000000000000000361414034707532015163 0ustar rootroot########################################################################### # # Prefixer.pm # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use strict; ######################################################################## package Log::Agent::Prefixer; # # Ancestor for logging channels wishing to implement native prefixing # # # Attribute access: those attributes must be filled by our heirs # sub prefix { $_[0]->{'prefix'} } sub stampfmt { $_[0]->{'stampfmt'} } sub showpid { $_[0]->{'showpid'} } sub no_ucfirst { $_[0]->{'no_ucfirst'} } sub no_prefixing { $_[0]->{'no_prefixing'} } sub no_newline { $_[0]->{'no_newline'} } sub crlf { $_[0]->{'crlf'} } # # ->prefixing_string # # Compute prefixing string: stamping and "prefix: " to be emitted before # the logged string. # # Usage: # # $str = $self->prefixing_string(); # no ucfirst support possible # $str = $self->prefixing_string(\$log_message); # # Leading char of to-be-logged string is upper-cased in-place if # neither prefix nor pid are present, and behaviour was not disabled # via a -no_ucfirst, and the second call form with a scalar ref is used. # sub prefixing_string { my $self = shift; # # This routine is called often... # Bypass the attribute access routines. # my $prefix = $self->{prefix}; $prefix = '' unless defined $prefix; if ($self->{showpid}) { if ($prefix eq '') { $prefix = $$; } else { $prefix .= "[$$]"; } } elsif ($prefix eq '') { my $rstr = $_[0]; $$rstr =~ s/^(.)/\u$1/ if ref $rstr && !$self->{no_ucfirst}; } my $stamp = &{$self->{stampfmt}}; return ($stamp eq '' ? '' : "$stamp ") . ($prefix eq '' ? '' : "$prefix: "); } 1; # for require Log-Agent-1.005/Agent/Stamping.pm0000644000000000000000000000557614034707532015172 0ustar rootroot########################################################################### # # Stamping.pm # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use strict; require Exporter; ######################################################################## package Log::Agent::Stamping; # # Common time-stamping routines # use vars qw(@ISA @EXPORT); @ISA = qw(Exporter); @EXPORT = qw(stamping_fn); my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); my @days = qw(Sun Mon Tue Wed Thu Fri Sat); # # stamp_none # # No timestamp # sub stamp_none { return ''; } # # stamp_syslog # # Syslog-like stamping: "Oct 27 21:09:33" # sub stamp_syslog { my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); return sprintf "%s %2d %.2d:%.2d:%.2d", $months[$mon], $mday, $hour, $min, $sec; } # # stamp_date # # Date format: "[Fri Oct 22 16:23:10 1999]" # sub stamp_date { my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); return sprintf "[%s %s %2d %.2d:%.2d:%.2d %d]", $days[$wday], $months[$mon], $mday, $hour, $min, $sec, 1900 + $year; } # # stamp_own # # Own format: "99/10/24 09:43:49" # sub stamp_own { my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); return sprintf "%.2d/%.2d/%.2d %.2d:%.2d:%.2d", $year % 100, ++$mon, $mday, $hour, $min, $sec; } my %stamping = ( 'none' => \&stamp_none, 'syslog' => \&stamp_syslog, 'date' => \&stamp_date, 'own' => \&stamp_own, ); # # stamping_fn # # Return proper time stamping function based on its 'tag' # If tag is unknown, use stamp_own. # sub stamping_fn { my ($tag) = @_; return $stamping{$tag} if defined $tag && defined $stamping{$tag}; return \&stamp_own; } 1; # for require __END__ =head1 NAME Log::Agent::Stamping - time-stamping routines =head1 SYNOPSIS Not intended to be used directly =head1 DESCRIPTION This package contains routines to generate the leading time-stamping on logged messages. Formats are identified by a name, and the stamping_fn() function converts that name into a CODE ref, defaulting to the "own" format when given an unknown name. Here are the known formats: date "[Fri Oct 22 16:23:10 1999]" none own "99/10/22 16:23:10" syslog "Oct 22 16:23:10" Channels or Drivers which take a C<-stampfmt> switch expect either a string giving the format name (e.g. "date"), or a CODE ref. That referenced routine will be called every time we need to compute a time stamp. It should not expect any parameter, and should return a stamping string. =head1 AUTHOR Raphael Manfredi FRaphael_Manfredi@pobox.comE> =head1 SEE ALSO Log::Agent(3), Log::Agent::Channel(3), Log::Agent::Driver(3). =cut Log-Agent-1.005/Agent/Message.pm0000644000000000000000000001233514034707532014763 0ustar rootroot########################################################################### # # Message.pm # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use strict; ######################################################################## package Log::Agent::Message; use overload qw("" stringify); # # ->make # # Creation routine. # # Attributes: # str formatted message string coming from user # prepend_list list of strings to prepend to `str' # append_list list of strings to append to `str' # sub make { my $self = bless [], shift; # Array for minimal overhead $self->[0] = $_[0]; return $self; } # # Attribute access # sub str { $_[0]->[0] } sub prepend_list { $_[0]->[1] } sub append_list { $_[0]->[2] } # # Attribute setting # sub set_str { $_[0]->[0] = $_[1] } sub set_prepend_list { $_[0]->[1] = $_[1] } sub set_append_list { $_[0]->[2] = $_[1] } # # ->prepend # # Add string to the prepend list, at its TAIL. # (i.e. the first to prepend gets output first) # sub prepend { my $self = shift; my ($str) = @_; my $array = $self->prepend_list; $array = $self->set_prepend_list([]) unless $array; push(@{$array}, $str); } # # ->prepend_first # # Add string to the prepend list, at its HEAD. # sub prepend_first { my $self = shift; my ($str) = @_; my $array = $self->prepend_list; $array = $self->set_prepend_list([]) unless $array; unshift(@{$array}, $str); } # # ->append # # Add string to the append list, at its HEAD. # (i.e. the first to append gets output last) # sub append { my $self = shift; my ($str) = @_; my $array = $self->append_list; $array = $self->set_append_list([]) unless $array; unshift(@{$array}, $str); } # # ->append_last # # Add string to the append list, at its TAIL. # sub append_last { my $self = shift; my ($str) = @_; my $array = $self->append_list; $array = $self->set_append_list([]) unless $array; push(@{$array}, $str); } # # ->stringify # (stringify) # # Returns complete string, with all prepended strings first, then the # original string followed by all the appended strings. # sub stringify { my $self = shift; return $self->[0] if @{$self} == 1; # Optimize usual case my $prepend = $self->prepend_list; my $append = $self->append_list; return ($prepend ? join('', @{$prepend}) : '') . $self->str . ($append ? join('', @{$append}) : ''); } # # ->clone # # Clone object # (not a deep clone, but prepend and append lists are also shallow-cloned.) # sub clone { my $self = shift; my $other = bless [], ref $self; $other->[0] = $self->[0]; return $other if @{$self} == 1; # Optimize usual case if (defined $self->[1]) { my @array = @{$self->[1]}; $other->[1] = \@array; } if (defined $self->[2]) { my @array = @{$self->[2]}; $other->[2] = \@array; } return $other; } 1; # for require __END__ =head1 NAME Log::Agent::Message - a log message =head1 SYNOPSIS require Log::Agent::Message; my $msg = Log::Agent::Message->make("string"); $msg->prepend("string"); $msg->append("string"); my $copy = $msg->clone; print "Message is $msg\n"; # overloaded stringification =head1 DESCRIPTION The Log::Agent::Message class represents an original log message (a string) to which one may prepend or append other strings, but with the special property that prepended strings aggregate themselves in FIFO order, whilst appended strings aggregate themselves in LIFO order, which is counter-intuitive at first sight. In plain words, this means that the last routine that prepends something to the message will get its prepended string right next to the original string, regardless of what could have been prepended already. The behaviour is symetric for appending. =head1 INTERFACE The following routines are available: =over 4 =item append($str) Append suppled string $str to the original string (given at creation time), at the head of all existing appended strings. =item append_last($str) Append suppled string $str to the original string (given at creation time), at the tail of all existing appended strings. =item clone Clone the message. This is not a shallow clone, because the list of prepended and appended strings is recreated. However it is not a deep clone, because the items held in those lists are merely copied (this would matter only when other objects with overloaded stringification routines were supplied to prepend() and append(), which is not the case today in the basic Log::Agent framework). =item make($string) This is the creation routine. =item prepend($str) Prepend supplied string $str to the original string (given at creation time), at the tail of all existing prepended strings. =item prepend_first($str) Prepend supplied string $str to the original string (given at creation time), at the head of all existing prepended strings. =item stringify This is the overloaded "" operator, which returns the complete string composed of all the prepended strings, the original string, and all the appended strings. =back =head1 AUTHOR Raphael Manfredi FRaphael_Manfredi@pobox.comE> =head1 SEE ALSO Log::Agent(3). =cut Log-Agent-1.005/Agent/Channel.pm0000644000000000000000000001045114034707532014744 0ustar rootroot########################################################################### # # Channel.pm # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use strict; ######################################################################## package Log::Agent::Channel; # # Ancestor for all Log::Agent logging channels. # # # is_deferred # # Report routine as being deferred # sub is_deferred { require Carp; Carp::confess("deferred"); } # # ->make -- deferred # # Creation routine. # sub make { &is_deferred; } # # ->write_fn -- frozen # # Message is a CODE ref, call routine to generate it, then perform write. # Extra arguments after CODE ref are passed back to the routine. # sub write_fn { my $self = shift; my ($priority, $fn) = splice(@_, 0, 2); my $msg = &$fn(@_); $self->write($priority, $msg); } # # ->write -- deferred # # Physical writing of the message with the said priority. # sub write { my $self = shift; my ($priority, $msg) = @_; &is_deferred; } # # ->close -- deferred # sub close { my $self = shift; &is_deferred; } 1; # for require __END__ =head1 NAME Log::Agent::Channel - ancestor class for all Log::Agent channels =head1 SYNOPSIS @Log::Agent::Channel::XXX::ISA = qw(Log::Agent::Channel); =head1 DESCRIPTION The C class is the root class from which all C channels inherit. It is a I class, meaning that it cannot be instantiated directly. All the deferred routines need to be implemented by its heirs to form a valid driver. Internally, the various C objects create C instances for each logging channel defined at driver creation time. The channels are therefore architecturally hidden within C, since this module only provides redefined mappings for the various logxxx() routines (logerr(), logwarn(), logdie(), etc...). However, this does not mean that channel classes cannot be used externally: the C extension makes C objects architecturally visible, thereby offering an application-level logging API that can be redirected to various places transparently for the application. =head1 CHANNEL LIST The following channels are currently made available by C. More channels can be defined by the C extension: =over 4 =item Log::Agent::Channel::File This channel writes logs to files, defined by their path or via a magical opening sequence such as "|cmd". See L. =item Log::Agent::Channel::Handle This channel writes logs to an already opened descriptor, as specified by its file handle: an IO::Handle object, or a GLOB reference such as \*FILE. See L. =item Log::Agent::Channel::Syslog This channel redirects logs to the syslogd(8) daemon, which will then handle the dispatching to various logfiles, based on its own configuration. See L. =back =head1 INTERFACE You need not read this section if you're only B C. However, if you wish to B another channel, then this section might be of interest. The following routines are B and therefore need to be defined by the heir: =over 4 =item write($priority, $logstring) Emit the log entry held in $logstring, at priority $priority. A trailing "\n" is added to the $logstring, if needed (i.e. if the physical entity does not do it already, like syslog does). The $priority argument must be a valid syslog priority, i.e. one of the following strings: "emerg", "alert", "crit", "err", "warning", "notice", "info", "debug". The $logstring may not really be a plain string. It can actually be a Log::Agent::Message object with an overloaded stringification routine, so the illusion should be complete. =item close Close the channel. =item make This is the creation routine. Its signature varies for each channel, naturally. =back =head1 AUTHOR Raphael Manfredi FRaphael_Manfredi@pobox.comE> =head1 SEE ALSO Log::Agent::Channel::File(3), Log::Agent::Channel::Handle(3), Log::Agent::Channel::Syslog(3), Log::Agent::Logger(3). =cut Log-Agent-1.005/Agent/Driver/0000755000000000000000000000000014034707532014270 5ustar rootrootLog-Agent-1.005/Agent/Driver/File.pm0000644000000000000000000004167714034707532015524 0ustar rootroot########################################################################### # # File.pm # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use strict; require Log::Agent::Driver; ######################################################################## package Log::Agent::Driver::File; use vars qw(@ISA); @ISA = qw(Log::Agent::Driver); # # ->make -- defined # # Creation routine. # # Attributes (and switches that set them): # # prefix the application name # duperr whether to duplicate "error" channels to "output" # stampfmt stamping format ("syslog", "date", "own", "none") or closure # showpid whether to show pid after prefix in [] # channels where each channel ("error", "output", "debug") goes # chanperm what permissions each channel ("error", "output", "debug") has # magic_open flag to tell whether ">>file" or "|proc" are allowed filenames # rotate default rotating policy for logfiles # # Additional switches: # # file sole channel, implies -duperr = 0 and supersedes -channels # perm file permissions that supersedes all channel permissions # # Other attributes: # # channel_obj opened channel objects # sub make { my $self = bless {}, shift; my (%args) = @_; my $prefix; my $file; my $perm; my %set = ( -prefix => \$prefix, # Handled by parent via _init -duperr => \$self->{'duperr'}, -channels => \$self->{'channels'}, -chanperm => \$self->{'chanperm'}, -stampfmt => \$self->{'stampfmt'}, -showpid => \$self->{'showpid'}, -magic_open => \$self->{'magic_open'}, -file => \$file, -perm => \$perm, -rotate => \$self->{'rotate'}, ); while (my ($arg, $val) = each %args) { my $vset = $set{lc($arg)}; unless (ref $vset) { require Carp; Carp::croak("Unknown switch $arg"); } $$vset = $val; } # # If -file was used, it supersedes -duperr and -channels # if (defined $file && length $file) { $self->{'channels'} = { 'debug' => $file, 'output' => $file, 'error' => $file, }; $self->{'duperr'} = 0; } # # and we do something similar for file permissions # if (defined $perm && length $perm) { $self->{chanperm} = { debug => $perm, output => $perm, error => $perm }; } $self->_init($prefix, 0); # 1 is the skip Carp penalty for confess $self->{channels} = {} unless $self->channels; # No defined channels $self->{chanperm} = {} unless $self->chanperm; # No defined perms $self->{channel_obj} = {}; # No opened files # # Check for logfile rotation, which can be specified on a global or # file by file basis. Since Log::Agent::Rotate is a separate extension, # it may not be installed. # my $use_rotate = defined($self->rotate) ? 1 : 0; unless ($use_rotate) { foreach my $chan (keys %{$self->channels}) { $use_rotate = 1 if ref $self->channels->{$chan} eq 'ARRAY'; last if $use_rotate; } } if ($use_rotate) { eval { require Log::Agent::File::Rotate; }; if ($@) { warn $@; require Carp; Carp::croak("Must install Log::Agent::Rotate to use rotation"); } } return $self; } # # Attribute access # sub duperr { $_[0]->{duperr} } sub channels { $_[0]->{channels} } sub chanperm { $_[0]->{chanperm} } sub channel_obj { $_[0]->{channel_obj} } sub stampfmt { $_[0]->{stampfmt} } sub showpid { $_[0]->{showpid} } sub magic_open { $_[0]->{magic_open} } sub rotate { $_[0]->{rotate} } # # ->prefix_msg -- defined # # NOP: channel handles prefixing for us. # sub prefix_msg { my $self = shift; return $_[0]; } # # ->chanfn # # Return channel file name. # sub chanfn { my $self = shift; my ($channel) = @_; my $filename = $self->channels->{$channel}; if (ref $filename eq 'ARRAY') { $filename = $filename->[0]; } # No channel defined, use 'error' $filename = $self->channels->{'error'} unless defined $filename && length $filename; $filename = '' unless defined $filename; return $filename; } # # ->channel_eq -- defined # # Compare two channels. # # It's hard to know for certain that two channels are equivalent, so we # compare filenames. This is not correct, of course, but it will do for # what we're trying to achieve here, namely avoid duplicates if possible # when traces are remapped to Carp::Datum. # sub channel_eq { my $self = shift; my ($chan1, $chan2) = @_; my $fn1 = $self->chanfn($chan1); my $fn2 = $self->chanfn($chan2); return $fn1 eq $fn2; } # # ->write -- defined # sub write { my $self = shift; my ($channel, $priority, $logstring) = @_; my $chan = $self->channel($channel); return unless $chan; $chan->write($priority, $logstring); } # # ->channel # # Return channel object (one of the Log::Agent::Channel::* objects) # sub channel { my $self = shift; my ($name) = @_; my $obj = $self->channel_obj->{$name}; $obj = $self->open_channel($name) unless $obj; return $obj; } # # ->open_channel # # Open given channel according to the configured channel description and # return the object file descriptor. # # If no channel of that name was defined, use 'error' or STDERR. # sub open_channel { my $self = shift; my ($name) = @_; my $filename = $self->channels->{$name}; # # Handle possible logfile rotation, which may be defined globally # or on a file by file basis. # my $rotate; # A Log::Agent::Rotate object if (ref $filename eq 'ARRAY') { ($filename, $rotate) = @$filename; } else { $rotate = $self->rotate; } my @common_args = ( -prefix => $self->prefix, -stampfmt => $self->stampfmt, -showpid => $self->showpid, ); my @other_args; my $type; # # No channel defined, use 'error', or revert to STDERR # unless (defined $filename && length $filename) { $filename = $self->channels->{'error'}; ($filename, $rotate) = @$filename if ref $filename eq 'ARRAY'; } unless (defined $filename && length $filename) { require Log::Agent::Channel::Handle; select((select(main::STDERR), $| = 1)[0]); $type = "Log::Agent::Channel::Handle"; @other_args = (-handle => \*main::STDERR); } else { require Log::Agent::Channel::File; $type = "Log::Agent::Channel::File"; @other_args = ( -filename => $filename, -magic_open => $self->magic_open, -share => 1, ); push(@other_args, -fileperm => $self->chanperm->{$name}) if $self->chanperm->{$name}; push(@other_args, -rotate => $rotate) if ref $rotate; } return $self->channel_obj->{$name} = $type->make(@common_args, @other_args); } # # ->emit_output # # Force error message to the regular 'output' channel with a specified tag. # sub emit_output { my $self = shift; my ($prio, $tag, $str) = @_; my $cstr = $str->clone; # We're prepending tag on a copy $cstr->prepend("$tag: "); $self->write('output', $prio, $cstr); } ### ### Redefined routines to handle duperr ### # # ->logconfess # # When `duperr' is true, emit message on the 'output' channel prefixed # with FATAL. # sub logconfess { my $self = shift; my ($str) = @_; $self->emit_output('critical', "FATAL", $str) if $self->duperr; $self->SUPER::logconfess($str); # Carp strips calls within hierarchy } # # ->logxcroak # # When `duperr' is true, emit message on the 'output' channel prefixed # with FATAL. # sub logxcroak { my $self = shift; my ($offset, $str) = @_; my $msg = Log::Agent::Message->make( $self->carpmess($offset, $str, \&Carp::shortmess) ); $self->emit_output('critical', "FATAL", $msg) if $self->duperr; # # Carp strips calls within hierarchy, so that new call should not show, # there's no need to adjust the frame offset. # $self->SUPER::logdie($msg); } # # ->logdie # # When `duperr' is true, emit message on the 'output' channel prefixed # with FATAL. # sub logdie { my $self = shift; my ($str) = @_; $self->emit_output('critical', "FATAL", $str) if $self->duperr; $self->SUPER::logdie($str); } # # ->logerr # # When `duperr' is true, emit message on the 'output' channel prefixed # with ERROR. # sub logerr { my $self = shift; my ($str) = @_; $self->emit_output('error', "ERROR", $str) if $self->duperr; $self->SUPER::logerr($str); } # # ->logcluck # # When `duperr' is true, emit message on the 'output' channel prefixed # with WARNING. # sub logconfess { my $self = shift; my ($str) = @_; $self->emit_output('warning', "WARNING", $str) if $self->duperr; $self->SUPER::logcluck($str); # Carp strips calls within hierarchy } # # ->logwarn # # When `duperr' is true, emit message on the 'output' channel prefixed # with WARNING. # sub logwarn { my $self = shift; my ($str) = @_; $self->emit_output('warning', "WARNING", $str) if $self->duperr; $self->SUPER::logwarn($str); } # # ->logxcarp # # When `duperr' is true, emit message on the 'output' channel prefixed # with WARNING. # sub logxcarp { my $self = shift; my ($offset, $str) = @_; my $msg = Log::Agent::Message->make( $self->carpmess($offset, $str, \&Carp::shortmess) ); $self->emit_output('warning', "WARNING", $msg) if $self->duperr; $self->SUPER::logwarn($msg); } # # ->DESTROY # # Close all opened channels, so they may be removed from the common pool. # sub DESTROY { my $self = shift; my $channel_obj = $self->channel_obj; return unless defined $channel_obj; foreach my $chan (values %$channel_obj) { $chan->close if defined $chan; } } 1; # for require __END__ =head1 NAME Log::Agent::Driver::File - file logging driver for Log::Agent =head1 SYNOPSIS use Log::Agent; require Log::Agent::Driver::File; my $driver = Log::Agent::Driver::File->make( -prefix => "prefix", -duperr => 1, -stampfmt => "own", -showpid => 1, -magic_open => 0, -channels => { error => '/tmp/output.err', output => 'log.out', debug => '../appli.debug', }, -chanperm => { error => 0777, output => 0666, debug => 0644 } ); logconfig(-driver => $driver); =head1 DESCRIPTION The file logging driver redirects logxxx() operations to specified files, one per channel usually (but channels may go to the same file). The creation routine make() takes the following arguments: =over 4 =item C<-channels> => I Specifies where channels go. The supplied hash maps channel names (C, C and C) to filenames. When C<-magic_open> is set to true, filenames are allowed magic processing via perl's open(), so this allows things like: -channels => { 'error' => '>&FILE', 'output' => '>newlog', # recreate each time, don't append 'debug' => '|mailx -s whatever user', } If a channel (e.g. 'output') is not specified, it will go to the 'error' channel, and if that one is not specified either, it will go to STDERR instead. If you have installed the additional C module, it is also possible to override any default rotating policy setup via the C<-rotate> argument: instead of supplying the channel as a single string, use an array reference where the first item is the channel file, and the second one is the C configuration: my $rotate = Log::Agent::Rotate->make( -backlog => 7, -unzipped => 2, -max_write => 100_000, -is_alone => 1, ); my $driver = Log::Agent::Driver::File->make( ... -channels => { 'error' => ['errors', $rotate], 'output' => ['output, $rotate], 'debug' => ['>&FILE, $rotate], # WRONG }, -magic_open => 1, ... ); In the above example, the rotation policy for the C channel will not be activated, since the channel is opened via a I method. See L for more details. =item C<-chanperm> => I Specifies the file permissions for the channels specified by C<-channels>. The arguemtn is a hash ref, indexed by channel name, with numeric values. This option is only necessary to override the default permissions used by Log::Agent::Channel::File. It is generally better to leave these permissive and rely on the user's umask. See L for more details.. =item C<-duperr> => I When true, all messages normally sent to the C channel are also copied to the C channel with a prefixing made to clearly mark them as such: "FATAL: " for logdie(), logcroak() and logconfess(), "ERROR: " for logerr() and "WARNING: " for logwarn(). Note that the "duplicate" is the original error string for logconfess() and logcroak(), and is not strictly identical to the message that will be logged to the C channel. This is a an accidental feature. Default is false. =item C<-file> => I This switch supersedes both C<-duperr> and C<-channels> by defining a single file for all the channels. =item C<-perm> => I This switch supersedes C<-chanperm> by defining consistent for all the channels. =item C<-magic_open> => I When true, channel filenames beginning with '>' or '|' are opened using Perl's open(). Otherwise, sysopen() is used, in append mode. Default is false. =item C<-prefix> => I The application prefix string to prepend to messages. =item C<-rotate> => I This sets a default logfile rotation policy. You need to install the additional C module to use this switch. I is the C instance describing the default policy for all the channels. Only files which are not opened via a so-called I can be rotated. =item C<-showpid> => I If set to true, the PID of the process will be appended within square brackets after the prefix, to all messages. Default is false. =item C<-stampfmt> => (I | I) Specifies the time stamp format to use. By default, my "own" format is used. The following formats are available: date "[Fri Oct 22 16:23:10 1999]" none own "99/10/22 16:23:10" syslog "Oct 22 16:23:10". You may also specify a CODE ref: that routine will be called every time we need to compute a time stamp. It should not expect any parameter, and should return a string. =back =head1 CHANNELS All the channels go to the specified files. If a channel is not configured, it is redirected to 'error', or STDERR if no 'error' channel was configured either. Two channels not opened via a I open and whose logfile name is the same are effectively I, i.e. the same file descriptor is used for both of them. If you supply distinct rotation policies (e.g. by having a default policy, and supplying another policy to one of the channel only), then the final rotation policy will depend on which one was opened first. So don't do that. =head1 CAVEAT Beware of chdir(). If your program uses chdir(), you should always specify logfiles by using absolute paths, otherwise you run the risk of having your relative paths become invalid: there is no anchoring done at the time you specify them. This is especially true when configured for rotation, since the logfiles are recreated as needed and you might end up with many logfiles scattered throughout all the directories you chdir()ed to. Logging channels with the same pathname are shared, i.e. they are only opened once by C. Therefore, if you specify different rotation policy to such channels, the channel opening order will determine which of the policies will be used for all such shared channels. Such errors are flagged at runtime with the following message: Rotation for 'logfile' may be wrong (shared with distinct policies) emitted in the logs upon subsequent sharing. =head1 AUTHORS Originally written by Raphael Manfredi ERaphael_Manfredi@pobox.comE, currently maintained by Mark Rogaski Emrogaski@cpan.orgE. Thanks to Joseph Pepin for suggesting the file permissions arguments to make(). =head1 LICENSE Copyright (C) 1999 Raphael Manfredi. Copyright (C) 2002 Mark Rogaski; all rights reserved. See L or the README file included with the distribution for license information. =head1 SEE ALSO Log::Agent::Driver(3), Log::Agent(3), Log::Agent::Rotate(3). =cut Log-Agent-1.005/Agent/Driver/Default.pm0000644000000000000000000001057514034707532016222 0ustar rootroot########################################################################### # # Default.pm # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use strict; require Log::Agent::Driver; ######################################################################## package Log::Agent::Driver::Default; use vars qw(@ISA); @ISA = qw(Log::Agent::Driver); # # ->make -- defined # # Creation routine. # sub make { my $self = bless {}, shift; my ($prefix) = @_; $self->_init($prefix, 0); # 0 is the skip Carp penalty select((select(main::STDERR), $| = 1)[0]); # Autoflush return $self; } # # ->prefix_msg -- defined # # Prepend "prefix: " to the error string, or nothing if no prefix, in which # case we capitalize the very first letter of the string. # sub prefix_msg { my $self = shift; my ($str) = @_; my $prefix = $self->prefix; return ucfirst($str) if !defined($prefix) || $prefix eq ''; return "$prefix: " . $str; } # # ->write -- defined # sub write { my $self = shift; my ($channel, $priority, $logstring) = @_; local $\ = undef; print main::STDERR "$logstring\n"; } # # ->channel_eq -- defined # # All channels equals here # sub channel_eq { my $self = shift; return 1; } # # ->logconfess -- redefined # # Fatal error, with stack trace # sub logconfess { my $self = shift; my ($str) = @_; require Carp; my $msg = $self->carpmess(0, $str, \&Carp::longmess); die $self->prefix_msg("$msg\n"); } # # ->logcluck -- redefined # # Warning, with stack trace # sub logcluck { my $self = shift; my ($str) = @_; require Carp; my $msg = $self->carpmess(0, $str, \&Carp::longmess); warn $self->prefix_msg("$msg\n"); } # # ->logxcroak -- redefined # # Fatal error, from perspective of caller # sub logxcroak { my $self = shift; my ($offset, $str) = @_; require Carp; my $msg = $self->carpmess($offset, $str, \&Carp::shortmess); die $self->prefix_msg("$msg\n"); } # # ->logdie -- redefined # # Fatal error # sub logdie { my $self = shift; my ($str) = @_; die $self->prefix_msg("$str\n"); } # # ->logerr -- redefined # # Signal error on stderr # sub logerr { my $self = shift; my ($str) = @_; warn $self->prefix_msg("$str\n"); } # # ->logwarn -- redefined # # Warn, with "WARNING" clearly emphasized # sub logwarn { my $self = shift; my ($str) = @_; $str->prepend("WARNING: "); warn $self->prefix_msg("$str\n"); } # # ->logxcarp -- redefined # # Warn from perspective of caller, with "WARNING" clearly emphasized. # sub logxcarp { my $self = shift; my ($offset, $str) = @_; $str->prepend("WARNING: "); require Carp; my $msg = $self->carpmess($offset, $str, \&Carp::shortmess); warn $self->prefix_msg("$msg\n"); } 1; # for require __END__ =head1 NAME Log::Agent::Driver::Default - default logging driver for Log::Agent =head1 SYNOPSIS # Implicit use use Log::Agent; logconfig(-prefix => "prefix"); # optional # Explicit use use Log::Agent; require Log::Agent::Driver::Default; my $driver = Log::Agent::Driver::Default->make("prefix"); logconfig(-driver => $driver); =head1 DESCRIPTION The default logging driver remaps the logxxx() operations to their default Perl counterpart. For instance, logerr() will issue a warn() and logwarn() will call warn() with a clear "WARNING: " emphasis (to distinguish between the two calls). The only routine of interest here is the creation routine: =over 4 =item make($prefix) Create a Log::Agent::Driver::Default driver whose prefix string will be $prefix. When no prefix is configured, the first letter of each logged string will be uppercased. =back =head1 CHANNELS The C, C and C channels all go to STDERR. =head1 BUGS If logdie() is used within an eval(), the string you will get in $@ will be prefixed. It's not really a bug, simply that wrapping a code into eval() and parsing $@ is poor's man exception handling which shows its limit here: since the programmer using logdie() cannot foresee which driver will be used, the returned string cannot be determined precisely. Morality: use die() if you mean it, and document the string as an exception. =head1 AUTHOR Raphael Manfredi FRaphael_Manfredi@pobox.comE> =head1 SEE ALSO Log::Agent::Driver(3), Log::Agent(3). =cut Log-Agent-1.005/Agent/Driver/Syslog.pm0000644000000000000000000000772314034707532016117 0ustar rootroot########################################################################### # # Syslog.pm # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use strict; ######################################################################## package Log::Agent::Driver::Syslog; require Log::Agent::Driver; use vars qw(@ISA); @ISA = qw(Log::Agent::Driver); require Log::Agent::Channel::Syslog; # # ->make -- defined # # Creation routine. # # All switches are passed to Log::Agent::Channel::Syslog. # # prefix the application name # facility the syslog facility name to use ("auth", "daemon", etc...) # showpid whether to show pid # socktype socket type ('unix' or 'inet') # logopt list of openlog() options: 'ndelay', 'cons' or 'nowait' # sub make { my $self = bless {}, shift; my (%args) = @_; my $prefix; my %set = ( -prefix => \$prefix, # Handled by parent via _init ); while (my ($arg, $val) = each %args) { my $vset = $set{lc($arg)}; next unless ref $vset; $$vset = $val; } $self->{channel} = Log::Agent::Channel::Syslog->make(@_); $self->_init($prefix, 0); # 0 is the skip Carp penalty return $self; } sub channel { $_[0]->{channel} } # # ->prefix_msg -- defined # # NOP -- syslog will handle this # sub prefix_msg { my $self = shift; return $_[0]; } # # ->channel_eq -- defined # # Always true. # sub channel_eq { return 1; } my %syslog_pri = ( 'em' => 'emerg', 'al' => 'alert', 'cr' => 'crit', 'er' => 'err', 'wa' => 'warning', 'no' => 'notice', 'in' => 'info', 'de' => 'debug' ); # # ->map_pri -- redefined # # Levels ignored, only priorities matter. # sub map_pri { my $self = shift; my ($priority, $level) = @_; return $syslog_pri{lc(substr($priority, 0, 2))} || 'debug'; } # # ->write -- defined # # $channel is ignored # sub write { my $self = shift; my ($channel, $priority, $logstring) = @_; $self->channel->write($priority, $logstring); } 1; # for require __END__ =head1 NAME Log::Agent::Driver::Syslog - syslog logging driver for Log::Agent =head1 SYNOPSIS use Log::Agent; require Log::Agent::Driver::Syslog; my $driver = Log::Agent::Driver::Syslog->make( -prefix => prefix, -facility => "user", -showpid => 1, -socktype => { port => 514, proto => "udp" }, -logopt => "ndelay", ); logconfig(-driver => $driver); =head1 DESCRIPTION The syslog logging driver delegates logxxx() operations to syslog() via the Sys::Syslog(3) interface. The creation routine make() takes the following switches: =over 4 =item C<-facility> => I Tell syslog() which facility to use (e.g. "user", "auth", "daemon"). Unlike the Sys::Syslog(3) interface, the facility is set once and for all: every logging message will use the same facility. If you wish to log something to "auth" for instance, then do so via Sys::Syslog directly: there is no guarantee that the application will configure its Log::Agent to use syslog anyway! =item C<-logopt> => I Specifies logging options, under the form of a string containing zero or more of the words I, I or I. =item C<-prefix> => I The I here is syslog's identification string. =item C<-showpid> => I Set to true to have the PID of the process logged. It is false by default. =item C<-socktype> => I Specifies the logging socket to use (protocol, destination, etc.). The value given is not interpreted and passed as-is to the C routine in Sys::Syslog(3). Please refer to Log::Agent::Channel::Syslog(3) for more information. =back =head1 CHANNELS All the channels go to syslog(), of course. =head1 AUTHOR Raphael Manfredi FRaphael_Manfredi@pobox.comE> =head1 SEE ALSO Log::Agent::Driver(3), Log::Agent::Channel::Syslog(3), Sys::Syslog(3). =cut Log-Agent-1.005/Agent/Driver/Fork.pm0000644000000000000000000001530314034707532015531 0ustar rootroot########################################################################### # # Fork.pm # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## package Log::Agent::Driver::Fork; use strict; require Log::Agent::Driver; use vars qw(@ISA); @ISA = qw(Log::Agent::Driver); ########################################################################### # # Public Methods # ########################################################################### # # make # # constructor method # sub make { my $class = shift; # initialize the dispatcher my $self = { drivers => [] }; bless $self, $class; $self->_init('', 0); # test for 5.6 $^W = 0; my $new_perl = eval "$^V and $^V ge v5.6.0" || 0; $^W = 1; # process the arguments foreach my $arg (@_) { if (ref $arg) { # add to the list of drivers push(@{$self->{drivers}}, $arg); } else { require Carp; Carp::croak("argument is not an object reference: $arg"); } } return $self; } # # prefix_msg # # does little of value # sub prefix_msg { return $_[1]; } # # write # # pass-through to drivers # sub write { my($self, $channel, $priority, $str) = @_; foreach my $driver (@{$self->{drivers}}) { $driver->write($channel, $priority, $str); } } # # emit # # wrapper for write() that uses dynamically bound priority() and prefix_msg() # methods # sub emit { my($self, $channel, $priority, $str) = @_; foreach my $driver (@{$self->{drivers}}) { $driver->emit($channel, $priority, $str); # This is a kludge to make duperr work in file driver, # the encapsulation purists should lynch me for this. if ($driver->isa('Log::Agent::Driver::File')) { if ($driver->duperr) { if ($priority eq 'critical') { $driver->emit_output('critical', 'FATAL', $str); } elsif ($priority eq 'error') { $driver->emit_output('error', 'ERROR', $str); } elsif ($priority eq 'warning') { $driver->emit_output('warning', 'WARNING', $str); } } } } } # # emit_carp # # A specialized wrapper to hand-off carp/croak messages at a # specified offset. # sub emit_carp { my($self, $channel, $priority, $offset, $str) = @_; # yet another kludge $offset++ if (caller(3))[3] =~ /^main::/; foreach my $driver (@{$self->{drivers}}) { # construct the message require Carp; my $msg = $driver->carpmess($offset, $str, \&Carp::shortmess); # send it to the driver $driver->emit($channel, $priority, $str); } } # # channel_eq # # exhaustive equality comparison # sub channel_eq { my $self = shift; foreach my $driver (@{$self->{drivers}}) { $driver->channel_eq(@_) || return; } return 1; } # # logconfess # # Fatal error, with stack trace # sub logconfess { my($self, $str) = @_; # log error to all drivers $self->emit_carp('error', 'critical', 0, $str); die; } # # logcroak # # Fatal error # sub logcroak { my($self, $str) = @_; # # log error to all drivers # $self->emit_carp('error', 'critical', 0, $str); die; } # # logxcroak # # Fatal error, from perspective of caller # sub logxcroak { my($self, $offset, $str) = @_; # # log error to all drivers # $self->emit_carp('error', 'critical', $offset, $str); die; } # # logdie # # Fatal error # sub logdie { my ($self, $str) = @_; # # log error to all drivers # $self->emit('error', 'critical', $str); die; } # # logerr # # Signal error on stderr # sub logerr { my ($self, $str) = @_; # # log error to all drivers # $self->emit('error', 'error', $str); } # # logwarn # # Warn, with "WARNING" clearly emphasized # sub logwarn { my ($self, $str) = @_; # # log error to all drivers # $self->emit('error', 'warning', $str); } # # logcluck # # Warning, with stack trace # sub logcluck { my($self, $str) = @_; # log error to all drivers $self->emit_carp('error', 'warning', 0, $str); } # # logcarp # # log a warning, carp-style # sub logcarp { my($self, $str) = @_; # # log message to all drivers # $self->emit_carp('error', 'warning', 0, $str); } # # logxcarp # # Warn from perspective of caller # sub logxcarp { my($self, $offset, $str) = @_; # # log message to all drivers # $self->emit_carp('error', 'warning', $offset, $str); } # # logsay # # Log message to "output" channel at "notice" priority # sub logsay { my($self, $str) = @_; # # send message to drivers # $self->emit('output', 'notice', $str); } # # loginfo # # Log message to "output" channel at "info" priority # sub loginfo { my($self, $str) = @_; # # send message to drivers # $self->emit('output', 'info', $str); } # # logdebug # # Log message to "output" channel at "debug" priority # sub logdebug { my($self, $str) = @_; # # send message to drivers # $self->emit('output', 'debug', $str); } 1; # for require __END__ =head1 NAME Log::Agent::Driver::Fork - dummy driver for forking output to multiple drivers =head1 SYNOPSIS use Log::Agent; require Log::Agent::Driver::Fork; require Log::Agent::Driver::Foo; require Log::Agent::Driver::Bar; my $driver = Log::Agent::Driver::Fork->make( Log::Agent::Driver::Foo->make( ... ), Log::Agent::Driver::Bar->make( ... ) ); logconfig(-driver => $driver); =head1 DESCRIPTION This driver merely acts a multiplexer for logxxx() calls, duplicating them and distributing them to other drivers. The only routine of interest here is the creation routine: =over 4 =item make(@drivers) Create a Log::Agent::Driver::Fork driver that duplicates logxxx() calls and distributes them to the drivers in @drivers. The arguments must be the return value of the make() call for the client drivers. =back =head1 NOTES Many thanks go to Daniel Lundin and Jason May who proposed this module independently. Eventually, logconfig() will support multiple drivers directly. But, for now, this solution requires no change to the existing interface. =head1 AUTHOR Mark Rogaski Emrogaski@pobox.comE =head1 LICENSE Copyright (C) 2002 Mark Rogaski; all rights reserved. See L or the README file included with the distribution for license information. =head1 SEE ALSO L, L. =cut Log-Agent-1.005/Agent/Driver/Datum.pm0000644000000000000000000001033114034707532015676 0ustar rootroot########################################################################### # # Datum.pm # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use strict; require Log::Agent::Driver; ######################################################################## package Log::Agent::Driver::Datum; use vars qw(@ISA); @ISA = qw(Log::Agent::Driver); # # ->make -- defined # # Creation routine. # # Attributes: # driver the underlying driver originally configured # sub make { my $self = bless {}, shift; my ($driver) = @_; $self->_init('', 0); # 0 is the skip Carp penalty $self->{driver} = $driver; $driver->add_penalty(2); # We're intercepting the calls return $self; } # # Attribute access # sub prefix { $_[0]->{driver}->prefix } sub driver { $_[0]->{driver} } # # Cannot-be-called routines. # sub prefix_msg { require Carp; Carp::confess("prefix_msg") } sub emit { require Carp; Carp::confess("emit") } # # ->channel_eq -- defined # # Redirect comparison to driver. # sub channel_eq { my $self = shift; my ($chan1, $chan2) = @_; return $self->driver->channel_eq($chan1, $chan2); } # # ->datum_trace # # Emit a Carp::Datum trace, which will be a logwrite() on the 'debug' channel. # sub datum_trace { my $self = shift; my ($str, $tag) = @_; require Carp::Datum; Carp::Datum::trace($str, $tag); } # # intercept # # Intercept call to driver by calling ->datum_trace() first, then resume # regular operation on the driver, if the channel where message would go # is not the same as the debug channel. # sub intercept { my ($aref, $tag, $op, $chan, $prepend) = @_; my $self = shift @$aref; # # $aref can be [$str] or [$offset, $str] # my $pstr = $aref->[$#$aref]; # String is last argument if (defined $prepend) { $pstr = $pstr->clone; # We're prepending tag on a copy $pstr->prepend("$prepend: "); } $self->datum_trace($pstr, $tag); my $driver = $self->driver; if ($driver->channel_eq('debug', $chan)) { die "$pstr\n" if $prepend eq 'FATAL'; } else { $driver->$op(@$aref); } } # # Interface interception. # # The string will be tagged with ">>" to make it clear it comes from Log::Agent, # unless it's a fatal string from logconfess/logcarp/logdie, in wich case # it is tagged with "**". # sub logconfess { intercept(\@_, '**', 'logconfess', 'error', 'FATAL') } sub logxcroak { intercept(\@_, '**', 'logxcroak', 'error', 'FATAL') } sub logdie { intercept(\@_, '**', 'logdie', 'error', 'FATAL') } sub logerr { intercept(\@_, '>>', 'logerr', 'error', 'ERROR') } sub logcluck { intercept(\@_, '>>', 'logcluck', 'error', 'WARNING') } sub logwarn { intercept(\@_, '>>', 'logwarn', 'error', 'WARNING') } sub logxcarp { intercept(\@_, '>>', 'logxcarp', 'error', 'WARNING') } sub logsay { intercept(\@_, '>>', 'logsay', 'output') } sub loginfo { intercept(\@_, '>>', 'loginfo', 'output') } sub logdebug { intercept(\@_, '>>', 'logdebug', 'output') } # # logwrite -- redefined # # Emit the message to the specified channel # sub logwrite { my $self = shift; my ($chan, $prio, $level, $str) = @_; # # Have to be careful not to recurse through ->datum_trace(). # Look at who is calling us (immediate caller is Log::Agent). # my $pkg = caller(1); if ($pkg =~ /^Carp::Datum\b/) { my $drv = $self->driver; return unless defined $drv; # Can happen during global destruct $drv->logwrite($chan, $prio, $level, $str); return; } # # The following will recurse back to us, but the above check will # cut the recursion. # intercept([$self, $str], '>>', 'logwrite', $chan); } __END__ =head1 NAME Log::Agent::Driver::Datum - interceptor driver to cooperate with Carp::Datum =head1 SYNOPSIS NONE =head1 DESCRIPTION The purpose of the interceptor is to cooperate with Carp::Datum by emitting traces to the debug channel via Carp::Datum's traces facilities. This driver is automatically installed by Log::Agent when Carp::Datum is in use and debug was activated through it. =head1 AUTHOR Raphael Manfredi FRaphael_Manfredi@pobox.comE> =head1 SEE ALSO Carp::Datum(3). =cut Log-Agent-1.005/Agent/Driver/Mail.pm0000644000000000000000000001014714034707532015513 0ustar rootroot########################################################################### # # Mail.pm # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## package Log::Agent::Driver::Mail; use strict; use Mail::Mailer; require Log::Agent::Driver; use vars qw(@ISA); @ISA = qw(Log::Agent::Driver); ########################################################################### # # Public Methods # ########################################################################### # # make -- driver constructor # sub make { my $self = bless { prefix => '', to => (getpwuid $<)[0], cc => '', bcc => '', subject => '', from => '', priority => '', reply_to => '', mailer => [] }, shift; my (%args) = @_; foreach my $key (keys %args) { if ($key =~ /^-(to|cc|bcc|prefix|subject|from|priority|reply_to| mailer)$/x) { $self->{$1} = $args{$key}; } else { use Carp; croak "invalid argument: $key"; } } $self->_init($self->{prefix}, 0); return $self; } # # chan_eq -- not much of anything at the moment # sub chan_eq { my($self, $chan0, $chan1) = @_; return $chan0 eq $chan1; } # # write -- send a message to the channel # sub write { my($self, $chan, $prio, $mesg) = @_; my(%headers); foreach my $hdr (qw( to cc bcc subject from priority reply_to )) { my $fhdr = ucfirst($hdr); $fhdr =~ s/_/-/g; $headers{$fhdr} = $self->{$hdr} unless $self->{$hdr} eq ''; } my $mailer = Mail::Mailer->new(@{$self->{mailer}}); $mailer->open(\%headers); print $mailer $mesg, "\n"; $mailer->close; } # # prefix_msg -- add prefix # sub prefix_msg { my($self, $str) = @_; return ($self->{prefix} ? $self->{prefix} . ' ' : '') . $str; } __END__ =head1 NAME Log::Agent::Driver::Mail - email driver for Log::Agent =head1 SYNOPSIS use Log::Agent; require Log::Agent::Driver::Mail; my $driver = Log::Agent::Driver::Mail->make( -to => 'oncall@example.org', -cc => [ qw( noc@example.org admin@example,net ) ], -subject => "ALERT! ALERT!", -mailer => [ 'smtp', Server => 'mail.example.net' ] ); logconfig(-driver => $driver); =head1 DESCRIPTION This driver maps the logxxx() calls to email messages. Each call generates a separate email message. The Mail::Mailer module is required. =head1 CONSTRUCTOR =head2 B The OPTIONS argument is a hash with the following keys: =over 8 =item B<-prefix> An optional prefix for the message body. =item B<-to> The destination addresses, may be a scalar containing a valid email address or a reference to an array of addresses. =item B<-reply_to> The reply-to addresses, may be a scalar containing a valid email address or a reference to an array of addresses. =item B<-from> The source address, must be a scalar containing a valid email address. =item B<-subject> The subject line of the email message. =item B<-cc> The carbon copy addresses, may be a scalar containing a valid email address or a reference to an array of addresses. =item B<-bcc> The blind carbon copy addresses, may be a scalar containing a valid email address or a reference to an array of addresses. =item B<-priority> The priority level for the email message. This is NOT related to the logging priority. =item B<-mailer> A reference to an array containing the optional arguments to Mail::Mailer->new(). Generally, this can be omitted. =back =head1 NOTES Thanks to Shirley Wang for the idea for this module. =head1 AUTHOR Mark Rogaski Emrogaski@pobox.comE =head1 LICENSE Copyright (C) 2002 Mark Rogaski; all rights reserved. See L or the README file included with the distribution for license information. =head1 SEE ALSO L, L, L. Log-Agent-1.005/Agent/Driver/Silent.pm0000644000000000000000000000406314034707532016067 0ustar rootroot########################################################################### # # Silent.pm # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use strict; require Log::Agent::Driver; ######################################################################## package Log::Agent::Driver::Silent; use vars qw(@ISA); @ISA = qw(Log::Agent::Driver); # # ->make -- defined # # Creation routine. # sub make { my $self = bless {}, shift; return $self; } # # NOP routines. # sub prefix_msg {} sub emit {} sub channel_eq { 1 } # # In theory, we could live with the above NOP ops and the logxxx() # routines would not do anything. Let's redefine them though... # sub logerr {} sub logwarn {} sub logcluck {} sub logsay {} sub loginfo {} sub logdebug {} sub logwrite {} sub logxcarp {} # # Those need minimal processing. # We explicitely stringify the string argument (uses overloaded "" method) # sub logconfess { require Carp; Carp::confess("$_[1]"); } sub logdie { die "$_[0]\n"; } # # ->logxcroak -- redefined # # Handle the offset parameter correctly # sub logxcroak { my $self = shift; my ($offset, $str) = @_; require Carp; my $msg = $self->carpmess($offset, $str, \&Carp::shortmess); die "$msg\n"; } 1; # for require __END__ =head1 NAME Log::Agent::Driver::Silent - silent logging driver for Log::Agent =head1 SYNOPSIS use Log::Agent; require Log::Agent::Driver::Silent; my $driver = Log::Agent::Driver::Silent->make(); logconfig(-driver => $driver); =head1 DESCRIPTION The silent logging driver remaps most of the logxxx() operations to NOPs. Only logconfess() and logdie() respectively call Carp::confess() and die(). =head1 CHANNELS All the channels go to /dev/null, so to speak. =head1 AUTHOR Raphael Manfredi FRaphael_Manfredi@pobox.comE> =head1 SEE ALSO Log::Agent::Driver(3), Log::Agent(3). =cut Log-Agent-1.005/Agent/Tag_List.pm0000644000000000000000000000474214034707532015110 0ustar rootroot########################################################################### # # Tag_List.pm # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use strict; ######################################################################## package Log::Agent::Tag_List; require Tie::Array; # contains Tie::StdArray use vars qw(@ISA); @ISA = qw(Tie::StdArray); # # A list of all log message tags recorded, with dedicated methods to # manipulate them. # # # ->make # # Creation routine. # sub make { my $self = bless [], shift; my (@tags) = @_; @$self = @tags; return $self; } # # _typecheck # # Make sure only objects of the proper type are given in the list. # Croaks when type checking detects an error. # sub _typecheck { my $self = shift; my ($type, $list) = @_; my @bad = grep { !ref $_ || !$_->isa($type) } @$list; return unless @bad; my $first = $bad[0]; require Carp; Carp::croak(sprintf "Expected list of $type, got %d bad (first one is $first)", scalar(@bad)); } # # ->append # # Append list of Log::Agent::Tag objects to current list. # sub append { my $self = shift; my (@tags) = @_; $self->_typecheck("Log::Agent::Tag", \@tags); push @$self, @tags; } # # ->prepend # # Prepend list of Log::Agent::Tag objects to current list. # sub prepend { my $self = shift; my (@tags) = @_; $self->_typecheck("Log::Agent::Tag", \@tags); unshift @$self, @tags; } 1; # for require __END__ =head1 NAME Log::Agent::Tag_List - user-defined tags to add to every log =head1 SYNOPSIS use Log::Agent qw(logtags); my $taglist = logtags(); $taglist->append(@tags); # adds @tags at the tail of list $taglist->prepend(@tags); # adds @tags at the head of list =head1 DESCRIPTION This class handles the list of user-defined tags, which are added to each log message. The initial list is taken from the C<-tags> argument of the logconfig() routine. See Log::Agent(3). =head1 INTERFACE The following interface is available: =over 4 =item append I Append I of C objects to the existing list. =item prepend I Prepends I of C objects to the existing list. =back =head1 AUTHOR Raphael Manfredi FRaphael_Manfredi@pobox.comE> =head1 SEE ALSO Log::Agent(3), Log::Agent::Tag(3). =cut Log-Agent-1.005/Agent/Tag/0000755000000000000000000000000014034707532013550 5ustar rootrootLog-Agent-1.005/Agent/Tag/Callback.pm0000644000000000000000000000773214034707532015613 0ustar rootroot########################################################################### # # Callback.pm # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use strict; ######################################################################## package Log::Agent::Tag::Callback; require Log::Agent::Tag; use vars qw(@ISA); @ISA = qw(Log::Agent::Tag); # # ->make # # Creation routine. # # Calling arguments: a hash table list. # # The keyed argument list may contain: # -POSTFIX whether to postfix log message or prefix it. # -SEPARATOR separator string to use between tag and message # -NAME tag's name (optional) # -CALLBACK Callback object # # Attributes: # callback the Callback object # sub make { my $self = bless {}, shift; my (%args) = @_; my ($name, $postfix, $separator, $callback); my %set = ( -name => \$name, -callback => \$callback, -postfix => \$postfix, -separator => \$separator, ); while (my ($arg, $val) = each %args) { my $vset = $set{lc($arg)}; next unless ref $vset; $$vset = $val; } unless (defined $callback) { require Carp; Carp::croak("Argument -callback is mandatory"); } unless (ref $callback && $callback->isa("Callback")) { require Carp; Carp::croak("Argument -callback needs a Callback object"); } $self->_init($name, $postfix, $separator); $self->{callback} = $callback; return $self; } # # Attribute access # sub callback { $_[0]->{callback} } # # Defined routines # # # ->string -- defined # # Build tag string by invoking callback. # sub string { my $self = shift; # # Avoid recursion, which could happen if another logxxx() call is made # whilst within the callback. # # Assumes mono-threaded application. # return sprintf 'callback "%s" busy', $self->name if $self->{busy}; $self->{busy} = 1; my $string = $self->callback->call(); $self->{busy} = 0; return $string; } 1; # for "require" __END__ =head1 NAME Log::Agent::Tag::Callback - a dynamic tag string =head1 SYNOPSIS require Log::Agent::Tag::Callback; # Inherits from Log::Agent::Tag. my $tag = Log::Agent::Tag::Callback->make( -name => "session id", -callback => Callback->new($obj, 'method', @args), -postfix => 1, -separator => " -- ", ); =head1 DESCRIPTION This class represents a dynamic tag string, whose value is determined by invoking a pre-determined callback, which is described by a C object. You need to make your application depend on the C module from CPAN if you make use of this tagging feature, since C does not depend on it, on purpose (it does not really use it, it only offers an interface to plug it in). At least version 1.02 must be used. =head1 CREATION ROUTINE PARAMETERS The following parameters are defined, in alphabetical order: =over 4 =item C<-callback> => C I The callback to invoke to determine the value of the tag. The call is protected via a I flag, in case there is an unwanted recursion due to a call to one of the logging routines whilst within the callback. If the callback is busy, the tag emitted is: callback "user" busy assuming C is the name you supplied via C<-name> for this tag. =item C<-name> => I The name of this tag. Used to flag a callback as I in case there is an unwanted recursion into the callback routine. =item C<-postfix> => I Whether tag should be placed after or before the log message. By default, it is prepended to the log message, i.e. this parameter is false. =item C<-separator> => I The separation string between the tag and the log message. A single space by default. =back =head1 AUTHOR Raphael Manfredi FRaphael_Manfredi@pobox.comE> =head1 SEE ALSO Callback(3), Log::Agent::Tag(3), Log::Agent::Message(3). =cut Log-Agent-1.005/Agent/Tag/String.pm0000644000000000000000000000466414034707532015366 0ustar rootroot########################################################################### # # String.pm # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use strict; ######################################################################## package Log::Agent::Tag::String; require Log::Agent::Tag; use vars qw(@ISA); @ISA = qw(Log::Agent::Tag); # # ->make # # Creation routine. # # Calling arguments: a hash table list. # # The keyed argument list may contain: # -POSTFIX whether to postfix log message or prefix it. # -SEPARATOR separator string to use between tag and message # -NAME tag's name (optional) # -VALUE string value to use # # Attributes: # string the string value # sub make { my $self = bless {}, shift; my (%args) = @_; my ($name, $postfix, $separator, $value); my %set = ( -name => \$name, -value => \$value, -postfix => \$postfix, -separator => \$separator, ); while (my ($arg, $val) = each %args) { my $vset = $set{lc($arg)}; next unless ref $vset; $$vset = $val; } $self->_init($name, $postfix, $separator); $self->{string} = $value; return $self; } # # Defined routines # sub string { $_[0]->{'string'} } 1; # for "require" __END__ =head1 NAME Log::Agent::Tag::String - a constant tag string =head1 SYNOPSIS require Log::Agent::Tag::String; # Inherits from Log::Agent::Tag. my $tag = Log::Agent::Tag::String->make( -name => "session id", -value => $session, -postfix => 1, -separator => " -- ", ); =head1 DESCRIPTION This class represents a constant tag string. =head1 CREATION ROUTINE PARAMETERS The following parameters are defined, in alphabetical order: =over 4 =item C<-name> => I The name of this tag. Currently unused. =item C<-postfix> => I Whether tag should be placed after or before the log message. By default, it is prepended to the log message, i.e. this parameter is false. =item C<-separator> => I The separation string between the tag and the log message. A single space by default. =item C<-value> => I The tag's value. =back =head1 AUTHOR Raphael Manfredi FRaphael_Manfredi@pobox.comE> =head1 SEE ALSO Log::Agent::Tag(3), Log::Agent::Message(3). =cut Log-Agent-1.005/Agent/Tag/Priority.pm0000644000000000000000000001033514034707532015731 0ustar rootroot########################################################################### # # Priority.pm # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use strict; ######################################################################## package Log::Agent::Tag::Priority; require Log::Agent::Tag::String; use vars qw(@ISA); @ISA = qw(Log::Agent::Tag::String); use Log::Agent::Priorities qw(level_from_prio prio_from_level); # # ->make # # Creation routine. # # Calling arguments: a hash table list. # # The keyed argument list may contain: # -POSTFIX whether to postfix log message or prefix it. # -SEPARATOR separator string to use between tag and message # -DISPLAY a string like '[$priority:$level])' # -PRIORITY the log priority string, e.g. "warning". # -LEVEL the log level value, e.g. 4. # # Attributes: # none, besides the inherited ones # sub make { my $type = shift; my (%args) = @_; my $separator = " "; my $postfix = 0; my ($display, $priority, $level); my %set = ( -display => \$display, -postfix => \$postfix, -separator => \$separator, -priority => \$priority, -level => \$level, ); while (my ($arg, $val) = each %args) { my $vset = $set{lc($arg)}; next unless ref $vset; $$vset = $val; } # # Normalize $priority to the full name (e.g. "err" -> "error") # $priority = prio_from_level level_from_prio $priority; # # Format according to -display specs. # # Since priority and level are fixed for this object, the resulting # string need only be computed once, i.e. now. # # The following variables are recognized: # # $priority priority name (e.g. "warning") # $level logging level # # We recognize both $level and ${level}. # $display =~ s/\$priority\b/$priority/g; $display =~ s/\$\{priority}/$priority/g; $display =~ s/\$level\b/$level/g; $display =~ s/\$\{level}/$level/g; # # Now create the constant tag string. # my $self = Log::Agent::Tag::String->make( -name => "priority", -value => $display, -postfix => $postfix, -separator => $separator, ); return bless $self, $type; # re-blessed in our package } 1; # for "require" __END__ =head1 NAME Log::Agent::Tag::Priority - a log priority tag string =head1 SYNOPSIS Not intended to be used directly Inherits from Log::Agent::Tag. =head1 DESCRIPTION This class represents a log priority tag string. =head1 CREATION ROUTINE PARAMETERS The following parameters are defined, in alphabetical order: =over 4 =item C<-display> => I Specifies the priority/level string to display, with minimal variable substitution. For instance: -display => '[$priority/$level]' The defined variables are documented in the B section underneath. =item C<-level> => I This parameter is internally added by C when computing the priority tag, since only it knows the level of the current message. =item C<-postfix> => I Whether tag should be placed after or before the log message. By default, it is prepended to the log message, i.e. this parameter is false. =item C<-priority> => I This parameter is internally added by C when computing the priority tag, since only it knows the priority of the current message. =item C<-separator> => I The separation string between the tag and the log message. A single space by default. =back =head1 DISPLAY VARIABLES The C<-display> switch understands a few variables that can be substituted in the supplied string. Both $var and C<${var}> forms are supported. Unknown variables are left untouched. =over 4 =item C<$priority> The full priority name of the logged message, e.g. "warning" or "error". =item C<$level> The associated priority level of the logged message, a number. For instance, the level associated to "warning" is C<4>. See L for the default name -> level mapping. =back =head1 AUTHOR Raphael Manfredi FRaphael_Manfredi@pobox.comE> =head1 SEE ALSO Log::Agent::Tag(3), Log::Agent::Message(3), Log::Agent::Priorities(3). =cut Log-Agent-1.005/Agent/Tag/Caller.pm0000644000000000000000000002235414034707532015316 0ustar rootroot########################################################################### # # Caller.pm # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use strict; ######################################################################## package Log::Agent::Tag::Caller; require Log::Agent::Tag; use vars qw(@ISA); @ISA = qw(Log::Agent::Tag); # # ->make # # Creation routine. # # Calling arguments: a hash table list. # # The keyed argument list may contain: # -OFFSET value for the offset attribute [NOT DOCUMENTED] # -INFO string of keywords like "package filename line subroutine" # -FORMAT formatting instructions, like "%s:%d", used along with -INFO # -POSTFIX whether to postfix log message or prefix it. # -DISPLAY a string like '($subroutine/$line)', supersedes -INFO # -SEPARATOR separator string to use between tag and message # # Attributes: # indices listref of indices to select in the caller() array # offset how many stack frames are between us and the caller we trace # format how to format extracted caller() info # postfix true if info to append to logged string # sub make { my $self = bless {}, shift; my (%args) = @_; $self->{'offset'} = 0; my $info; my $postfix = 0; my $separator; my %set = ( -offset => \$self->{'offset'}, -info => \$info, -format => \$self->{'format'}, -postfix => \$postfix, -display => \$self->{'display'}, -separator => \$separator, ); while (my ($arg, $val) = each %args) { my $vset = $set{lc($arg)}; next unless ref $vset; $$vset = $val; } $self->_init("caller", $postfix, $separator); return $self if $self->display; # A display string takes precedence # # pre-process info to compute the indices # my $i = 0; my %indices = map { $_ => $i++ } qw(pac fil lin sub); # abbrevs my @indices = (); foreach my $token (split(' ', $info)) { my $abbr = substr($token, 0, 3); push(@indices, $indices{$abbr}) if exists $indices{$abbr}; } $self->{'indices'} = \@indices; return $self; } # # Attribute access # sub offset { $_[0]->{'offset'} } sub indices { $_[0]->{'indices'} } sub format { $_[0]->{'format'} } sub display { $_[0]->{'display'} } sub postfix { $_[0]->{'postfix'} } # # expand_a # # Expand the %a macro and return new string. # if ($] >= 5.005) { eval q{ # if VERSION >= 5.005 # 5.005 and later version grok /(?= 5.005 */ # # ->string -- defined # # Compute string with properly formatted caller info # sub string { my $self = shift; # # The following code: # # sub foo { # my ($pack, $file, $line, $sub) = caller(0); # print "excuting $sub called at $file/$line in $pack"; # } # # will report who called us, except that $sub will be US, not our CALLER! # This is an "anomaly" somehow, and therefore to get the routine name # that called us, we need to move one frame above the ->offset value. # my @caller = caller($self->offset); # Kludge for anomalies in caller() # Thanks to Jeff Boes for finding the second one! $caller[3] = (caller($self->offset + 1))[3] || '(main)'; my ($package, $filename, $line, $subroutine) = @caller; # # If there is a display, it takes precedence and is formatted accordingly, # with limited variable substitution. The variables that are recognized # are: # # $package or $pack package name of caller # $filename or $file filename of caller # $line line number of caller # $subroutine or $sub routine name of caller # # We recognize both $line and ${line}, the difference being that the # first needs to be at a word boundary (i.e. $lineage would not result # in any expansion). # # Otherwise, the necessary information is gathered from the caller() # output, and formatted via sprintf, along with the special %a macro # which stands for all the information, separated by ':'. # # NB: The default format is "[%a]" for postfixed info, "(%a)" otherwise. # my $display = $self->display; if ($display) { $display =~ s/\$pack(?:age)?\b/$package/g; $display =~ s/\$\{pack(?:age)?}/$package/g; $display =~ s/\$file(?:name)?\b/$filename/g; $display =~ s/\$\{file(?:name)?}/$filename/g; $display =~ s/\$line\b/$line/g; $display =~ s/\$\{line}/$line/g; $display =~ s/\$sub(?:routine)?\b/$subroutine/g; $display =~ s/\$\{sub(?:routine)?}/$subroutine/g; } else { my @show = map { $caller[$_] } @{$self->indices}; my $format = $self->format || ($self->postfix ? "[%a]" : "(%a)"); $format = expand_a($format, \@show); # depends on Perl's version $display = sprintf $format, @show; } return $display; } 1; # for "require" __END__ =head1 NAME Log::Agent::Tag::Caller - formats caller information =head1 SYNOPSIS Not intended to be used directly Inherits from Log::Agent::Tag. =head1 DESCRIPTION This class handles caller information for Log::Agent services and is not meant to be used directly. This manpage therefore only documents the creation routine parameters that can be specified at the Log::Agent level via the C<-caller> switch in the logconfig() routine. =head1 CALLER INFORMATION ENTITIES This class knows about four entities: I, I, I and I, which are to be understood within the context of the Log::Agent routine being called (e.g. a logwarn() routine), namely: =over 4 =item package This is the package name where the call to the logwarn() routine was made. It can be specified as "pack" for short, or spelled out completely. =item filename This is the file where the call to the logwarn() routine was made. It can be specified as "file" for short, or spelled out completely. =item line This is the line number where the call to the logwarn() routine was made, in file I. The name is short enough to be spelled out completely. =item subroutine This is the subroutine where the call to the logwarn() routine was made. If the call is made outside a subroutine, this will be empty. The name is long enough to warrant the "sub" abbreviation if you don't wish to spell it out fully. =back =head1 CREATION ROUTINE PARAMETERS The purpose of those parameters is to define how caller information entities (as defined by the previous section) will be formatted within the log message. =over 4 =item C<-display> => I Specifies a string with minimal variable substitution: only the caller information entities specified above, or their abbreviation, will be interpolated. For instance: -display => '($package::$sub/$line)' Don't forget to use simple quotes to avoid having Perl interpolate those as variables, or escape their leading C<$> sign otherwise. Using this convention was deemed to more readable (and natural in Perl) than SGML entities such as "&pack;". Using this switch supersedes the C<-info> and C<-format> switches. =item C<-format> => I Formatting instructions for the caller information entities listed by the C<-info> switch. For instance: -format => "%s:%4d" if you have specified two entities in C<-info>. The special formatting macro C<%a> stands for all the entities specified by C<-info> and is rendered by a string where values are separated by ":". =item C<-info> => I<"space separated list of parameters"> Specifies a list of caller information entities that are to be formated using the C<-format> specification. For instance: -info => "pack sub line" would only report those three entites. =item C<-postfix> => I Whether the string resulting from the formatting of the caller information entities should be appended to the regular log message or not (i.e. prepended, which is the default). =item C<-separator> => I The separation string between the tag and the log message. A single space by default. =back =head1 AUTHORS Raphael Manfredi ERaphael_Manfredi@pobox.comE created the module, it is currently maintained by Mark Rogaski Emrogaski@cpan.orgE. Thanks to Jeff Boes for uncovering wackiness in caller(). =head1 LICENSE Copyright (C) 1999 Raphael Manfredi. Copyright (C) 2002 Mark Rogaski; all rights reserved. See L or the README file included with the distribution for license information. =head1 SEE ALSO Log::Agent(3), Log::Agent::Message(3). =cut Log-Agent-1.005/Agent/File_Pool.pm0000644000000000000000000000343614034707532015251 0ustar rootroot########################################################################### # # File_Pool.pm # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use strict; ######################################################################## package Log::Agent::File_Pool; # # A pool of all created file objects, along with their rotation policies # my $POOL = undef; # only one instance # # ->make # # Creation routine. # # Attributes: # info records path -> # [Log::Agent::File objects, rotation policies, refcnt] # sub make { my $self = bless {}, shift; $self->{info} = {}; return $self; } # # Attribute access # sub info { $_[0]->{'info'} } # # file_pool -- "once" routine # # Return the main pool # sub file_pool { return $POOL || ($POOL = Log::Agent::File_Pool->make()); } # # ->put # # Put new entry in pool. # sub put { my $self = shift; my ($path, $file, $rotate) = @_; my $info = $self->info; if (exists $info->{$path}) { $info->{$path}->[2]++; # refcnt } else { $info->{$path} = [$file, $rotate, 1]; } } # # ->get # # Get record for existing entry, undef if none. # sub get { my $self = shift; my ($path) = @_; my $aref = $self->info->{$path}; return defined $aref ? @$aref : (); } # # ->remove # # Remove record. # Returns true when file is definitively removed (no more reference on it). # sub remove { my $self = shift; my ($path) = @_; my $item = $self->info->{$path}; return 1 unless defined $item; return 0 if --$item->[2]; # # Reference count reached 0 # delete $self->info->{$path}; return 1; } 1; # for require Log-Agent-1.005/Agent/Priorities.pm0000644000000000000000000001124014034707532015522 0ustar rootroot########################################################################### # # Priorities.pm # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use strict; ######################################################################## package Log::Agent::Priorities; require Exporter; use AutoLoader 'AUTOLOAD'; use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS @LEVELS); @ISA = qw(Exporter); @LEVELS = qw(NONE EMERG ALERT CRIT ERROR WARN NOTICE INFO DEBUG); @EXPORT = qw(priority_level); @EXPORT_OK = qw(prio_from_level level_from_prio); push(@EXPORT_OK, @LEVELS); %EXPORT_TAGS = (LEVELS => \@LEVELS); BEGIN { sub NONE () {-1} sub EMERG () {0} sub ALERT () {1} sub CRIT () {2} sub ERROR () {3} sub WARN () {4} sub NOTICE () {6} sub INFO () {8} sub DEBUG () {10} } use vars qw(@basic_prio %basic_level); @basic_prio = qw( emergency alert critical error warning warning notice notice info info); %basic_level = ( 'em' => EMERG, # emergency 'al' => ALERT, # alert 'cr' => CRIT, # critical 'er' => ERROR, # error 'wa' => WARN, # warning 'no' => NOTICE, # notice 'in' => INFO, # info 'de' => DEBUG, # debug ); 1; __END__ # # prio_from_level # # Given a level, compute suitable priority. # sub prio_from_level { my ($level) = @_; return 'none' if $level < 0; return 'debug' if $level >= @basic_prio; return $basic_prio[$level]; } # # level_from_prio # # Given a syslog priority, compute suitable level. # sub level_from_prio { my ($prio) = @_; return -1 if lc($prio) eq 'none'; # none & notice would look alike my $canonical = lc(substr($prio, 0, 2)); return 10 unless exists $basic_level{$canonical}; return $basic_level{$canonical} || -1; } # # priority_level # # Decompiles priority which can be either a single digit, a "priority" string # or a "priority:digit" string. Returns the priority (computed if none) and # the level (computed if none). # sub priority_level { my ($id) = @_; return (prio_from_level($id), $id) if $id =~ /^\d+$/; return ($1, $2) if $id =~ /^([^:]+):(\d+)$/; return ($id, level_from_prio($id)); } =head1 NAME Log::Agent::Priorities - conversion between syslog priorities and levels =head1 SYNOPSIS Not intended to be used directly =head1 DESCRIPTION This package contains routines to convert between syslog priorities and logging levels: level_from_prio("crit") yields 2, and prio_from_level(4) yields "warning", as does prio_from_level(5). Here are the known priorities (which may be abbreviated to the first 2 letters, in a case-insensitive manner) and their corresponding logging level: Name Level Traditional Export --------- ----- -------------- ------ none -1 NONE (special, see text) emergency 0 (emerg, panic) EMERG alert 1 ALERT critical 2 (crit) CRIT error 3 (err) ERROR warning 4 WARN notice 6 NOTICE info 8 INFO debug 10 DEBUG The values between parenthesis show the traditional syslog priority tokens. The missing levels (5, 7, 9) are there for possible extension. They currently map to the level immediately below. The Export column lists the symbolic constants defined by this package. They can be imported selectively, or alltogether via the C<:LEVELS> tag, as in: use Log::Agent::Priorities qw(:LEVELS); The special token "none" may be used (and spelled out fully) on special occasions: it maps to -1, and is convenient when specifying a logging level, for instance: specifying "none" ensures that B will take place, even for emergency situations. Anywhere where a I is expected, one may specify a number taken as a logging level or a string taken as a priority. If the default mapping outlined above is not satisfactory, it can be redefined by specifying, for instance C<"notice:9">. It will be taken as being of level 9, but with a C priority nonetheless, not C as it would have been implicitely determined otherwise. The routine priority_level() decompiles C<"notice:9"> into ("notice", 9), and otherwise uses prio_from_level() or level_from_prio() to compute the missing informatin. For instance, given "critical", priority_level() routine will return the tuple ("critical", 2). =head1 AUTHOR Raphael Manfredi FRaphael_Manfredi@pobox.comE> =head1 SEE ALSO Log::Agent(3), Log::Agent::Logger(3). =cut Log-Agent-1.005/Agent/Channel/0000755000000000000000000000000014034707532014405 5ustar rootrootLog-Agent-1.005/Agent/Channel/File.pm0000644000000000000000000003042414034707532015625 0ustar rootroot########################################################################### # # File.pm # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use strict; require Log::Agent::Channel; require Log::Agent::Prefixer; ######################################################################## package Log::Agent::Channel::File; use vars qw(@ISA); @ISA = qw(Log::Agent::Channel Log::Agent::Prefixer); use Symbol; use Fcntl; use Log::Agent::Stamping; # # ->make -- defined # # Creation routine. # # Attributes (and switches that set them): # # prefix the application name # stampfmt stamping format ("syslog", "date", "own", "none") or closure # showpid whether to show pid after prefix in [] # filename file name to open (magical open needs -magic_open) # fileperm permissions to open file with # magic_open flag to tell whether ">>file" or "|proc" are allowed filenames # rotate rotating policy for this file # share true implies that non-magic filenames share the same fd object # no_ucfirst don't capitalize first letter of message when no prefix # no_prefixing don't prefix logs # no_newline never append any newline character at the end of messages # # Other attributes: # # fd records Log::Agent::File::* objects # crlf the new-line marker for this OS ("\n" on UNIX) # warned records calls made to hardwired warn() to only do them once # sub make { my $self = bless {}, shift; my (%args) = @_; my %set = ( -prefix => \$self->{'prefix'}, -stampfmt => \$self->{'stampfmt'}, -showpid => \$self->{'showpid'}, -magic_open => \$self->{'magic_open'}, -filename => \$self->{'filename'}, -fileperm => \$self->{'fileperm'}, -rotate => \$self->{'rotate'}, -no_ucfirst => \$self->{'no_ucfirst'}, -no_prefixing => \$self->{'no_prefixing'}, -no_newline => \$self->{'no_newline'}, -share => \$self->{'share'}, ); while (my ($arg, $val) = each %args) { my $vset = $set{lc($arg)}; unless (ref $vset) { require Carp; Carp::croak("Unknown switch $arg"); } $$vset = $val; } # # Initialize proper time-stamping routine. # $self->{'stampfmt'} = stamping_fn($self->stampfmt) unless ref $self->stampfmt eq 'CODE'; $self->{'fd'} = undef; $self->{'crlf'} = $^O =~ /^dos|win/i ? "\r\n" : "\n"; $self->{'warned'} = {}; if ($self->rotate) { eval { require Log::Agent::File::Rotate; }; if ($@) { warn $@; require Carp; Carp::croak("Must install Log::Agent::Rotate to use rotation"); } } return $self; } # # Attribute access # sub magic_open { $_[0]->{'magic_open'} } sub rotate { $_[0]->{'rotate'} } sub filename { $_[0]->{'filename'} } sub fileperm { $_[0]->{'fileperm'} } sub fd { $_[0]->{'fd'} } sub share { $_[0]->{'share'} } sub warned { $_[0]->{'warned'} } # # ->write -- defined # # Write logstring to the file. # Priority is ignored by this channel. # sub write { my $self = shift; my ($priority, $logstring) = @_; # # This routine is called often... # Bypass the attribute access routines. # my $fd = $self->{fd}; $fd = $self->open unless $fd; return unless ref $fd; my $prefix = ''; $prefix = $self->prefixing_string(\$logstring) unless $self->{no_prefixing}; my $crlf = ''; $crlf = $self->{crlf} unless $self->{no_newline}; # # The innocent-looking ->print statement below is NOT a polymorphic call. # # It can be targetted on various Log::Agent::File::* objects, which # all happen to provide a print() feature with the same signature. # However, those clases have no inheritance relationship because Perl # is not typed, and the ancestor would be a deferred class anyway. # $fd->print($prefix, $logstring, $crlf); return; } # # ->open # # Open channel, and return the opened file descriptor. # Also record opened file within $self->fd. # sub open { my $self = shift; my $filename = $self->filename; require Log::Agent::File::Native; my $fobj; my $note; # # They may use ">file" or "|proc" as channel files if -magic_open # if ($filename =~ /^\s*[>|]/ && $self->magic_open) { # restrict the permissions my $mask = umask; umask($mask | 0666 ^ $self->fileperm) if defined $self->fileperm; # open the file my $h = gensym; $fobj = Log::Agent::File::Native->make($h) if open($h, $filename); # restore the permissions umask $mask; } else { # # If the file is already opened, and the current channel can be # shared, do not re-open it: share the same Log::Agent::File::* object, # along with its rotation policy. # my $rotate = $self->rotate; # A Log::Agent::Rotate object my $pool; if ($self->share) { require Log::Agent::File_Pool; $pool = Log::Agent::File_Pool::file_pool(); my ($eobj, $erot) = $pool->get($filename); if (defined $eobj) { $fobj = $eobj; # Reuse same object $note = "rotation for '$filename' may be wrong" . " (shared with distinct policies)" if defined $erot && defined $rotate && !$erot->is_same($rotate); } } unless (defined $fobj) { if (defined $rotate) { $fobj = Log::Agent::File::Rotate->make($filename, $rotate); } else { my $h = gensym; $fobj = Log::Agent::File::Native->make($h) if sysopen($h, $filename, O_CREAT|O_APPEND|O_WRONLY, defined $self->fileperm ? $self->fileperm : 0666); } } # # Record object in pool if shared, even if already present. # We maintain a refcount of all the shared items. # $pool->put($filename, $fobj, $rotate) if defined $fobj && $self->share; } # # If an error occurred, we have no choice but to emit a warning via warn(). # Otherwise, the error would disappear, and we know they don't want to # silence us, or they would not try to open a logfile. # # Warn only once per filename though. # unless (defined $fobj) { my $prefix = $self->prefixing_string() || "$0: "; warn "${prefix}can't open logfile \"$filename\": $!\n" unless $self->warned->{$filename}++; return undef; } $self->{fd} = $fobj || 1; # Avoid recursion in open if not defined # # Print the note, using ->write() now that $self->fd is recorded. # if (defined $note) { $note .= $self->crlf if $self->no_newline; $self->write(undef, $note); } return $fobj; } # # ->close -- defined # sub close { my $self = shift; my $fd = $self->fd; return unless ref $fd; $self->{fd} = 1; # Prevents further opening from ->write unless ($self->share) { $fd->close; return; } # # A shared file is physically closed only when the last reference # to it is removed. # my $pool = Log::Agent::File_Pool::file_pool(); $fd->close if $pool->remove($self->filename); return; } 1; # for require __END__ =head1 NAME Log::Agent::Channel::File - file logging channel for Log::Agent =head1 SYNOPSIS require Log::Agent::Channel::File; my $driver = Log::Agent::Channel::File->make( -prefix => "prefix", -stampfmt => "own", -showpid => 1, -magic_open => 0, -filename => "/tmp/output.err", -fileperm => 0640, -share => 1, ); =head1 DESCRIPTION The file channel performs logging to a file, along with the necessary prefixing and stamping of the messages. Internally, the C driver creates such objects for each logging channel defined at driver creation time. The creation routine make() takes the following arguments: =over 4 =item C<-filename> => I The file name where output should go. The file is opened in append mode and autoflushing is turned on. See also the C<-magic_open> flag. =item C<-fileperm> => I The permissions that the file should be opened with (XOR'd with the user's umask). Due to the nature of the underlying open() and sysopen(), the value is limited to less than or equal to 0666. See L for more details. =item C<-magic_open> => I When true, channel filenames beginning with '>' or '|' are opened using Perl's open(). Otherwise, sysopen() is used, in append mode. Default is I. =item C<-no_newline> => I When set to I, never append any "\n" (on Unix) or "\r\n" (on Windows) to log messages. Internally, Log::Agent relies on the channel to delimit logged lines appropriately, so this flag is not used. However, it might be useful for C users. Default is I, meaning newline markers are systematically appended. =item C<-no_prefixing> => I When set to I, disable the prefixing logic entirely, i.e. the following options are ignored completely: C<-prefix>, C<-showpid>, C<-no_ucfirst>, C<-stampfmt>. Default is I. =item C<-no_ucfirst> => I When set to I, don't upper-case the first letter of the log message entry when there's no prefix inserted before the logged line. When there is a prefix, a ":" character follows, and therefore the leading letter of the message should not be upper-cased anyway. Default is I, meaning uppercasing is performed. =item C<-prefix> => I The application prefix string to prepend to messages. =item C<-rotate> => I This sets a default logfile rotation policy. You need to install the additional C module to use this switch. I is the C instance describing the rotating policy for the channel. Only files which are not opened via a so-called I can be rotated. =item C<-share> => I When I, this flag records the channel in a global pool indexed by filenames. An existing file handle for the same filename may be then be shared amongst several file channels. However, you will get this message in the file Rotation for 'filename' may be wrong (shared with distinct policies) when a rotation policy different from the one used during the initial opening is given. Which policy will be used is unspecified, on purpose. =item C<-showpid> => I If set to true, the PID of the process will be appended within square brackets after the prefix, to all messages. Default is I. =item C<-stampfmt> => (I | I) Specifies the time stamp format to use. By default, my "own" format is used. See L for a description of the available format names. You may also specify a CODE ref: that routine will be called every time we need to compute a time stamp. It should not expect any parameter, and should return a string. =back =head1 CAVEAT Beware of chdir(). If your program uses chdir(), you should always specify logfiles by using absolute paths, otherwise you run the risk of having your relative paths become invalid: there is no anchoring done at the time you specify them. This is especially true when configured for rotation, since the logfiles are recreated as needed and you might end up with many logfiles scattered throughout all the directories you chdir()ed to. =head1 AUTHORS Originally written by Raphael Manfredi ERaphael_Manfredi@pobox.comE, currently maintained by Mark Rogaski Emrogaski@cpan.orgE. =head1 LICENSE Copyright (C) 1999 Raphael Manfredi. Copyright (C) 2002 Mark Rogaski, mrogaski@cpan.org; all rights reserved. See L or the README file included with the distribution for license information. =head1 SEE ALSO Log::Agent::Logger(3), Log::Agent::Channel(3). =cut Log-Agent-1.005/Agent/Channel/Syslog.pm0000644000000000000000000001004514034707532016223 0ustar rootroot########################################################################### # # Syslog.pm # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use strict; require Log::Agent::Channel; ######################################################################## package Log::Agent::Channel::Syslog; use vars qw(@ISA); @ISA = qw(Log::Agent::Channel); use Sys::Syslog qw(:DEFAULT setlogsock); # # ->make -- defined # # Creation routine. # # Attributes (and switches that set them): # # prefix the logging prefix to use (application name, usally) # facility the syslog facility name to use ("auth", "daemon", etc...) # showpid whether to show pid # socktype socket type ('unix' or 'inet') # logopt list of openlog() options: 'ndelay', 'cons' or 'nowait' # sub make { my $self = bless {}, shift; my (%args) = @_; my %set = ( -prefix => \$self->{'prefix'}, -facility => \$self->{'facility'}, -showpid => \$self->{'showpid'}, -socktype => \$self->{'socktype'}, -logopt => \$self->{'logopt'}, ); while (my ($arg, $val) = each %args) { my $vset = $set{lc($arg)}; unless (ref $vset) { require Carp; Carp::croak("Unknown switch $arg"); } $$vset = $val; } $self->{'logopt'} =~ s/\bpid\b//g; # Must use showpid => 1 $self->{'logopt'} .= ' pid' if $self->showpid; return $self; } # # Attribute access # sub prefix { $_[0]->{'prefix'} } sub facility { $_[0]->{'facility'} || 'user' } sub showpid { $_[0]->{'showpid'} } sub socktype { $_[0]->{'socktype'} } sub logopt { $_[0]->{'logopt'} } sub connected { $_[0]->{'connected'} } # # ->connect # # Connect to syslogd. # sub connect { my $self = shift; setlogsock $self->socktype if $self->socktype; openlog $self->prefix, $self->logopt, $self->facility; $self->{'connected'}++; } # # ->close -- defined # # Disconnect from syslogd. # sub disconnect { my $self = shift; return unless $self->connected; closelog; $self->{'connected'} = 0; } # # ->write -- defined # sub write { my $self = shift; my ($priority, $logstring) = @_; $self->connect unless $self->connected; syslog $priority, "%s", $logstring; } 1; # for require __END__ =head1 NAME Log::Agent::Channel::Syslog - syslog logging channel for Log::Agent::Logger =head1 SYNOPSIS require Log::Agent::Channel::Syslog; my $channel = Log::Agent::Channel::Syslog->make( # Specific attributes -prefix => prefix, -facility => "user", -showpid => 1, -socktype => { port => 514, type => "udp" }, -logopt => "ndelay", ); =head1 DESCRIPTION The syslog logging channels directs operations to syslog() via the Sys::Syslog(3) interface. The creation routine make() takes the following switches: =over 4 =item C<-facility> => I Tell syslog() which facility to use (e.g. "user", "auth", "daemon"). Unlike the Sys::Syslog(3) interface, the facility is set once and for all: every message logged through this channel will use the same facility. =item C<-logopt> => I Specifies logging options, under the form of a string containing zero or more of the words I, I or I. =item C<-prefix> => I The I here is syslog's identification string. =item C<-showpid> => I Set to true to have the PID of the process logged. It is false by default. =item C<-socktype> => I Configures the logging socket. The given I are passed without interpretation to C hence refer to Sys::Sylog(3) for the exhaustive set of configuration options there. If you run C over TCP on a non-standard port 60514 for instance, you could say: =over 4 -socktype => { port => 60514, type => "tcp" } =back but there are many other configuration possibilities. =back =head1 AUTHOR Raphael Manfredi FRaphael_Manfredi@pobox.comE> =head1 SEE ALSO Log::Agent::Logger(3), Sys::Syslog(3). =cut Log-Agent-1.005/Agent/Channel/Handle.pm0000644000000000000000000001334214034707532016141 0ustar rootroot########################################################################### # # Handle.pm # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use strict; require Log::Agent::Channel; require Log::Agent::Prefixer; require Log::Agent::File::Native; ######################################################################## package Log::Agent::Channel::Handle; use vars qw(@ISA); @ISA = qw(Log::Agent::Channel Log::Agent::Prefixer); use Log::Agent::Stamping; # # ->make -- defined # # Creation routine. # # Attributes (and switches that set them): # # prefix the application name # stampfmt stamping format ("syslog", "date", "own", "none") or closure # showpid whether to show pid after prefix in [] # handle I/O glob or IO::Handle object # no_ucfirst don't capitalize first letter of message when no prefix # no_prefixing don't prefix logs # no_newline never append any newline character at the end of messages # # Other attributes: # # crlf the new-line marker for this OS ("\n" on UNIX) # sub make { my $self = bless {}, shift; my (%args) = @_; my %set = ( -prefix => \$self->{'prefix'}, -stampfmt => \$self->{'stampfmt'}, -showpid => \$self->{'showpid'}, -handle => \$self->{'handle'}, -no_ucfirst => \$self->{'no_ucfirst'}, -no_prefixing => \$self->{'no_prefixing'}, -no_newline => \$self->{'no_newline'}, ); while (my ($arg, $val) = each %args) { my $vset = $set{lc($arg)}; unless (ref $vset) { require Carp; Carp::croak("Unknown switch $arg"); } $$vset = $val; } # # Initialize proper time-stamping routine. # $self->{'stampfmt'} = stamping_fn($self->stampfmt) unless ref $self->stampfmt eq 'CODE'; $self->{'crlf'} = $^O =~ /^dos|win/i ? "\r\n" : "\n"; return $self; } # # Local attribute access # sub handle { $_[0]->{'handle'} } # # ->write -- defined # # Write logstring to the file. # Priority is ignored by this channel. # sub write { my $self = shift; my ($priority, $logstring) = @_; # # This routine is called often... # Bypass the attribute access routines. # my $handle = $self->{handle}; return unless defined $handle; my $prefix = ''; $prefix = $self->prefixing_string(\$logstring) unless $self->{no_prefixing}; my $crlf = ''; $crlf = $self->{crlf} unless $self->{no_newline}; print $handle join '', $prefix, $logstring, $crlf; return; } # # ->close -- defined # # sub close { my $self = shift; $self->{handle} = undef; # # Do nothing on the handle itself. # We did not open the thing, we don't get to close it. # return; } 1; # for require __END__ =head1 NAME Log::Agent::Channel::Handle - I/O handle logging channel for Log::Agent =head1 SYNOPSIS require Log::Agent::Channel::Handle; my $driver = Log::Agent::Channel::Handle->make( -prefix => "prefix", -stampfmt => "own", -showpid => 1, -handle => \*FILE, ); =head1 DESCRIPTION The handle channel performs logging to an already opened I/O handle, along with the necessary prefixing and stamping of the messages. The creation routine make() takes the following arguments: =over 4 =item C<-handle> => I Specifies the I/O I to use. It can be given as a GLOB reference, such as C<\*FILE>, or as an C object. B: Auto-flushing is not enabled on the I. Even when the channel is closed, the I is left as-is: we simply stop sending log messages to it. =item C<-no_newline> => I When set to I, never append any "\n" (on Unix) or "\r\n" (on Windows) to log messages. Internally, Log::Agent relies on the channel to delimit logged lines appropriately, so this flag is not used. However, it might be useful for C users. Default is I, meaning newline markers are systematically appended. =item C<-no_prefixing> => I When set to I, disable the prefixing logic entirely, i.e. the following options are ignored completely: C<-prefix>, C<-showpid>, C<-no_ucfirst>, C<-stampfmt>. Default is I. =item C<-no_ucfirst> => I When set to I, don't upper-case the first letter of the log message entry when there's no prefix inserted before the logged line. When there is a prefix, a ":" character follows, and therefore the leading letter of the message should not be upper-cased anyway. Default is I, meaning uppercasing is performed. =item C<-prefix> => I The application prefix string to prepend to messages. =item C<-showpid> => I If set to true, the PID of the process will be appended within square brackets after the prefix, to all messages. Default is I. =item C<-stampfmt> => (I | I) Specifies the time stamp format to use. By default, my "own" format is used. See L for a description of the available format names. You may also specify a CODE ref: that routine will be called every time we need to compute a time stamp. It should not expect any parameter, and should return a string. =back =head1 CAVEAT Beware of chdir(). If your program uses chdir(), you should always specify logfiles by using absolute paths, otherwise you run the risk of having your relative paths become invalid: there is no anchoring done at the time you specify them. This is especially true when configured for rotation, since the logfiles are recreated as needed and you might end up with many logfiles scattered throughout all the directories you chdir()ed to. =head1 AUTHOR Raphael Manfredi FRaphael_Manfredi@pobox.comE> =head1 SEE ALSO Log::Agent::Logger(3), Log::Agent::Channel(3). =cut Log-Agent-1.005/MANIFEST0000644000000000000000000000555014034707532013135 0ustar rootrootREADME The main README file MANIFEST This list CHANGELOG.md List of changes Makefile.PL Generic Makefile template Agent.pm Main agent, default interface Agent/Channel.pm Ancestor for all channels Agent/Channel/File.pm File logging channel Agent/Channel/Handle.pm I/O handle logging channel Agent/Channel/Syslog.pm Syslog logging channel Agent/Driver.pm Ancestor for all drivers Agent/Driver/Datum.pm Intercepting driver for Devel::Datum Agent/Driver/Default.pm Default logging driver Agent/Driver/File.pm File driver Agent/Driver/Fork.pm Fork to split output to multiple drivers Agent/Driver/Mail.pm Email driver Agent/Driver/Silent.pm Silent driver Agent/Driver/Syslog.pm Syslog driver Agent/File/Native.pm A native file handle Agent/File_Pool.pm Pool of file logging channels for sharing Agent/Formatting.pm Log formatting routines Agent/Message.pm A log message Agent/Prefixer.pm Log prefixer (name, pid) Agent/Priorities.pm Priority manipulation routines Agent/Stamping.pm Log timestamping routines Agent/Tag.pm Ancestor for message tags Agent/Tag/Callback.pm Add dynamically computed tags to messages Agent/Tag/Caller.pm Computes and formats caller information Agent/Tag/Priority.pm Add priority/level information to messages Agent/Tag/String.pm Add constant string to messages Agent/Tag_List.pm Holds list of user-defined tags t/caller.t Test caller information t/carp.pl Library for tests t/carp_default.t Test logcarp() and logxcarp() with defaults t/carp_file.t Test logcarp() and logxcarp() to file t/carp_fork.t Test logcarp() and logxcarp() to fork t/carp_multiline.t Test logcarp() and logxcarp() with newlines t/carp_silent.t Test logcarp() and logcroak() with silent t/code.pl Library for tests t/common.pl Library for tests t/default.t Test default settings and driver t/default_exp.t Test default settings, explicit logconfig() t/file.t Test file driver t/fork.t Test driver fork t/format.t Test the sprintf compatibility of logxxx() t/priority.t Test -priority setting in logconfig() t/tag_callback.t Test log message tag via callback t/tag_string.t Test log message tag via string META.json Module meta-data Log-Agent-1.005/t/0000755000000000000000000000000014034707532012242 5ustar rootrootLog-Agent-1.005/t/tag_string.t0000644000000000000000000000222414034707532014570 0ustar rootroot#!perl ########################################################################### # # tag_string.t # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## print "1..2\n"; require './t/code.pl'; sub ok; use Log::Agent; require Log::Agent::Driver::File; require Log::Agent::Tag::String; unlink 't/file.out', 't/file.err'; my $driver = Log::Agent::Driver::File->make( -prefix => 'me', -channels => { 'error' => 't/file.err', 'output' => 't/file.out' }, ); my $t1 = Log::Agent::Tag::String->make(-value => ""); my $t2 = Log::Agent::Tag::String->make(-value => "", -postfix => 1); logconfig( -driver => $driver, -tags => [$t1], ); logerr "error string"; use Log::Agent qw(logtags); my $tags = logtags; $tags->append($t2); logwarn "warn string"; ok 1, contains("t/file.err", ' error string$'); ok 2, contains("t/file.err", ' warn string $'); unlink 't/file.out', 't/file.err'; Log-Agent-1.005/t/format.t0000644000000000000000000000220014034707532013711 0ustar rootroot#!perl ########################################################################### # # format.t # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use Test; use Log::Agent; BEGIN { plan tests => 7 } open(FOO, "t/frank"); my $errstr = $!; eval { logdie "error: %m" }; ok($@ =~ /Error: $errstr/i); close FOO; eval { logdie "100%% pure, %s lard", "snowy" }; ok($@ =~ /100\% pure, snowy lard/); eval { logdie "5%% Nation of Lumps in My Oatmeal" }; ok($@ =~ /5% Nation of Lumps in My Oatmeal/); eval { logdie "10%% inspiration, 90%% frustration" }; ok($@ =~ /10% inspiration, 90% frustration/); eval { logdie "%-10s, %10s", 'near', 'far' }; ok($@ =~ /Near , far/); eval { logdie "because %d is the magic number", 0x03 }; ok($@ =~ /Because 3 is the magic number/); eval { logdie 'night of the living %*2$x', 233495723, 4 }; skip($] < 5.008 ? "pre 5.8.0" : 0, $@ =~ /Night of the living dead/); Log-Agent-1.005/t/carp_multiline.t0000644000000000000000000000123114034707532015433 0ustar rootroot#!./perl ########################################################################### # # carp_multiline.t # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use Test; use Carp; use Log::Agent; BEGIN { plan tests => 1 } eval { croak "Yo\nla\ntengo" }; $die1 = $@; eval { logcroak "Yo\nla\ntengo" }; $die2 = $@; $die1 =~ s/^\s+eval.*\n//m; $die1 =~ s/(at .* line \d+)\./$1/m; # I'm not gonna bother. ok($die1 eq $die2); Log-Agent-1.005/t/carp_file.t0000644000000000000000000000124214034707532014352 0ustar rootroot#!./perl ########################################################################### # # carp_file.t # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use Log::Agent; require Log::Agent::Driver::File; unlink 't/file.out', 't/file.err'; my $driver = Log::Agent::Driver::File->make( -prefix => 'me', -channels => { 'error' => 't/file.err', 'output' => 't/file.out' }, ); logconfig(-driver => $driver); do './t/carp.pl'; Log-Agent-1.005/t/carp_silent.t0000644000000000000000000000203114034707532014726 0ustar rootroot#!./perl ########################################################################### # # carp_silent.t # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## print "1..2\n"; require './t/code.pl'; sub ok; use Log::Agent; require Log::Agent::Driver::Silent; open(ORIG_STDOUT, ">&STDOUT") || die "can't dup STDOUT: $!\n"; select(ORIG_STDOUT); open(STDOUT, ">t/file.out") || die "can't redirect STDOUT: $!\n"; open(STDERR, ">t/file.err") || die "can't redirect STDOUT: $!\n"; my $driver = Log::Agent::Driver::Silent->make(); logconfig(-driver => $driver); sub test { logcarp "none"; logcroak "test"; } my $line = __LINE__ + 1; test(); sub END { ok 1, !contains("t/file.err", "none"); ok 2, contains("t/file.err", "test at t/carp_silent.t line $line"); unlink 't/file.out', 't/file.err'; exit 0; } Log-Agent-1.005/t/tag_callback.t0000644000000000000000000000255014034707532015020 0ustar rootroot#!perl ########################################################################### # # tag_callback.t # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## require './t/code.pl'; sub ok; eval "require Callback"; if ($@) { print "1..0\n"; exit 0; } print "1..2\n"; use Log::Agent; require Log::Agent::Driver::File; require Log::Agent::Tag::Callback; unlink 't/file.out', 't/file.err'; sub build_tag { return "<" . join(':', @_) . ">"; } my $driver = Log::Agent::Driver::File->make( -prefix => 'me', -channels => { 'error' => 't/file.err', 'output' => 't/file.out' }, ); my $c1 = Callback->new(\&build_tag, qw(a b c)); my $c2 = Callback->new(\&build_tag, qw(d e f)); my $t1 = Log::Agent::Tag::Callback->make(-callback => $c1); my $t2 = Log::Agent::Tag::Callback->make(-callback => $c2, -postfix => 1); logconfig( -driver => $driver, -tags => [$t1], ); logerr "error string"; use Log::Agent qw(logtags); my $tags = logtags; $tags->prepend($t2); logwarn "warn string"; ok 1, contains("t/file.err", ' error string$'); ok 2, contains("t/file.err", ' warn string $'); unlink 't/file.out', 't/file.err'; Log-Agent-1.005/t/common.pl0000644000000000000000000000222014034707532014063 0ustar rootroot#!perl ########################################################################### # # common.pl # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## sub contains ($$) { my ($file, $pattern) = @_; $pattern = qr{$pattern}; local *FILE; local $_; open(FILE, $file) || die "can't open $file: $!\n"; my $found = 0; my $line = 0; while () { s/[\n\r]//sg; $line++; if (/$pattern/) { $found = 1; last; } } close FILE; return $found ? $line : 0; } sub perm_ok ($$) { # # Given a fileame and target permissions, checks if the file # was created with the correct permissions. # my($file, $target) = @_; $target &= ~ umask; # account for user mask my $mode = (stat $file)[2]; # find the current mode $mode &= 0777; # we only care about UGO return $mode == $target; } 1; Log-Agent-1.005/t/carp.pl0000644000000000000000000000506214034707532013527 0ustar rootroot#!perl ########################################################################### # # carp.pl # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## print "1..11\n"; require './t/code.pl'; sub ok; my $FILE = "./t/carp.pl"; package OTHER; use Log::Agent; use Carp qw(carp cluck); sub make { bless {}, shift } sub intern { my $i = $_[1]; logcarp "OTHER${i}::intern"; } sub extern { my $i = $_[1]; logxcarp 1, "OTHER${i}::extern"; } package ROOT; use Log::Agent; sub make { my $self = bless {}, shift; $self->{other} = OTHER->make; return $self; } sub f { logcarp "ROOT::f"; } sub g { logcarp "ROOT::g"; } sub h { my $self = shift; my $o = $self->{other}; $main::intern1 = __LINE__ + 1; $o->intern(1); $o->extern(1); } sub k { my $o = OTHER->make; $main::intern2 = __LINE__ + 1; $o->intern(2); $o->extern(2); } package SUBCLASS; use Log::Agent; @ISA = qw(ROOT); sub g { logcarp "SUBCLASS::g"; } package main; use Carp qw(carp cluck); sub intern { logcarp "main::intern"; } sub extern { logxcarp 1, "main::extern"; } sub wrap { $intern = __LINE__ + 1; intern; extern; } my $r = ROOT->make; my $s = SUBCLASS->make; my $file = "t/file.err"; my $base = __LINE__ + 1; # First call below $r->f; $s->f; $r->g; $s->g; ok 1, 1 == contains($file, sprintf "ROOT::f at $FILE line %d", $base+0); ok 2, 2 == contains($file, sprintf "ROOT::f at $FILE line %d", $base+1); ok 3, 3 == contains($file, sprintf "ROOT::g at $FILE line %d", $base+2); ok 4, contains($file, sprintf "SUBCLASS::g at $FILE line %d", $base+3); # Empty file open(FILE, ">$file"); close FILE; $base = __LINE__ + 1; # First call below $s->h; ok 5, contains($file, "OTHER1::intern at $FILE line $intern1"); ok 6, contains($file, "OTHER1::extern at $FILE line $base"); $base = __LINE__ + 1; # First call below ROOT::g(); ok 7, contains($file, "ROOT::g at $FILE line $base"); $base = __LINE__ + 1; # First call below ROOT::k(); ok 8, contains($file, "OTHER2::intern at $FILE line $intern2"); ok 9, contains($file, "OTHER2::extern at $FILE line $base"); # # This test would not work without the kludge fixing Carp's output # in Log::Agent::Driver::carpmess. # $base = __LINE__ + 1; # First call below wrap; ok 10, contains($file, "main::intern at $FILE line $intern"); ok 11, contains($file, "main::extern at $FILE line $base"); unlink 't/file.out', 't/file.err'; Log-Agent-1.005/t/file.t0000644000000000000000000001601514034707532013351 0ustar rootroot#!perl ########################################################################### # # file.t # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use Test::More; use Log::Agent; use Log::Agent::Priorities qw(:LEVELS); require Log::Agent::Driver::File; require './t/common.pl'; BEGIN { plan tests => 42 } my $driver = Log::Agent::Driver::File->make(); # take all defaults logconfig(-driver => $driver); open(ORIGOUT, ">&STDOUT") or die "can't dup STDOUT: $!\n"; open(STDOUT, ">t/file.out") or die "can't redirect STDOUT: $!\n"; open(ORIGERR, ">&STDERR") or die "can't dup STDERR: $!\n"; open(STDERR, ">t/file.err") or die "can't redirect STDERR: $!\n"; select(ORIGERR); $| = 1; select(ORIGOUT); $| = 1; logerr "error"; logsay "message"; close STDOUT; open(STDOUT, ">&ORIGOUT") or die "can't restore STDOUT: $!\n"; close STDERR; open(STDERR, ">&ORIGERR") or die "can't restore STDERR: $!\n"; select(STDOUT); ok(contains("t/file.err", '\d Error$')); ok(! contains("t/file.out", 'Error')); ok(contains("t/file.err", '\d Message$')); ok(! contains("t/file.out", 'Message')); undef $Log::Agent::Driver; # Cheat $driver = Log::Agent::Driver::File->make( -prefix => 'me', -showpid => 1, -stampfmt => sub { 'DATE' }, -channels => { 'error' => 't/file.err', 'output' => 't/file.out' }, -duperr => 1, ); logconfig(-driver => $driver, -level => DEBUG); open(ORIGOUT, ">&STDOUT") or die "can't dup STDOUT: $!\n"; open(STDOUT, ">t/file.out") or die "can't redirect STDOUT: $!\n"; open(ORIGERR, ">&STDERR") or die "can't dup STDERR: $!\n"; open(STDERR, ">t/file.err") or die "can't redirect STDERR: $!\n"; select(ORIGERR); $| = 1; select(ORIGOUT); $| = 1; logerr "error"; logdebug "debug"; loginfo "info"; logsay "message"; logwarn "warning"; eval { logdie "die" }; close STDOUT; open(STDOUT, ">&ORIGOUT") or die "can't restore STDOUT: $!\n"; close STDERR; open(STDERR, ">&ORIGERR") or die "can't restore STDERR: $!\n"; select(STDOUT); ok($@); ok(contains("t/file.err", '^DATE me\[\d+\]: error$')); ok(contains("t/file.out", 'ERROR: error')); ok(contains("t/file.out", '^DATE me\[\d+\]: message$')); ok(contains("t/file.out", '^DATE me\[\d+\]: info$')); ok(contains("t/file.out", '^DATE me\[\d+\]: debug$')); ok(! contains("t/file.err", 'message')); ok(! contains("t/file.err", 'info')); ok(! contains("t/file.err", 'debug')); ok(contains("t/file.err", '^DATE me\[\d+\]: warning$')); ok(contains("t/file.out", 'WARNING: warning')); ok(contains("t/file.err", '^DATE me\[\d+\]: die$')); ok(contains("t/file.out", 'FATAL: die')); unlink 't/file.out', 't/file.err'; undef $Log::Agent::Driver; # Cheat $driver = Log::Agent::Driver::File->make( -prefix => 'me', -stampfmt => sub { 'DATE' }, -channels => { 'error' => 't/file2.err', 'output' => 't/file2.out' }, ); logconfig(-driver => $driver); logerr "error"; logsay "message"; logwarn "warning"; eval { logdie "die" }; ok($@); ok(contains("t/file2.err", '^DATE me: error$')); ok(! contains("t/file2.out", 'error')); ok(contains("t/file2.out", '^DATE me: message$')); ok(! contains("t/file2.err", 'message')); ok(contains("t/file2.err", '^DATE me: warning$')); ok(! contains("t/file2.out", 'warning')); ok(contains("t/file2.err", '^DATE me: die$')); ok(! contains("t/file2.out", 'die')); unlink 't/file2.out', 't/file2.err'; undef $Log::Agent::Driver; # Cheat open(FILE, '>>t/file.err'); # Needs appending, for OpenBSD $driver = Log::Agent::Driver::File->make( -prefix => 'me', -magic_open => 1, -channels => { 'error' => '>>t/file3.err', }, ); logconfig(-driver => $driver); logerr "error"; logsay "should go to error"; close FILE; ok(! -e '>&main::FILE'); ok(-e 't/file3.err'); ok(contains("t/file3.err", 'me: error$')); ok(contains("t/file3.err", 'me: should go to')); unlink 't/file3.err'; # # Test file permissions # SKIP: { skip "file mode not supported on Win32.", 12 if $^O eq 'MSWin32'; $driver = Log::Agent::Driver::File->make( -file => 't/file4.out', -perm => 0666 ); logconfig(-driver => $driver); logsay "HONK HONK!"; ok(perm_ok('t/file4.out', 0666)); unlink 't/file4.out'; $driver = Log::Agent::Driver::File->make( -file => 't/file5.out', -perm => 0644 ); logconfig(-driver => $driver); logsay "HONK HONK!"; ok(perm_ok('t/file5.out', 0644)); unlink 't/file5.out'; $driver = Log::Agent::Driver::File->make( -file => 't/file6.out', -perm => 0640 ); logconfig(-driver => $driver); logsay "HONK HONK!"; ok(perm_ok('t/file6.out', 0640)); unlink 't/file6.out'; # # and with magic_open # $driver = Log::Agent::Driver::File->make( -file => 't/file7.out', -perm => 0666, -magic_open => 1 ); logconfig(-driver => $driver); logsay "HONK HONK!"; ok(perm_ok('t/file7.out', 0666)); unlink 't/file7.out'; $driver = Log::Agent::Driver::File->make( -file => 't/file8.out', -perm => 0644, -magic_open => 1 ); logconfig(-driver => $driver); logsay "HONK HONK!"; ok(perm_ok('t/file8.out', 0644)); unlink 't/file8.out'; $driver = Log::Agent::Driver::File->make( -file => 't/file9.out', -perm => 0640, -magic_open => 1 ); logconfig(-driver => $driver); logsay "HONK HONK!"; ok(perm_ok('t/file9.out', 0640)); unlink 't/file9.out'; # # Test file permissions with multiple channels # $driver = Log::Agent::Driver::File->make( -channels => { output => 't/file10.out', error => 't/file10.err', debug => 't/file10.dbg' }, -chanperm => { output => 0666, error => 0644, debug => 0640 } ); logconfig(-driver => $driver, -debug => 10); logsay "HONK HONK!"; logerr "HONK HONK!"; logdbg 'debug', "HONK HONK!"; ok(perm_ok('t/file10.out', 0666)); ok(perm_ok('t/file10.err', 0644)); ok(perm_ok('t/file10.dbg', 0640)); unlink 't/file10.out', 't/file10.err', 't/file10.dbg'; # # and, again, with magic_open # $driver = Log::Agent::Driver::File->make( -channels => { output => 't/file11.out', error => 't/file11.err', debug => 't/file11.dbg' }, -chanperm => { output => 0666, error => 0644, debug => 0640 }, -magic_open => 1 ); logconfig(-driver => $driver, -debug => 10); logsay "HONK HONK!"; logerr "HONK HONK!"; logdbg 'debug', "HONK HONK!"; ok(perm_ok('t/file11.out', 0666)); ok(perm_ok('t/file11.err', 0644)); ok(perm_ok('t/file11.dbg', 0640)); unlink 't/file11.out', 't/file11.err', 't/file11.dbg'; } Log-Agent-1.005/t/caller.t0000644000000000000000000000521314034707532013672 0ustar rootroot#!./perl ########################################################################### # # caller.t # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## print "1..10\n"; require './t/code.pl'; sub ok; use Log::Agent; require Log::Agent::Driver::File; unlink 't/file.out', 't/file.err'; my $show_error = __LINE__ + 2; sub show_error { logerr "error string"; } my $show_output = __LINE__ + 2; sub show_output { logsay "output string"; } my $show_carp = __LINE__ + 2; sub show_carp { logcarp "carp string"; } my $driver = Log::Agent::Driver::File->make( -prefix => 'me', -channels => { 'error' => 't/file.err', 'output' => 't/file.out' }, ); logconfig( -driver => $driver, -caller => [ -format => "<%s,%.4d>", -info => "sub line", -postfix => 1 ], ); show_error; show_output; my $carp_line = __LINE__ + 1; show_carp; my $error_str = sprintf("%.4d", $show_error); my $output_str = sprintf("%.4d", $show_output); my $carp_str = sprintf("%.4d", $show_carp); ok 1, contains("t/file.err", "error string "); ok 2, !contains("t/file.err", "output string"); ok 3, contains("t/file.out", "output string "); ok 4, !contains("t/file.out", "error string"); ok 5, contains("t/file.err", "carp string at t/caller.t line $carp_line "); ok 6, !contains("t/file.out", "carp string"); unlink 't/file.out', 't/file.err'; undef $Log::Agent::Driver; # Cheat $driver = Log::Agent::Driver::File->make( -prefix => 'me', -channels => { 'error' => 't/file.err', 'output' => 't/file.out' }, ); logconfig( -driver => $driver, -caller => [ -format => "<%a>", -info => "pack file sub line" ], ); show_error; show_output; $error_str = $show_error; $output_str = $show_output; my $file = __FILE__; ok 7, contains("t/file.err", " error"); ok 8, contains("t/file.out", " output"); unlink 't/file.out', 't/file.err'; undef $Log::Agent::Driver; # Cheat $driver = Log::Agent::Driver::File->make( -prefix => 'me', -channels => { 'error' => 't/file.err', 'output' => 't/file.out' }, ); logconfig( -driver => $driver, -caller => [ -display => '<$sub/${line}>' ], ); show_error; show_output; ok 9, contains("t/file.err", " error"); ok 10, contains("t/file.out", " output"); unlink 't/file.out', 't/file.err'; Log-Agent-1.005/t/carp_fork.t0000644000000000000000000000142414034707532014376 0ustar rootroot#!perl ########################################################################### # # carp_fork.t # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use Log::Agent; require Log::Agent::Driver::Fork; require Log::Agent::Driver::File; unlink 't/file.out', 't/file.err'; my $driver = Log::Agent::Driver::Fork->make( Log::Agent::Driver::File->make( -prefix => 'me', -channels => { 'error' => 't/file.err', 'output' => 't/file.out' }, ) ); logconfig(-driver => $driver); do './t/carp.pl'; Log-Agent-1.005/t/default.t0000644000000000000000000000213014034707532014047 0ustar rootroot#!./perl ########################################################################### # # default.t # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## print "1..6\n"; require './t/code.pl'; sub ok; use Log::Agent; open(ORIG_STDOUT, ">&STDOUT") || die "can't dup STDOUT: $!\n"; select(ORIG_STDOUT); open(STDOUT, ">t/default.out") || die "can't redirect STDOUT: $!\n"; open(STDERR, ">t/default.err") || die "can't redirect STDERR: $!\n"; logerr "error"; logsay "message"; loginfo "info"; logdebug "debugging"; logtrc 'debug', "debug"; close STDOUT; close STDERR; ok 1, contains("t/default.err", '^Error$'); ok 2, contains("t/default.err", '^Message$'); ok 3, !contains("t/default.err", '^Debug$'); ok 4, !contains("t/default.err", '^Debugging$'); ok 5, !contains("t/default.err", '^Info$'); ok 6, 0 == -s "t/default.out"; unlink 't/default.out', 't/default.err'; Log-Agent-1.005/t/priority.t0000644000000000000000000000247514034707532014320 0ustar rootroot#!perl ########################################################################### # # priority.t # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## print "1..7\n"; require './t/code.pl'; sub ok; use Log::Agent; require Log::Agent::Driver::File; unlink 't/file.out', 't/file.err'; my $driver = Log::Agent::Driver::File->make( -prefix => 'me', -channels => { 'error' => 't/file.err', 'output' => 't/file.out' }, ); logconfig( -driver => $driver, -priority => [ -display => '<$priority/$level>', -prefix => 1 ], -level => 12, ); logerr "error string"; logsay "notice string"; logcarp "carp string"; logdbg 'info:12', "info string"; logdebug "debug string in out"; ok 1, contains("t/file.err", " error string"); ok 2, !contains("t/file.err", "notice string"); ok 3, contains("t/file.err", " carp string"); ok 4, contains("t/file.out", " notice string"); ok 5, contains("t/file.err", " info string"); ok 6, !contains("t/file.err", "debug string in out"); ok 7, contains("t/file.out", "debug string in out"); unlink 't/file.out', 't/file.err'; Log-Agent-1.005/t/code.pl0000644000000000000000000000141214034707532013507 0ustar rootroot#!perl ########################################################################### # # code.pl # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## sub ok { my ($num, $ok) = @_; print "not " unless $ok; print "ok $num\n"; } sub contains { my ($file, $pattern) = @_; local *FILE; local $_; open(FILE, $file) || die "can't open $file: $!\n"; my $found = 0; my $line = 0; while () { s/[\n\r]//sg; $line++; if (/$pattern/) { $found = 1; last; } } close FILE; return $found ? $line : 0; } 1; Log-Agent-1.005/t/fork.t0000644000000000000000000000646514034707532013403 0ustar rootroot#!perl ########################################################################### # # fork.t # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use strict; use Test; require './t/common.pl'; BEGIN { plan tests => 27 } use Log::Agent; use Log::Agent::Priorities qw(:LEVELS); require Log::Agent::Driver::Fork; require Log::Agent::Driver::Default; require Log::Agent::Driver::File; my $driver = Log::Agent::Driver::Fork->make( Log::Agent::Driver::Default->make('moose'), Log::Agent::Driver::File->make( -prefix => 'squirrel', -showpid => 1, -stampfmt => sub { 'DATE' }, -channels => { 'error' => 't/fork_file.err', 'output' => 't/fork_file.out' }, -duperr => 1, ) ); logconfig( -driver => $driver, -level => DEBUG ); open(ORIGOUT, ">&STDOUT") or die "can't dup STDOUT: $!\n"; open(STDOUT, ">t/fork_std.out") or die "can't redirect STDOUT: $!\n"; open(ORIGERR, ">&STDERR") or die "can't dup STDERR: $!\n"; open(STDERR, ">t/fork_std.err") or die "can't redirect STDERR: $!\n"; select(ORIGERR); $| = 1; select(ORIGOUT); $| = 1; logerr "out of pez"; logsay "una is a growing pup"; loginfo "COOLING"; logdebug "COOKING"; logtrc 'debug', "HLAGHLAGHLAGH"; logwarn "do not try this at home"; eval { logdie "et tu, Chuckles?" }; close STDOUT; open(STDOUT, ">&ORIGOUT") or die "can't restore STDOUT: $!\n"; close STDERR; open(STDERR, ">&ORIGERR") or die "can't restore STDERR: $!\n"; select(STDOUT); ok($@); # default driver output ok(contains("t/fork_std.err", '^moose: out of pez$')); ok(! contains("t/fork_std.err", '^Out of pez$')); ok(contains("t/fork_std.err", '^moose: una is a growing pup$')); ok(contains("t/fork_std.err", '^moose: COOLING')); ok(contains("t/fork_std.err", '^moose: COOKING')); ok(! contains("t/fork_std.err", '^Una is a growing pup$')); ok(! contains("t/fork_std.err", '^COOKING$')); ok(! contains("t/fork_std.err", '^COOLING$')); ok(contains("t/fork_std.err", '^moose: et tu, Chuckles\?$')); ok(! contains("t/fork_std.err", '^Et tu, Chuckles\?$')); ok(contains("t/fork_std.err", '^moose: do not try this at home$')); ok(! contains("t/fork_std.err", '^Do not try this at home$')); ok(! contains("t/fork_std.err", '^moose: HLAGHLAGHLAGH$')); ok(-s "t/fork_std.out", 0); # file driver output ok(contains("t/fork_file.err", '^DATE squirrel\[\d+\]: out of pez$')); ok(contains("t/fork_file.out", 'ERROR: out of pez')); ok(contains("t/fork_file.out", '^DATE squirrel\[\d+\]: una is a growing pup$')); ok(! contains("t/fork_file.err", 'una is a growing pup')); ok(! contains("t/fork_file.err", 'COOKING')); ok(! contains("t/fork_file.err", 'COOLING')); ok(contains("t/fork_file.err", '^DATE squirrel\[\d+\]: do not try this at home$')); ok(contains("t/fork_file.out", 'WARNING: do not try this at home')); ok(contains("t/fork_file.err", '^DATE squirrel\[\d+\]: et tu, Chuckles\?$')); ok(contains("t/fork_file.out", 'FATAL: et tu, Chuckles\?')); ok(contains("t/fork_file.out", 'COOKING')); ok(contains("t/fork_file.out", 'COOLING')); unlink 't/fork_std.out', 't/fork_std.err', 't/fork_file.out', 't/fork_file.err'; Log-Agent-1.005/t/default_exp.t0000644000000000000000000000271714034707532014736 0ustar rootroot#!./perl ########################################################################### # # default_exp.t # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## # # This is the continuation of t/default.t. # It was split to circumvent a Perl 5.005 or glibc bug on Linux platforms. # print "1..8\n"; require './t/code.pl'; sub ok; use Log::Agent; open(ORIG_STDOUT, ">&STDOUT") || die "can't dup STDOUT: $!\n"; select(ORIG_STDOUT); open(STDOUT, ">t/default.out") || die "can't redirect STDOUT: $!\n"; open(STDERR, ">t/default.err") || die "can't redirect STDERR: $!\n"; logconfig(-prefix => 'me', -trace => 6, -debug => 8); logtrc 'notice', "notice"; logtrc 'info', "trace-info"; logdbg 'info', "debug-info"; logerr "error"; logsay "message"; logwarn "warning"; eval { logdie "die" }; print STDERR $@; # We trapped it ok 1, $@; close STDOUT; close STDERR; ok 2, contains("t/default.err", '^me: error$'); ok 3, contains("t/default.err", '^me: message$'); ok 4, contains("t/default.err", '^me: WARNING: warning$'); ok 5, contains("t/default.err", '^me: die$'); ok 6, contains("t/default.err", '^me: debug-info$'); ok 7, !contains("t/default.err", '^me: trace-info$'); ok 8, 0 == -s "t/default.out"; unlink 't/default.out', 't/default.err'; Log-Agent-1.005/t/carp_default.t0000644000000000000000000000121214034707532015054 0ustar rootroot#!perl ########################################################################### # # carp_default.t # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use Log::Agent; open(ORIG_STDOUT, ">&STDOUT") || die "can't dup STDOUT: $!\n"; select(ORIG_STDOUT); open(STDOUT, ">t/file.out") || die "can't redirect STDOUT: $!\n"; open(STDERR, ">t/file.err") || die "can't redirect STDOUT: $!\n"; do './t/carp.pl'; Log-Agent-1.005/README0000644000000000000000000003245314034707532012666 0ustar rootrootNAME Log::Agent - logging agent SYNOPSIS use Log::Agent; # in all reusable components logerr "error"; logtrc "notice:12", "notice that" if ...; logdie "log and die"; use Log::Agent; # in application's main logconfig(-prefix => $0); # simplest, uses default driver use Log::Agent; # another more complex example require Log::Agent::Driver::File; # logging made to file logconfig(-driver => Log::Agent::Driver::File->make( -prefix => $0, -showpid => 1, -channels => { 'error' => "$0.err", 'output' => "$0.out", 'debug' => "$0.dbg", }, ) ); DESCRIPTION The `Log::Agent' module provides an abstract layer for logging and tracing, which is independant from the actual method used to physically perform those activities. It acts as an agent (hence the name) that collects the requests and delegates processing to a sublayer: the logging driver. The `Log::Agent' module is meant to be used in all reusable components, since they cannot know in advance how the application which ends up using them will perform its logging activities: either by emitting messages on stdout and errors on stderr, or by directing messages to logfiles, or by using syslog(3). The logging interface is common for all the logging drivers, and is therefore the result of a compromise between many logging schemes: any information given at this level must be either handled by all drivers, or may be ignored depending on the application's final choice. PRIORITIES AND LEVEL The `Log::Agent' module can use both priorities (as defined by syslog(3)) or logging levels, or either, in which case there is an implicit computation of the missing item (i.e. the level 4, for instance, corresponds to the "warning" priority, and vice-versa). See Log::Agent::Priorities for more details. A logging level is defined as being a threshold: any level lesser than or equal to that threshold will be logged. At the `Log::Agent' level, it is possible to define a trace level and a debug level. Only the messages below those levels (inclusive) will be handed out to the underlying driver for logging. They are used by the logtrc() and logdbg() routines, respectively. CHANNELS The `Log::Agent' class defines three logging channels, which are `error', `output' and `debug'. Depending on the driver used for logging, those channels are ignored (typically with syslog()) or may be implicitely defined (default logging, i.e. the one achieved by the `Log::Agent::Driver::Default' driver, remaps `error' and `debug' to stderr, `output' to stdout). INTERFACE Anywhere a *message* is expected, it can be a single string, or a printf()-like format string followed by the required arguments. The special macro `%m' is handled directly by `Log::Agent' and is replaced by the string version of $!, which is the last error message returned by the last failing system call. NOTE: There should not be any trailing "\n" in the *message* strings, nor any embededed one, although this is not enforced. Remember that the main purpose of `Log::Agent' is to specify logging messages in a standard way! Therefore, most of the time, a "should" should be read as "must" and "should not" as "must not", which is the strongest interdiction form available in English, as far as I know. Here are valid *message* examples: "started since $time" "started since %s", $time "fork: %m" The follwing logging interface is made available to modules: logdbg *priority*, *message* Debug logging of *message* to the `debug' channel. You may specify any priority you want, i.e. a `debug' priority is not enforced here. You may even specify `"notice:4"' if you wish, to have the message logged if the debug level is set to 4 or less. If handed over to syslog(3), the message will nonetheless be logged at the `notice' priority. logtrc *priority*, *message* Trace logging of *message* to the `output' channel. Like logdbg() above, you are not restricted to the `info' priority. This routine checks the logging level (either explicit as in `"info:14"' or implicit as in `"notice"') against the trace level. logsay *message* Log the message at the `notice' priority to the `output' channel. The logging always takes place under the default `-trace' settings, but only if the routine is called, naturally. This means you can still say: logsay "some trace message" if $verbose; and control whether the message is emitted by using some external configuration for your module (e.g. by adding a -verbose flag to the creation routine of your class). logwarn *message* Log a warning message at the `warning' priority to the `error' channel. logcarp *message* Same as logwarn(), but issues a Carp::carp(3) call instead, which will warn from the perspective of the routine's caller. logerr *message* Log an error message at the `error' priority to the `error' channel. logdie *message* Log a fatal message at the `critical' priority to the `error' channel, and then dies. logconfess *message* Same as logdie(), but issues a Carp::confess(3) call instead. It is possible to configure the `Log::Agent' module via the `-confess' switch to automatically redirect a logdie() to logconfess(), which is invaluable during unit testing. logcroak *message* Same as logdie(), but issues a Carp::croak(3) call instead. It is possible to configure the `Log::Agent' module via the `-confess' switch to automatically redirect a logcroak() to logconfess(), which is invaluable during unit testing. Log::Agent::inited Returns true when `Log::Agent' was initialized, either explicitely via a logconfig() or implicitely via any logxxx() call. Modules sometimes wish to report errors from the perspective of their caller's caller, not really their caller. The following interface is therefore provided: logxcarp *offset*, *message* Same a logcarp(), but with an additional offset to be applied on the stack. To warn one level above your caller, set it to 1. logxcroak *offset*, *message* Same a logcroak(), but with an additional offset to be applied on the stack. To report an error one level above your caller, set it to 1. For applications that wish to implement a debug layer on top of `Log::Agent', the following routine is provided. Note that it is not imported by default, i.e. it needs to be explicitely mentionned at `use' time, since it is not meant to be used directly under regular usage. logwrite *channel*, *priority*, *message* Unconditionally write the *message* at the given *priority* on *channel*. The channel can be one of `debug', `error' or `output'. At the application level, one needs to commit once and for all about the logging scheme to be used. This is done thanks to the logconfig() routine which takes the following switches, in alphabetical order: `-caller' => [ *parameters* ] Request that caller information (relative to the logxxx() call) be part of the log message. The given *parameters* are handed off to the creation routine of `Log::Agent::Tag::Caller' and are documented there. I usually say something like: -caller => [ -display => '($sub/$line)', -postfix => 1 ] which I find informative enough. On occasion, I found myself using more complex sequences. See Log::Agent::Tag::Caller. `-confess' => *flag* When true, all logdie() calls will be automatically masqueraded as logconfess(). `-debug' => *priority or level* Sets the priority threshold (can be expressed as a string or a number, the string being mapped to a logging level as described above in PRIORITIES AND LEVEL) for logdbg() calls. Calls tagged with a level less than or equal to the given threshold will pass through, others will return prematurely without logging anything. `-driver' => *driver_object* This switch defines the driver object to be used, which must be an heir of the `Log::Agent::Driver' class. See Log::Agent::Driver(3) for a list of the available drivers. `-level' => *priority or level* Specifies both `-debug' and `-trace' levels at the same time, to a common value. `-prefix' => *name* Defines the application name which will be pre-pended to all messages, followed by `": "' (a colon and a space). Using this switch alone will configure the default driver to use that prefix (stripped down to its basename component). When a driver object is used, the `-prefix' switch is kept at the `Log::Agent' level only and is not passed to the driver: it is up to the driver's creation routine to request the `-prefix'. Having this information in Log::Agent enables the module to die on critical errors with that error prefix, since it cannot rely on the logging driver for that, obviously. `-priority' => [ *parameters* ] Request that message priority information be part of the log message. The given *parameters* are handed off to the creation routine of `Log::Agent::Tag::Priority' and are documented there. I usually say something like: -priority => [ -display => '[$priority]' ] which will display the whole priority name at the beginning of the messages, e.g. "[warning]" for a logwarn() or "[error]" for logerr(). See Log::Agent::Tag::Priority and Log::Agent::Priorities. NOTE: Using `-priority' does not prevent the `-duperr' flag of the file driver to also add its own hardwired prefixing in front of duplicated error messages. The two options act at a different level. `-tags' => [ *list of `Log::Agent::Tag' objects* ] Specifies user-defined tags to be added to each message. The objects given here must inherit from `Log::Agent::Tag' and conform to its interface. See Log::Agent::Tag for details. At runtime, well after logconfig() was issued, it may be desirable to add (or remove) a user tag. Use the `logtags()' routine for this purpose, and iteract directly with the tag list object. For instance, a web module might wish to tag all the messages with a session ID, information that might not have been available by the time logconfig() was issued. `-trace' => *priority or level* Same a `-debug' but applies to logsay(), logwarn(), logerr() and logtrc(). When unspecified, `Log::Agent' runs at the "notice" level. Additional routines, not exported by default, are: logtags Returns a `Log::Agent::Tag_List' object, which holds all user-defined tags that are to be added to each log message. The initial list of tags is normally supplied by the application at logconfig() time, via the `-tags' argument. To add or remove tags after configuration time, one needs direct access to the tag list, obtained via this routine. See Log::Agent::Tag_List for the operations that can be performed. KNOWN LIMITATIONS The following limitations exist in this early version. They might be addressed in future versions if they are perceived as annoying limitatons instead of being just documented ones. :-) * A module which calls logdie() may have its die trapped if called from within an eval(), but unfortunately, the value of $@ is unpredictable: it may be prefixed or not depending on the driver used. This is harder to fix as one might think of at first glance. * Some drivers lack customization and hardwire a few things that come from my personal taste, like the prefixing done when *duperr* is set in Log::Agent::Driver::File, or the fact that the `debug' and `stderr' channels are merged as one in the Log::Agent::Driver::Default driver. * When using logcroak() or logconfess(), the place where the call was made can still be visible when -caller is used, since the addition of the caller information to the message is done before calling the logging driver. Is this a problem? AUTHOR Log::Agent was originally authored by Raphael Manfredi and is currently maintained by Mark Rogaski . LICENSE Copyright (c) 1999-2000 Raphael Manfredi. Copyright (c) 2002-2017 Mark Rogaski; all rights reserved. This module is free software. You can redistribute it and/or modify it under the terms of the Artistic License 2.0. This program is distributed in the hope that it will be useful, but without any warranty; without even the implied warranty of merchantability or fitness for a particular purpose. SEE ALSO Log::Agent::Driver(3), Carp(3). Log-Agent-1.005/CHANGELOG.md0000644000000000000000000002156014034707532013614 0ustar rootroot# Change Log ## [1.005] - 2021-04-11 ### Added - Added support for `logcluck`. `loginfo`, and `logdebug`. ### Changed - Updated socktype handling to comply with the current language interface. - Moved from Drone CI to Github Actions, automating upload to CPAN. ## [1.004] - 2021-02-13 ### Changed - Moved from Travis CI with Coveralls to Drone CI with CodeCov. ## [1.003] - 2017-11-10 ### Added - Added a license file. ### Fixed - Fixed remaining relative paths in unit tests. (Florian Schlichting, CPAN #123578) ## [1.002] - 2017-10-27 ### Added - Added support for TravisCI. ### Fixed - Fix test failures due to '.' removal from @INC under Perl 5.26 when PERL_USE_UNSAFE_INC=0. (Kent Fredric, CPAN #121459) ## [1.001] - 2015-11-29 ### Added - Added .gitignore. ### Changed - Moved change log to Markdown format. CHANGELOG.md replaces changes.pod. ### Fixed - Corrected POD typos. (Florian Schlich) - Escaped literal left braces in tests. (Petr Pisar) ## [1.000] - 2013-08-13 ### Changed - Switched to standard X.YYYZZZ versioning. - Replaced ChangeLog with changes.pod. - Updated 'clean' arguments in Makefile.PL. - Updated Agent.pm and replaced old README. ## [0.308] - 2013-08-10 ### Changed - Changed license to the Artistic License 2.0. - Replaced META.yml with META.json. ### Fixed - Fixed tests for Carp behavior and file permissions. ## [0.307] - 2005-10-02 ### Fixed - Replaced a non-localized modification $^W with "no warnings" so warnings are no disabled globally. (Andreas Vierengel) - Fixed formatting behavior for strings that contain "%%" without any other formating characters. (David Coppit) - Fixed a minor undef warning in a major kludge in the Agent::Driver code. ## [0.306] - 2004-02-02 ### Fixed - Stripped line endings in common tests to allow tests to succeed under non-UN*X environments. - Replaced an unnecessary handle alias with the actual file name in t/file.t. (Jay Lawrence and Terrence Brannon) ## [0.305] - 2003-09-27 ### Added - Added a wrapper for &AutoLoader::AUTOLOAD to save the value of $!, which is often clobbered before the substitution of "%m" by logxxx(). - Added a META.yml file and disabled autogeneration in Makefile.PL. ## [0.304] - 2003-03-08 ### Added - Added support for embedded newlines in messages passed to logcarp() and logxcarp(). ### Fixed - Made the logxxx() calls transparent to all (current) sprintf() formatting patterns. Not all formatting errors will be caught before passed to sprintf(), but the obviously malformed ones will be detected. ## [0.303] - 2002-09-30 ### Removed - Removed the problematic t/mail.t test. The test fails due to problems with redirecting the output of Mail::Mailer in test mode. ## [0.302] - 2002-08-01 ### Fixed - Expanded &Carp::shortmess workaround in Log::Agent::Driver to handle behavior under Perl 5.8.0. ## [0.301_002] - 2002-05-12 ### Added - Added prechecks for sprintf() arguments in Log::Agent::Formatting. - Added argument for Mail::Mailer options in Log::Agent::Driver::Mail->make(). ## [0.301_001] - 2002-04-25 ### Added - Added trial Log::Agent::Driver::Mail for sending log messages via email. ### Changed - Minor changes to version control. ## [0.301] - 2002-03-18 ### Removed - Removed paranoid argument test from Log::Agent::Driver::Fork::make(), now relying on later failure for invalid argument. Only testing with ref() now. ## 0.300 - 2002-02-23 ### Added - Added Log::Agent::Driver::Fork to allow logconfig() to accept multiple drivers at once. - Added file permission arguments to Log::Agent::Driver::File and Log::Agent::Channel::File. ### Changed - Development and maintenance handed over to [Mark Rogaski](mrogaski@cpan.org). ### Fixed - Corrected "uninitialized value" in Log::Agent::Tag::Caller caused by undefined $subroutine. ## 0.208 - 2001-04-11 ### Added - Added hyperlinks within POD to ease web browsing of manpage. ### Changed - Routines from Log::Agent::Priorities are now auto-loaded. - Normalize priority string ("err" -> "error") when logging it, Indeed, Log::Agent::Logger uses those routines but makes strict use of syslog priority names. ## 2001-03-31 ### Changed - Massive renaming Devel::Datum -> Carp::Datum. ### Fixed - Fixed =over to add explicit indent level, for POD checkers. - Fixed off-by-one error in prio_from_level(), which caused improper conversion for level 10. ## 2001-03-15 ### Changed. - Updated version number. ## 2001-03-13 ### Fixed - Forgot to handle -prefix in Log::Agent::Channel::Syslog. - Was wrongly issuing test headers twice when skipping the t/tag_callback.t tests. ## 2001-03-13 ### Fixed - Fixed typo in -priority documentation. ### Removed - Manual page for Log::Agent::Tag::Priority was irrelevant. ## 2001-03-13 ### Added - Added the -priority and -tags options to logconfig() for including priority string in messages, as well as user-defined tag strings. ### Fixed - Test the ${line} variable substitution in caller formatting. - Fixed bug for *BSD systems, which caused the test suite to fail. ### Changed - Class Log::Agent::Caller disappered, and is now replaced by Log::Agent::Tag::Caller. ## 0.201 - 2000-11-12 ### Fixed - Minor typo fixes. ## 0.200 - 2000-11-06 ### Changed - Modularized the logging channels. They have now their own hierarchy under Log::Agent::Channel. - Modularized priority, prefixing and timestamping routines, so that they can be re-used by satellite Log::Agent modules. - Logging from Log::Agent is now subject to pruning depending on the logging level set. By default, it is "notice", so that even logsay() is visible. ## 0.108 - 2000-10-01 ### Added - Added support for Devel::Datum. This module is still under development, but is already used in production system. - New logcarp, logxcarp and logxcroak interface. ### Fixed - Fixed carpmess to work around Carp's incorrect offseting and added a test suite for logcarp and logxcarp. ## 0.107 - 2000-07-04 ### Fixed - Forgot to increase version number at last patch. ## 0.106 - 2000-07-04 ### Fixed - Was missing default init check before calling logwrite(), resulting in a call on an undefined referenced in logtrc() and logdbg() when no explicit configuration was otherwise made. ## 0.105 - 2000-06-20 ### Added - Added logcroak(), to die from the perspective of the caller. - New logwrite() routine for upper-level apps, which unconditionally logs messages to a specified channel. ### Fixed - Fixed arg processing to avoid dying on 2nd calls to logconfig(). - Fixed typos in debug init and man page. ### Removed - Removed logtrc() and logdbg() from the driver interface: they are now frozen in Log::Agent, and implemented in terms of logwrite(), which may be redefined as suited. ## 0.104 - 2000-03-30 ### Fixed - Forgot that /(?<\!)/ is a 5.005 feature, fixed Agent/Caller.pm. ## 0.103 - 2000-03-05 ### Added - Added missing 1 for require and fixed typo in pod for Log::Agent::Caller as was reported by many people. - All .pm files now have an \_\_END__ marker before the pod section anyway, so that the Perl parser stops. - Added support for logfile rotation via Log::Agent::Rotate. ### Removed - No longer uses IO::Handle but relies on the new Log::Agent::File hierarch, to support logfile rotation. Native Perl files are now handled via Log::Agent::File::Native. - Suppressed blurb about the Linux bug since we workaround it by creating a new separate default_exp.t test. ## 0.102 - 1999-12-09 ### Fixed - Wrote two versions of format_args and eval proper one. Indeed, perl-5.005 versions do not support /(?<\!)/ and this is parsed at compile time, hence we need to protect the expression within an eval. ## 0.101 - 1999-12-08 ### Fixed - Forgot that /(?<\!)/ is a 5.005 feature, fixed Agent.pm. - Mentions that perl 5.005 fails tests on Linux due to a perl or glibc bug. It's only the test code that fails though. ## 0.100 Initial revision. [1.005]: https://github.com/mrogaski/Log-Agent/compare/v1.004...v1.005 [1.004]: https://github.com/mrogaski/Log-Agent/compare/v1.003...v1.004 [1.003]: https://github.com/mrogaski/Log-Agent/compare/v1.002...v1.003 [1.002]: https://github.com/mrogaski/Log-Agent/compare/v1.001...v1.002 [1.001]: https://github.com/mrogaski/Log-Agent/compare/v1.000...v1.001 [1.000]: https://github.com/mrogaski/Log-Agent/compare/v0.308...v1.000 [0.308]: https://github.com/mrogaski/Log-Agent/compare/rel_0_3_7...v0.308 [0.307]: https://github.com/mrogaski/Log-Agent/compare/rel_0_3_6...rel_0_3_7 [0.306]: https://github.com/mrogaski/Log-Agent/compare/rel_0_3_5...rel_0_3_6 [0.305]: https://github.com/mrogaski/Log-Agent/compare/rel_0_3_4...rel_0_3_5 [0.304]: https://github.com/mrogaski/Log-Agent/compare/rel_0_3_3...rel_0_3_4 [0.303]: https://github.com/mrogaski/Log-Agent/compare/rel0_3_2...rel_0_3_3 [0.302]: https://github.com/mrogaski/Log-Agent/compare/rel0_3_1_p2...rel0_3_2 [0.301_002]: https://github.com/mrogaski/Log-Agent/compare/rel0_3_1_p1...rel0_3_1_p2 [0.301_001]: https://github.com/mrogaski/Log-Agent/compare/rel0_3_1...rel0_3_1_p1 [0.301]: https://github.com/mrogaski/Log-Agent/compare/rel0_3_0...rel0_3_1 Log-Agent-1.005/Agent.pm0000644000000000000000000006113614034707532013402 0ustar rootroot########################################################################### # # Agent.pm # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################### use strict; require Exporter; ######################################################################## package Log::Agent; use vars qw($Driver $Prefix $Trace $Debug $Confess $OS_Error $AUTOLOAD $Caller $Priorities $Tags $DATUM %prio_cache); use AutoLoader; use vars qw(@ISA @EXPORT @EXPORT_OK); @ISA = qw(Exporter); @EXPORT = qw( logconfig logconfess logcluck logcroak logcarp logxcroak logxcarp logdebug loginfo logsay logerr logwarn logdie logtrc logdbg ); @EXPORT_OK = qw( logwrite logtags ); use Log::Agent::Priorities qw(:LEVELS priority_level level_from_prio); use Log::Agent::Formatting qw(tag_format_args); our $VERSION = '1.005'; $VERSION = eval $VERSION; $Trace = NOTICE; # Default tracing $OS_Error = ''; # Data stash for the $! value sub AUTOLOAD { ${Log::Agent::OS_Error} = $!; # for safe-keeping, the braces # prevent CVS substitution $AutoLoader::AUTOLOAD = $AUTOLOAD; goto &AutoLoader::AUTOLOAD; } 1; __END__ # # logconfig # # Configure the logging system at the application level. By default, logging # uses the Log::Agent::Driver::Default driver. # # Available options (case insensitive): # # -PREFIX => string logging prefix/tag to use, for Default agent # -DRIVER => object object heir of Log::Agent::Driver # -TRACE => level trace level # -DEBUG => level debug level # -LEVEL => level specifies common trace/debug level # -CONFESS => flag whether to automatically confess on logdie # -CALLER => listref info from caller to add and where # -PRIORITY => listref message priority information to add # -TAGS => listref list of user-defined tags to add # # Notes: # -CALLER allowed keys documented in Log::Agent::Tag::Caller's make() # -PRIORITY allowed keys documented in Log::Agent::Tag::Priority's make() # -TAGS supplies list of Log::Agent::Tag objects # sub logconfig { my (%args) = @_; my ($calldef, $priodef, $tags); my %set = ( -prefix => \$Prefix, # Only for Default init -driver => \$Driver, -trace => \$Trace, -debug => \$Debug, -level => [\$Trace, \$Debug], -confess => \$Confess, -caller => \$calldef, -priority => \$priodef, -tags => \$tags, ); while (my ($arg, $val) = each %args) { my $vset = $set{lc($arg)}; unless (ref $vset) { require Carp; Carp::croak("Unknown switch $arg"); } if (ref $vset eq 'SCALAR') { $$vset = $val } elsif (ref $vset eq 'ARRAY') { map { $$_ = $val } @$vset } elsif (ref $vset eq 'REF') { $$vset = $val } else { die "bug in logconfig" } } unless (defined $Driver) { require Log::Agent::Driver::Default; # Keep only basename for default prefix $Prefix =~ s|^.*/(.*)|$1| if defined $Prefix; $Driver = Log::Agent::Driver::Default->make($Prefix); } $Prefix = $Driver->prefix; $Trace = level_from_prio($Trace) if defined $Trace && $Trace =~ /^\D+/; $Debug = level_from_prio($Debug) if defined $Debug && $Debug =~ /^\D+/; # # Handle -caller => [ ] # if (defined $calldef) { unless (ref $calldef eq 'ARRAY') { require Carp; Carp::croak("Argument -caller must supply an array ref"); } require Log::Agent::Tag::Caller; $Caller = Log::Agent::Tag::Caller->make(-offset => 3, @{$calldef}); }; # # Handle -priority => [ ] # if (defined $priodef) { unless (ref $priodef eq 'ARRAY') { require Carp; Carp::croak("Argument -priority must supply an array ref"); } $Priorities = $priodef; # Objects created via prio_tag() }; # # Handle -tags => [ ] # if (defined $tags) { unless (ref $tags eq 'ARRAY') { require Carp; Carp::croak("Argument -tags must supply an array ref"); } my $type = "Log::Agent::Tag"; if (grep { !ref $_ || !$_->isa($type) } @$tags) { require Carp; Carp::croak("Argument -tags must supply list of $type objects"); } if (@$tags) { require Log::Agent::Tag_List; $Tags = Log::Agent::Tag_List->make(@$tags); } else { undef $Tags; } } # Install interceptor if needed DATUM_is_here() if defined $DATUM && $DATUM; } # # inited # # Returns whether Log::Agent was inited. # NOT exported, must be called as Log::Agent::inited(). # sub inited { return 0 unless defined $Driver; return ref $Driver ? 1 : 0; } # # DATUM_is_here -- undocumented, but for Carp::Datum # # Tell Log::Agent that the Carp::Datum package was loaded and configured # for debug. # # If there is a driver configured already, install the interceptor. # Otherwise, record that DATUM is here and the interceptor will be installed # by logconfig(). # # NOT exported, must be called as Log::Agent::DATUM_is_here(). # sub DATUM_is_here { $DATUM = 1; return unless defined $Driver; return if ref $Driver eq 'Log::Agent::Driver::Datum'; # # Install the interceptor. # require Log::Agent::Driver::Datum; $Driver = Log::Agent::Driver::Datum->make($Driver); } # # log_default # # Initialize a default logging driver. # sub log_default { return if defined $Driver; logconfig(); } # # logconfess # # Die with a full stack trace # sub logconfess { my $ptag = prio_tag(priority_level(CRIT)) if defined $Priorities; my $str = tag_format_args($Caller, $ptag, $Tags, \@_); &log_default unless defined $Driver; $Driver->logconfess($str); bug("back from logconfess in driver $Driver\n"); } # # logcroak # # Fatal error, from the perspective of our caller # Error is logged, and then we die. # sub logcroak { goto &logconfess if $Confess; # Redirected when -confess my $ptag = prio_tag(priority_level(CRIT)) if defined $Priorities; my $str = tag_format_args($Caller, $ptag, $Tags, \@_); &log_default unless defined $Driver; $Driver->logxcroak(0, $str); bug("back from logxcroak in driver $Driver\n"); } # # logxcroak # # Same a logcroak, but with a specific additional offset. # sub logxcroak { my $offset = shift; goto &logconfess if $Confess; # Redirected when -confess my $ptag = prio_tag(priority_level(CRIT)) if defined $Priorities; my $str = tag_format_args($Caller, $ptag, $Tags, \@_); &log_default unless defined $Driver; $Driver->logxcroak($offset, $str); bug("back from logxcroak in driver $Driver\n"); } # # logdie # # Fatal error # Error is logged, and then we die. # sub logdie { goto &logconfess if $Confess; # Redirected when -confess my $ptag = prio_tag(priority_level(CRIT)) if defined $Priorities; my $str = tag_format_args($Caller, $ptag, $Tags, \@_); &log_default unless defined $Driver; $Driver->logdie($str); bug("back from logdie in driver $Driver\n"); } # # logerr # # Log error, at the "error" level. # sub logerr { return if $Trace < ERROR; my $ptag = prio_tag(priority_level(ERROR)) if defined $Priorities; my $str = tag_format_args($Caller, $ptag, $Tags, \@_); &log_default unless defined $Driver; $Driver->logerr($str); } # # logcarp # # Warning, from the perspective of our caller (at the "warning" level) # sub logcarp { return if $Trace < WARN; my $ptag = prio_tag(priority_level(WARN)) if defined $Priorities; my $str = tag_format_args($Caller, $ptag, $Tags, \@_); &log_default unless defined $Driver; $Driver->logxcarp(0, $str); } # # logxcarp # # Same a logcarp, but with a specific additional offset. # sub logxcarp { return if $Trace < WARN; my $offset = shift; my $ptag = prio_tag(priority_level(WARN)) if defined $Priorities; my $str = tag_format_args($Caller, $ptag, $Tags, \@_); &log_default unless defined $Driver; $Driver->logxcarp($offset, $str); } # # logcluck # # Warning, with a full stack trace. # sub logcluck { return if $Trace < WARN; my $ptag = prio_tag(priority_level(WARN)) if defined $Priorities; my $str = tag_format_args($Caller, $ptag, $Tags, \@_); &log_default unless defined $Driver; $Driver->logcluck($str); } # # logwarn # # Log warning at the "warning" level. # sub logwarn { return if $Trace < WARN; my $ptag = prio_tag(priority_level(WARN)) if defined $Priorities; my $str = tag_format_args($Caller, $ptag, $Tags, \@_); &log_default unless defined $Driver; $Driver->logwarn($str); } # # logsay # # Log message at the "notice" level. # sub logsay { return if $Trace < NOTICE; my $ptag = prio_tag(priority_level(NOTICE)) if defined $Priorities; my $str = tag_format_args($Caller, $ptag, $Tags, \@_); &log_default unless defined $Driver; $Driver->logsay($str); } # loginfo # # Log message at the "info" level. # sub loginfo { return if $Trace < INFO; my $ptag = prio_tag(priority_level(INFO)) if defined $Priorities; my $str = tag_format_args($Caller, $ptag, $Tags, \@_); &log_default unless defined $Driver; $Driver->loginfo($str); } # logdebug # # Log message at the "debug" level. # sub logdebug { return if $Trace < DEBUG; my $ptag = prio_tag(priority_level(INFO)) if defined $Priorities; my $str = tag_format_args($Caller, $ptag, $Tags, \@_); &log_default unless defined $Driver; $Driver->logdebug($str); } # # logtrc -- frozen # # Trace the message if trace level is set high enough. # Trace level must either be a single digit or "priority" or "priority:digit". # sub logtrc { my $id = shift; my ($prio, $level) = priority_level($id); return if $level > $Trace; my $ptag = prio_tag($prio, $level) if defined $Priorities; my $str = tag_format_args($Caller, $ptag, $Tags, \@_); &log_default unless defined $Driver; $Driver->logwrite('output', $prio, $level, $str); } # # logdbg -- frozen # # Emit debug message if debug level is set high enough. # Debug level must either be a single digit or "priority" or "priority:digit". # sub logdbg { my $id = shift; my ($prio, $level) = priority_level($id); return if !defined($Debug) || $level > $Debug; my $ptag = prio_tag($prio, $level) if defined $Priorities; my $str = tag_format_args($Caller, $ptag, $Tags, \@_); &log_default unless defined $Driver; $Driver->logwrite('debug', $prio, $level, $str); } # # logtags # # Returns info on user-defined logging tags. # Asking for this creates the underlying taglist object if not already present. # sub logtags { return $Tags if defined $Tags; require Log::Agent::Tag_List; return $Tags = Log::Agent::Tag_List->make(); } ### ### Utilities ### # # logwrite -- not exported by default # # Write message to the specified channel, at the given priority. # sub logwrite { my ($channel, $id) = splice(@_, 0, 2); my ($prio, $level) = priority_level($id); my $ptag = prio_tag($prio, $level) if defined $Priorities; my $str = tag_format_args($Caller, $ptag, $Tags, \@_); &log_default unless defined $Driver; $Driver->logwrite($channel, $prio, $level, $str); } # # bug # # Log bug, and die. # sub bug { my $ptag = prio_tag(priority_level(EMERG)) if defined $Priorities; my $str = tag_format_args($Caller, $ptag, $Tags, \@_); logerr("BUG: $str"); die "${Prefix}: $str\n"; } # # prio_tag # # Returns Log::Agent::Tag::Priority message that is suitable for tagging # at this priority/level, if configured to log priorities. # # Objects are cached into %prio_cache. # sub prio_tag { my ($prio, $level) = @_; my $ptag = $prio_cache{$prio, $level}; return $ptag if defined $ptag; require Log::Agent::Tag::Priority; # # Common attributes (formatting, postfixing, etc...) are held in # the $Priorities global variable. We add the priority/level here. # $ptag = Log::Agent::Tag::Priority->make( -priority => $prio, -level => $level, @$Priorities ); return $prio_cache{$prio, $level} = $ptag; } =head1 NAME Log::Agent - logging agent =head1 SYNOPSIS use Log::Agent; # in all reusable components logerr "error"; logtrc "notice:12", "notice that" if ...; logdie "log and die"; use Log::Agent; # in application's main logconfig(-prefix => $0); # simplest, uses default driver use Log::Agent; # another more complex example require Log::Agent::Driver::File; # logging made to file logconfig(-driver => Log::Agent::Driver::File->make( -prefix => $0, -showpid => 1, -channels => { 'error' => "$0.err", 'output' => "$0.out", 'debug' => "$0.dbg", }, ) ); =head1 DESCRIPTION The C module provides an abstract layer for logging and tracing, which is independent from the actual method used to physically perform those activities. It acts as an agent (hence the name) that collects the requests and delegates processing to a sublayer: the logging driver. The C module is meant to be used in all reusable components, since they cannot know in advance how the application which ends up using them will perform its logging activities: either by emitting messages on stdout and errors on stderr, or by directing messages to logfiles, or by using syslog(3). The logging interface is common for all the logging drivers, and is therefore the result of a compromise between many logging schemes: any information given at this level must be either handled by all drivers, or may be ignored depending on the application's final choice. =head1 PRIORITIES AND LEVEL The C module can use both priorities (as defined by syslog(3)) or logging levels, or either, in which case there is an implicit computation of the missing item (i.e. the level 4, for instance, corresponds to the "warning" priority, and vice-versa). See L for more details. A logging level is defined as being a threshold: any level lesser than or equal to that threshold will be logged. At the C level, it is possible to define a trace level and a debug level. Only the messages below those levels (inclusive) will be handed out to the underlying driver for logging. They are used by the logtrc() and logdbg() routines, respectively. =head1 CHANNELS The C class defines three logging channels, which are C, C and C. Depending on the driver used for logging, those channels are ignored (typically with syslog()) or may be implicitely defined (default logging, i.e. the one achieved by the C driver, remaps C and C to stderr, C to stdout). =head1 INTERFACE Anywhere a I is expected, it can be a single string, or a printf()-like format string followed by the required arguments. The special macro C<%m> is handled directly by C and is replaced by the string version of $!, which is the last error message returned by the last failing system call. B: There should not be any trailing "\n" in the I strings, nor any embededed one, although this is not enforced. Remember that the main purpose of C is to specify logging messages in a standard way! Therefore, most of the time, a "should" should be read as "must" and "should not" as "must not", which is the strongest interdiction form available in English, as far as I know. Here are valid I examples: "started since $time" "started since %s", $time "fork: %m" The follwing logging interface is made available to modules: =over 4 =item logdbg I, I Debug logging of I to the C channel. You may specify any priority you want, i.e. a C priority is not enforced here. You may even specify C<"notice:4"> if you wish, to have the message logged if the debug level is set to 4 or less. If handed over to syslog(3), the message will nonetheless be logged at the C priority. =item logtrc I, I Trace logging of I to the C channel. Like logdbg() above, you are not restricted to the C priority. This routine checks the logging level (either explicit as in C<"info:14"> or implicit as in C<"notice">) against the trace level. =item logdebug I Log the message at the C priority to the C channel. The difference with logdbg() is twofold: logging is done on the C channel, not the C one, and the priority is implicit. =item loginfo I Log the message at the C priority to the C channel. =item logsay I Log the message at the C priority to the C channel. The logging always takes place under the default C<-trace> settings, but only if the routine is called, naturally. This means you can still say: logsay "some trace message" if $verbose; and control whether the message is emitted by using some external configuration for your module (e.g. by adding a -verbose flag to the creation routine of your class). =item logwarn I Log a warning message at the C priority to the C channel. =item logcarp I Same as logwarn(), but issues a Carp::carp(3) call instead, which will warn from the perspective of the routine's caller. =item logcluck I Same as logwarn(), but dumps a full stacktrace as well. =item logerr I Log an error message at the C priority to the C channel. =item logdie I Log a fatal message at the C priority to the C channel, and then dies. =item logconfess I Same as logdie(), but issues a Carp::confess(3) call instead. It is possible to configure the C module via the C<-confess> switch to automatically redirect a logdie() to logconfess(), which is invaluable during unit testing. =item logcroak I Same as logdie(), but issues a Carp::croak(3) call instead. It is possible to configure the C module via the C<-confess> switch to automatically redirect a logcroak() to logconfess(), which is invaluable during unit testing. =item Log::Agent::inited Returns true when C was initialized, either explicitly via a logconfig() or implicitely via any logxxx() call. =back Modules sometimes wish to report errors from the perspective of their caller's caller, not really their caller. The following interface is therefore provided: =over 4 =item logxcarp I, I Same a logcarp(), but with an additional offset to be applied on the stack. To warn one level above your caller, set it to 1. =item logxcroak I, I Same a logcroak(), but with an additional offset to be applied on the stack. To report an error one level above your caller, set it to 1. =back For applications that wish to implement a debug layer on top of C, the following routine is provided. Note that it is not imported by default, i.e. it needs to be explicitly mentionned at C time, since it is not meant to be used directly under regular usage. =over 4 =item logwrite I, I, I Unconditionally write the I at the given I on I. The channel can be one of C, C or C. =back At the application level, one needs to commit once and for all about the logging scheme to be used. This is done thanks to the logconfig() routine which takes the following switches, in alphabetical order: =over 4 =item C<-caller> => [ I ] Request that caller information (relative to the logxxx() call) be part of the log message. The given I are handed off to the creation routine of C and are documented there. I usually say something like: -caller => [ -display => '($sub/$line)', -postfix => 1 ] which I find informative enough. On occasion, I found myself using more complex sequences. See L. =item C<-confess> => I When true, all logdie() calls will be automatically masqueraded as logconfess(). =item C<-debug> => I Sets the priority threshold (can be expressed as a string or a number, the string being mapped to a logging level as described above in B) for logdbg() calls. Calls tagged with a level less than or equal to the given threshold will pass through, others will return prematurely without logging anything. =item C<-driver> => I This switch defines the driver object to be used, which must be an heir of the C class. See L for a list of the available drivers. =item C<-level> => I Specifies both C<-debug> and C<-trace> levels at the same time, to a common value. =item C<-prefix> => I Defines the application name which will be pre-pended to all messages, followed by C<": "> (a colon and a space). Using this switch alone will configure the default driver to use that prefix (stripped down to its basename component). When a driver object is used, the C<-prefix> switch is kept at the C level only and is not passed to the driver: it is up to the driver's creation routine to request the C<-prefix>. Having this information in Log::Agent enables the module to die on critical errors with that error prefix, since it cannot rely on the logging driver for that, obviously. =item C<-priority> => [ I ] Request that message priority information be part of the log message. The given I are handed off to the creation routine of C and are documented there. I usually say something like: -priority => [ -display => '[$priority]' ] which will display the whole priority name at the beginning of the messages, e.g. "[warning]" for a logwarn() or "[error]" for logerr(). See L and L. B: Using C<-priority> does not prevent the C<-duperr> flag of the file driver to also add its own hardwired prefixing in front of duplicated error messages. The two options act at a different level. =item C<-tags> => [ I objects> ] Specifies user-defined tags to be added to each message. The objects given here must inherit from C and conform to its interface. See L for details. At runtime, well after logconfig() was issued, it may be desirable to add (or remove) a user tag. Use the C routine for this purpose, and iteract directly with the tag list object. For instance, a web module might wish to tag all the messages with a session ID, information that might not have been available by the time logconfig() was issued. =item C<-trace> => I Same a C<-debug> but applies to logsay(), logwarn(), logerr() and logtrc(). When unspecified, C runs at the "notice" level. =back Additional routines, not exported by default, are: =over 4 =item logtags Returns a C object, which holds all user-defined tags that are to be added to each log message. The initial list of tags is normally supplied by the application at logconfig() time, via the C<-tags> argument. To add or remove tags after configuration time, one needs direct access to the tag list, obtained via this routine. See L for the operations that can be performed. =back =head1 KNOWN LIMITATIONS The following limitations exist in this early version. They might be addressed in future versions if they are perceived as annoying limitatons instead of being just documented ones. :-) =over 4 =item * A module which calls logdie() may have its die trapped if called from within an eval(), but unfortunately, the value of $@ is unpredictable: it may be prefixed or not depending on the driver used. This is harder to fix as one might think of at first glance. =item * Some drivers lack customization and hardwire a few things that come from my personal taste, like the prefixing done when I is set in Log::Agent::Driver::File, or the fact that the C and C channels are merged as one in the Log::Agent::Driver::Default driver. =item * When using logcroak() or logconfess(), the place where the call was made can still be visible when -caller is used, since the addition of the caller information to the message is done before calling the logging driver. Is this a problem? =back =head1 AUTHOR Log::Agent was originally authored by Raphael Manfredi FRaphael_Manfredi@pobox.comE> and is currently maintained by Mark Rogaski Fmrogaski@cpan.orgE>. =head1 LICENSE Copyright (c) 1999-2000 Raphael Manfredi. Copyright (c) 2002-2003, 2005, 2013 Mark Rogaski; all rights reserved. This module is free software. You can redistribute it and/or modify it under the terms of the Artistic License 2.0. This program is distributed in the hope that it will be useful, but without any warranty; without even the implied warranty of merchantability or fitness for a particular purpose. =head1 SEE ALSO Log::Agent::Driver(3), Carp(3). =cut Log-Agent-1.005/Makefile.PL0000644000000000000000000000127514034707532013756 0ustar rootroot########################################################################### # # Makefile.PL # # Copyright (C) 1999 Raphael Manfredi. # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Log::Agent', VERSION_FROM => 'Agent.pm', PREREQ_PM => { 'Tie::Array' => 0, 'Test::More' => 0, }, clean => { FILES => '*~ *.err *.out Agent/*~ t*~ t/*.err t/*.out', }, ($] < 5.008_001 ? () : ( NO_META => 1 )) );