eaiovnaovbqoebvqoeavibavo Config.pm000064400000011724147635054350006330 0ustar00package Log::Message::Config; use if $] > 5.017, 'deprecate'; use strict; use Params::Check qw[check]; use Module::Load; use FileHandle; use Locale::Maketext::Simple Style => 'gettext'; BEGIN { use vars qw[$VERSION $AUTOLOAD]; $VERSION = '0.08'; } sub new { my $class = shift; my %hash = @_; ### find out if the user specified a config file to use ### and/or a default configuration object ### and remove them from the argument hash my %special = map { lc, delete $hash{$_} } grep /^config|default$/i, keys %hash; ### allow provided arguments to override the values from the config ### my $tmpl = { private => { default => undef, }, verbose => { default => 1 }, tag => { default => 'NONE', }, level => { default => 'log', }, remove => { default => 0 }, chrono => { default => 1 }, }; my %lc_hash = map { lc, $hash{$_} } keys %hash; my $file_conf; if( $special{config} ) { $file_conf = _read_config_file( $special{config} ) or ( warn( loc(q[Could not parse config file!]) ), return ); } my $def_conf = \%{ $special{default} || {} }; ### make sure to only include keys that are actually defined -- ### the checker will assign even 'undef' if you have provided that ### as a value ### priorities goes as follows: ### 1: arguments passed ### 2: any config file passed ### 3: any default config passed my %to_check = map { @$_ } grep { defined $_->[1] } map { [ $_ => defined $lc_hash{$_} ? $lc_hash{$_} : defined $file_conf->{$_} ? $file_conf->{$_} : defined $def_conf->{$_} ? $def_conf->{$_} : undef ] } keys %$tmpl; my $rv = check( $tmpl, \%to_check, 1 ) or ( warn( loc(q[Could not validate arguments!]) ), return ); return bless $rv, $class; } sub _read_config_file { my $file = shift or return; my $conf = {}; my $FH = new FileHandle; $FH->open("$file", 'r') or ( warn(loc(q[Could not open config file '%1': %2],$file,$!)), return {} ); while(<$FH>) { next if /\s*#/; next unless /\S/; chomp; s/^\s*//; s/\s*$//; my ($param,$val) = split /\s*=\s*/; if( (lc $param) eq 'include' ) { load $val; next; } ### add these to the config hash ### $conf->{ lc $param } = $val; } close $FH; return $conf; } sub AUTOLOAD { $AUTOLOAD =~ s/.+:://; my $self = shift; return $self->{ lc $AUTOLOAD } if exists $self->{ lc $AUTOLOAD }; die loc(q[No such accessor '%1' for class '%2'], $AUTOLOAD, ref $self); } sub DESTROY { 1 } 1; __END__ =pod =head1 NAME Log::Message::Config - Configuration options for Log::Message =head1 SYNOPSIS # This module is implicitly used by Log::Message to create a config # which it uses to log messages. # For the options you can pass, see the C method. # Below is a sample of a config file you could use # comments are denoted by a single '#' # use a shared stack, or have a private instance? # if none provided, set to '0', private = 1 # do not be verbose verbose = 0 # default tag to set on new items # if none provided, set to 'NONE' tag = SOME TAG # default level to handle items # if none provided, set to 'log' level = carp # extra files to include # if none provided, no files are auto included include = mylib.pl include = ../my/other/lib.pl # automatically delete items # when you retrieve them from the stack? # if none provided, set to '0' remove = 1 # retrieve errors in chronological order, or not? # if none provided, set to '1' chrono = 0 =head1 DESCRIPTION Log::Message::Config provides a standardized config object for Log::Message objects. It can either read options as perl arguments, or as a config file. See the Log::Message manpage for more information about what arguments are valid, and see the Synopsis for an example config file you can use =head1 SEE ALSO L, L, L =head1 AUTHOR This module by Jos Boumans Ekane@cpan.orgE. =head1 Acknowledgements Thanks to Ann Barcomb for her suggestions. =head1 COPYRIGHT This module is copyright (c) 2002 Jos Boumans Ekane@cpan.orgE. All rights reserved. This library is free software; you may redistribute and/or modify it under the same terms as Perl itself. =cut # Local variables: # c-indentation-style: bsd # c-basic-offset: 4 # indent-tabs-mode: nil # End: # vim: expandtab shiftwidth=4: Simple.pm000064400000017017147635054350006355 0ustar00package Log::Message::Simple; use if $] > 5.017, 'deprecate'; use strict; use Log::Message private => 0;; BEGIN { use vars qw[$VERSION]; $VERSION = '0.10'; } =pod =head1 NAME Log::Message::Simple - Simplified interface to Log::Message =head1 SYNOPSIS use Log::Message::Simple qw[msg error debug carp croak cluck confess]; use Log::Message::Simple qw[:STD :CARP]; ### standard reporting functionality msg( "Connecting to database", $verbose ); error( "Database connection failed: $@", $verbose ); debug( "Connection arguments were: $args", $debug ); ### standard carp functionality carp( "Wrong arguments passed: @_" ); croak( "Fatal: wrong arguments passed: @_" ); cluck( "Wrong arguments passed -- including stacktrace: @_" ); confess("Fatal: wrong arguments passed -- including stacktrace: @_" ); ### retrieve individual message my @stack = Log::Message::Simple->stack; my @stack = Log::Message::Simple->flush; ### retrieve the entire stack in printable form my $msgs = Log::Message::Simple->stack_as_string; my $trace = Log::Message::Simple->stack_as_string(1); ### redirect output local $Log::Message::Simple::MSG_FH = \*STDERR; local $Log::Message::Simple::ERROR_FH = \*STDERR; local $Log::Message::Simple::DEBUG_FH = \*STDERR; ### force a stacktrace on error local $Log::Message::Simple::STACKTRACE_ON_ERROR = 1 =head1 DESCRIPTION This module provides standardized logging facilities using the C module. =head1 FUNCTIONS =head2 msg("message string" [,VERBOSE]) Records a message on the stack, and prints it to C (or actually C<$MSG_FH>, see the C section below), if the C option is true. The C option defaults to false. Exported by default, or using the C<:STD> tag. =head2 debug("message string" [,VERBOSE]) Records a debug message on the stack, and prints it to C (or actually C<$DEBUG_FH>, see the C section below), if the C option is true. The C option defaults to false. Exported by default, or using the C<:STD> tag. =head2 error("error string" [,VERBOSE]) Records an error on the stack, and prints it to C (or actually C<$ERROR_FH>, see the C sections below), if the C option is true. The C options defaults to true. Exported by default, or using the C<:STD> tag. =cut { package Log::Message::Handlers; sub msg { my $self = shift; my $verbose = shift || 0; ### so you don't want us to print the msg? ### return if defined $verbose && $verbose == 0; my $old_fh = select $Log::Message::Simple::MSG_FH; print '['. $self->tag (). '] ' . $self->message . "\n"; select $old_fh; return; } sub debug { my $self = shift; my $verbose = shift || 0; ### so you don't want us to print the msg? ### return if defined $verbose && $verbose == 0; my $old_fh = select $Log::Message::Simple::DEBUG_FH; print '['. $self->tag (). '] ' . $self->message . "\n"; select $old_fh; return; } sub error { my $self = shift; my $verbose = shift; $verbose = 1 unless defined $verbose; # default to true ### so you don't want us to print the error? ### return if defined $verbose && $verbose == 0; my $old_fh = select $Log::Message::Simple::ERROR_FH; my $msg = '['. $self->tag . '] ' . $self->message; print $Log::Message::Simple::STACKTRACE_ON_ERROR ? Carp::shortmess($msg) : $msg . "\n"; select $old_fh; return; } } =head2 carp(); Provides functionality equal to C while still logging to the stack. Exported by using the C<:CARP> tag. =head2 croak(); Provides functionality equal to C while still logging to the stack. Exported by using the C<:CARP> tag. =head2 confess(); Provides functionality equal to C while still logging to the stack. Exported by using the C<:CARP> tag. =head2 cluck(); Provides functionality equal to C while still logging to the stack. Exported by using the C<:CARP> tag. =head1 CLASS METHODS =head2 Log::Message::Simple->stack() Retrieves all the items on the stack. Since C is implemented using C, consult its manpage for the function C to see what is returned and how to use the items. =head2 Log::Message::Simple->stack_as_string([TRACE]) Returns the whole stack as a printable string. If the C option is true all items are returned with C output, rather than just the message. C defaults to false. =head2 Log::Message::Simple->flush() Removes all the items from the stack and returns them. Since C is implemented using C, consult its manpage for the function C to see what is returned and how to use the items. =cut BEGIN { use Exporter; use Params::Check qw[ check ]; use vars qw[ @EXPORT @EXPORT_OK %EXPORT_TAGS @ISA ];; @ISA = 'Exporter'; @EXPORT = qw[error msg debug]; @EXPORT_OK = qw[carp cluck croak confess]; %EXPORT_TAGS = ( STD => \@EXPORT, CARP => \@EXPORT_OK, ALL => [ @EXPORT, @EXPORT_OK ], ); my $log = new Log::Message; for my $func ( @EXPORT, @EXPORT_OK ) { no strict 'refs'; ### up the carplevel for the carp emulation ### functions *$func = sub { local $Carp::CarpLevel += 2 if grep { $_ eq $func } @EXPORT_OK; my $msg = shift; $log->store( message => $msg, tag => uc $func, level => $func, extra => [@_] ); }; } sub flush { return reverse $log->flush; } sub stack { return $log->retrieve( chrono => 1 ); } sub stack_as_string { my $class = shift; my $trace = shift() ? 1 : 0; return join $/, map { '[' . $_->tag . '] [' . $_->when . '] ' . ($trace ? $_->message . ' ' . $_->longmess : $_->message); } __PACKAGE__->stack; } } =head1 GLOBAL VARIABLES =over 4 =item $ERROR_FH This is the filehandle all the messages sent to C are being printed. This defaults to C<*STDERR>. =item $MSG_FH This is the filehandle all the messages sent to C are being printed. This default to C<*STDOUT>. =item $DEBUG_FH This is the filehandle all the messages sent to C are being printed. This default to C<*STDOUT>. =item $STACKTRACE_ON_ERROR If this option is set to C, every call to C will generate a stacktrace using C. Defaults to C =back =cut BEGIN { use vars qw[ $ERROR_FH $MSG_FH $DEBUG_FH $STACKTRACE_ON_ERROR ]; local $| = 1; $ERROR_FH = \*STDERR; $MSG_FH = \*STDOUT; $DEBUG_FH = \*STDOUT; $STACKTRACE_ON_ERROR = 0; } 1; # Local variables: # c-indentation-style: bsd # c-basic-offset: 4 # indent-tabs-mode: nil # End: # vim: expandtab shiftwidth=4: Handlers.pm000064400000007273147635054350006667 0ustar00package Log::Message::Handlers; use if $] > 5.017, 'deprecate'; use strict; use vars qw[$VERSION]; $VERSION = '0.08'; =pod =head1 NAME Log::Message::Handlers - Message handlers for Log::Message =head1 SYNOPSIS # Implicitly used by Log::Message to serve as handlers for # Log::Message::Item objects # Create your own file with a package called # Log::Message::Handlers to add to the existing ones, or to even # overwrite them $item->carp; $item->trace; =head1 DESCRIPTION Log::Message::Handlers provides handlers for Log::Message::Item objects. The handler corresponding to the level (see Log::Message::Item manpage for an explanation about levels) will be called automatically upon storing the error. Handlers may also explicitly be called on an Log::Message::Item object if one so desires (see the Log::Message manpage on how to retrieve the Item objects). =head1 Default Handlers =head2 log Will simply log the error on the stack, and do nothing special =cut sub log { 1 } =head2 carp Will carp (see the Carp manpage) with the error, and add the timestamp of when it occurred. =cut sub carp { my $self = shift; warn join " ", $self->message, $self->shortmess, 'at', $self->when, "\n"; } =head2 croak Will croak (see the Carp manpage) with the error, and add the timestamp of when it occurred. =cut sub croak { my $self = shift; die join " ", $self->message, $self->shortmess, 'at', $self->when, "\n"; } =head2 cluck Will cluck (see the Carp manpage) with the error, and add the timestamp of when it occurred. =cut sub cluck { my $self = shift; warn join " ", $self->message, $self->longmess, 'at', $self->when, "\n"; } =head2 confess Will confess (see the Carp manpage) with the error, and add the timestamp of when it occurred =cut sub confess { my $self = shift; die join " ", $self->message, $self->longmess, 'at', $self->when, "\n"; } =head2 die Will simply die with the error message of the item =cut sub die { die shift->message; } =head2 warn Will simply warn with the error message of the item =cut sub warn { warn shift->message; } =head2 trace Will provide a traceback of this error item back to the first one that occurred, clucking with every item as it comes across it. =cut sub trace { my $self = shift; for my $item( $self->parent->retrieve( chrono => 0 ) ) { $item->cluck; } } =head1 Custom Handlers If you wish to provide your own handlers, you can simply do the following: =over 4 =item * Create a file that holds a package by the name of C =item * Create subroutines with the same name as the levels you wish to handle in the Log::Message module (see the Log::Message manpage for explanation on levels) =item * Require that file in your program, or add it in your configuration (see the Log::Message::Config manpage for explanation on how to use a config file) =back And that is it, the handler will now be available to handle messages for you. The arguments a handler may receive are those specified by the C key, when storing the message. See the Log::Message manpage for details on the arguments. =head1 SEE ALSO L, L, L =head1 AUTHOR This module by Jos Boumans Ekane@cpan.orgE. =head1 Acknowledgements Thanks to Ann Barcomb for her suggestions. =head1 COPYRIGHT This module is copyright (c) 2002 Jos Boumans Ekane@cpan.orgE. All rights reserved. This library is free software; you may redistribute and/or modify it under the same terms as Perl itself. =cut 1; # Local variables: # c-indentation-style: bsd # c-basic-offset: 4 # indent-tabs-mode: nil # End: # vim: expandtab shiftwidth=4: Item.pm000064400000011230147635054350006011 0ustar00package Log::Message::Item; use if $] > 5.017, 'deprecate'; use strict; use vars qw[$VERSION]; use Params::Check qw[check]; use Log::Message::Handlers; ### for the messages to store ### use Carp (); BEGIN { use vars qw[$AUTOLOAD $VERSION]; $VERSION = '0.08'; } ### create a new item. ### note that only an id (position on the stack), message and a reference ### to its parent are required. all the other things it can fill in itself sub new { my $class = shift; my %hash = @_; my $tmpl = { when => { no_override => 1, default => scalar localtime }, id => { required => 1 }, message => { required => 1 }, parent => { required => 1 }, level => { default => '' }, # default may be conf dependant tag => { default => '' }, # default may be conf dependant longmess => { default => _clean(Carp::longmess()) }, shortmess => { default => _clean(Carp::shortmess())}, }; my $args = check($tmpl, \%hash) or return undef; return bless $args, $class; } sub _clean { map { s/\s*//; chomp; $_ } shift; } sub remove { my $item = shift; my $self = $item->parent; return splice( @{$self->{STACK}}, $item->id, 1, undef ); } sub AUTOLOAD { my $self = $_[0]; $AUTOLOAD =~ s/.+:://; return $self->{$AUTOLOAD} if exists $self->{$AUTOLOAD}; local $Carp::CarpLevel = $Carp::CarpLevel + 3; { no strict 'refs'; return *{"Log::Message::Handlers::${AUTOLOAD}"}->(@_); } } sub DESTROY { 1 } 1; __END__ =pod =head1 NAME Log::Message::Item - Message objects for Log::Message =head1 SYNOPSIS # Implicitly used by Log::Message to create Log::Message::Item objects print "this is the message's id: ", $item->id; print "this is the message stored: ", $item->message; print "this is when it happened: ", $item->when; print "the message was tagged: ", $item->tag; print "this was the severity level: ", $item->level; $item->remove; # delete the item from the stack it was on # Besides these methods, you can also call the handlers on # the object specifically. # See the Log::Message::Handlers manpage for documentation on what # handlers are available by default and how to add your own =head1 DESCRIPTION Log::Message::Item is a class that generates generic Log items. These items are stored on a Log::Message stack, so see the Log::Message manpage about details how to retrieve them. You should probably not create new items by yourself, but use the storing mechanism provided by Log::Message. However, the accessors and handlers are of interest if you want to do fine tuning of how your messages are handled. The accessors and methods are described below, the handlers are documented in the Log::Message::Handlers manpage. =head1 Methods and Accessors =head2 remove Calling remove will remove the object from the stack it was on, so it will not show up any more in subsequent fetches of messages. You can still call accessors and handlers on it however, to handle it as you will. =head2 id Returns the internal ID of the item. This may be useful for comparing since the ID is incremented each time a new item is created. Therefore, an item with ID 4 must have been logged before an item with ID 9. =head2 when Returns the timestamp of when the message was logged =head2 message The actual message that was stored =head2 level The severity type of this message, as well as the name of the handler that was called upon storing it. =head2 tag Returns the identification tag that was put on the message. =head2 shortmess Returns the equivalent of a C for this item. See the C manpage for details. =head2 longmess Returns the equivalent of a C for this item, which is essentially a stack trace. See the C manpage for details. =head2 parent Returns a reference to the Log::Message object that stored this item. This is useful if you want to have access to the full stack in a handler. =head1 SEE ALSO L, L, L =head1 AUTHOR This module by Jos Boumans Ekane@cpan.orgE. =head1 Acknowledgements Thanks to Ann Barcomb for her suggestions. =head1 COPYRIGHT This module is copyright (c) 2002 Jos Boumans Ekane@cpan.orgE. All rights reserved. This library is free software; you may redistribute and/or modify it under the same terms as Perl itself. =cut # Local variables: # c-indentation-style: bsd # c-basic-offset: 4 # indent-tabs-mode: nil # End: # vim: expandtab shiftwidth=4: