Log-Dispatch-Perl-0.04/000755 000765 000765 00000000000 11737537323 014276 5ustar00lizliz000000 000000 Log-Dispatch-Perl-0.04/CHANGELOG000644 000765 000765 00000001536 11737537272 015520 0ustar00lizliz000000 000000 0.04 6 April 2012 Brought up to the latest code esthetics. Stopped doing unneccessary BEGIN block magic. Verifies it runs on 5.14.2, threaded and unthreaded. Added LICENSE parameter to allow MetaCPAN to show license info. 0.03 1 February 2004 Changed internal workings to use %Carp::Internal to indicate module names that shouldn't be listed in a traceback. As per suggestion of Perl Monk tilly. This however only works for Perl 5.8.0 and higher. Change the removal optimization slightly for other versions of Perl. 29 January 2004 Minor first 4 line regex removal optimization. Minor nits in the documentation. 0.02 29 January 2004 Fixed problem with extra lines in "cluck" and "confess" types of handling. All intermediate levels in Log::Dispatch::xxx modules are now removed. 0.01 28 January 2004 First version of Log::Dispatch::Perl. Log-Dispatch-Perl-0.04/lib/000755 000765 000765 00000000000 11737537323 015044 5ustar00lizliz000000 000000 Log-Dispatch-Perl-0.04/Makefile.PL000644 000765 000765 00000000611 11737537225 016247 0ustar00lizliz000000 000000 require 5.006; use strict; use ExtUtils::MakeMaker; eval "use Devel::Required"; WriteMakefile ( NAME => "Log::Dispatch::Perl", AUTHOR => 'Elizabeth Mattijsen (liz@dijkmat.nl)', ABSTRACT => 'Log::Dispatch::Perl - Use core Perl functions for logging', LICENSE => 'perl', VERSION_FROM => 'lib/Log/Dispatch/Perl.pm', PREREQ_PM => {qw( Log::Dispatch 1.16 )}, ); Log-Dispatch-Perl-0.04/MANIFEST000644 000765 000765 00000000375 11737537323 015434 0ustar00lizliz000000 000000 MANIFEST CHANGELOG README TODO VERSION Makefile.PL lib/Log/Dispatch/Perl.pm t/logperl01.t META.yml Module meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Log-Dispatch-Perl-0.04/META.json000644 000765 000765 00000001624 11737537323 015722 0ustar00lizliz000000 000000 { "abstract" : "Log::Dispatch::Perl - Use core Perl functions for logging", "author" : [ "Elizabeth Mattijsen (liz@dijkmat.nl)" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.112150", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Log-Dispatch-Perl", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : 0 } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : 0 } }, "runtime" : { "requires" : { "Log::Dispatch" : "1.16" } } }, "release_status" : "stable", "version" : "0.04" } Log-Dispatch-Perl-0.04/META.yml000644 000765 000765 00000001024 11737537323 015544 0ustar00lizliz000000 000000 --- abstract: 'Log::Dispatch::Perl - Use core Perl functions for logging' author: - 'Elizabeth Mattijsen (liz@dijkmat.nl)' build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.112150' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Log-Dispatch-Perl no_index: directory: - t - inc requires: Log::Dispatch: 1.16 version: 0.04 Log-Dispatch-Perl-0.04/README000644 000765 000765 00000001235 11737526674 015166 0ustar00lizliz000000 000000 README for Log::Dispatch::Perl The "Log::Dispatch::Perl" module offers a logging alternative using standard Perl core functions. It allows you to fall back to the common Perl alternatives for logging, such as "warn" and "cluck". It also adds the possibility for a logging action to halt the current environment, such as with "die" and "croak". Copyright (c) 2004, 2012 Elizabeth Mattijsen . All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Version: 0.04 Required Modules: Log::Dispatch (1.16) The build is standard: perl Makefile.PL make make test make install Log-Dispatch-Perl-0.04/t/000755 000765 000765 00000000000 11737537323 014541 5ustar00lizliz000000 000000 Log-Dispatch-Perl-0.04/TODO000644 000765 000765 00000000054 10050423647 014753 0ustar00lizliz000000 000000 Add examples and more elaborate test-suite. Log-Dispatch-Perl-0.04/VERSION000644 000765 000765 00000000005 10050423647 015327 0ustar00lizliz000000 000000 0.03 Log-Dispatch-Perl-0.04/t/logperl01.t000644 000765 000765 00000003302 10050423647 016517 0ustar00lizliz000000 000000 BEGIN { # Magic Perl CORE pragma if ($ENV{PERL_CORE}) { chdir 't' if -d 't'; @INC = '../lib'; } } use Test::More tests => 5 + (2*2) + (2*2) + (2*2) + (2*2); use strict; use warnings; use_ok( 'Log::Dispatch::Perl' ); can_ok( 'Log::Dispatch::Perl',qw( new log_message ) ); my $dispatcher = Log::Dispatch->new; isa_ok( $dispatcher,'Log::Dispatch' ); my $channel = Log::Dispatch::Perl->new( qw(name default min_level debug) ); isa_ok( $channel,'Log::Dispatch::Perl' ); $dispatcher->add( $channel ); is( $dispatcher->output( 'default' ),$channel,'Check if channel activated' ); my $warn; $SIG{__WARN__} = sub { $warn .= "@_" }; foreach my $method (qw(debug info)) { $warn = ''; eval { $dispatcher->$method( "This is a '$method' action" ) }; ok( !$@,"Check if no error in eval for '$method': $@" ); ok( !$warn,"Check if no warning occurred: $warn" ); } foreach my $method (qw(notice warning)) { $warn = ''; eval { $dispatcher->$method( "This is a '$method' action" ) }; ok( !$@,"Check if no error in eval for '$method': $@" ); is( $warn,"This is a '$method' action\n","Check if warning occurred" ); } foreach my $method (qw(error critical)) { $warn = ''; eval { $dispatcher->$method( "This is a '$method' action" ) }; is( $@,"This is a '$method' action\n", "Check if no error in eval for '$method'" ); ok( !$warn,"Check if no warning occurred: $warn" ) } foreach my $method (qw(alert emergency)) { $warn = ''; eval { $dispatcher->$method( "This is a '$method' action" ) }; like( $@,qr#eval \{\.\.\.} called at $0 line \d+#, "Check if no error in eval for '$method'" ); ok( !$warn,"Check if no warning occurred: $warn" ) } Log-Dispatch-Perl-0.04/lib/Log/000755 000765 000765 00000000000 11737537323 015565 5ustar00lizliz000000 000000 Log-Dispatch-Perl-0.04/lib/Log/Dispatch/000755 000765 000765 00000000000 11737537323 017324 5ustar00lizliz000000 000000 Log-Dispatch-Perl-0.04/lib/Log/Dispatch/Perl.pm000644 000765 000765 00000016127 11737526674 020602 0ustar00lizliz000000 000000 package Log::Dispatch::Perl; use base 'Log::Dispatch::Output'; $VERSION= '0.04'; # be as strict and verbose as possible use strict; use warnings; # initialize level name / number conversion hashes my %LEVEL2NUM; my %NUM2LEVEL; do { my @level2num= ( debug => 0, info => 1, notice => 2, warning => 3, error => 4, err => 4, # MUST be after "error" critical => 5, crit => 5, # MUST be after "critical" alert => 6, emergency => 7, emerg => 7, # MUST be after "emergency" ); %LEVEL2NUM= @level2num; %NUM2LEVEL= reverse @level2num; # order fixes double assignments }; # hide ourselves from Carp my $havecarp= defined $Carp::VERSION; unless ( $] < 5.008 ) { $Carp::Internal{$_}= 1 foreach ( 'Log::Dispatch', 'Log::Dispatch::Output' ); } # action to actual code hash my %ACTION2CODE; %ACTION2CODE= ( '' => sub { undef }, carp => $havecarp ? \&Carp::carp : sub { $havecarp ||= require Carp; $ACTION2CODE{carp}= \&Carp::carp; goto &Carp::carp; }, cluck => $] < 5.008 ? sub { $havecarp ||= require Carp; ( my $m= Carp::longmess() ) =~ s#\s+Log::Dispatch::[^\n]+\n##sg; return CORE::warn $_[0] . $m; } : sub { $havecarp ||= require Carp; return CORE::warn $_[0] . Carp::longmess(); }, confess => $] < 5.008 ? sub { $havecarp ||= require Carp; ( my $m = Carp::longmess() ) =~ s#\s+Log::Dispatch::[^\n]+\n##sg; return CORE::die $_[0] . $m; } : sub { $havecarp ||= require Carp; return CORE::die $_[0] . Carp::longmess(); }, croak => $havecarp ? \&Carp::croak : sub { $havecarp ||= require Carp; $ACTION2CODE{croak}= \&Carp::croak; goto &Carp::croak; }, die => sub { CORE::die @_ }, warn => sub { CORE::warn @_ }, ); # satisfy require 1; #------------------------------------------------------------------------------- # # Class methods # #------------------------------------------------------------------------------- # new # # Required by Log::Dispatch::Output. Creates a new Log::Dispatch::Perl # object # # IN: 1 class # 2..N parameters as a hash # OUT: 1 instantiated object sub new { my ( $class, %param )= @_; # do the basic initializations my $self= bless {}, ref $class || $class; $self->_basic_init( %param ); # we have specific actions specified my @action; if ( my $actions= $param{action} ) { # check all actions specified foreach my $level ( keys %{$actions} ) { my $action= $actions->{$level}; $level= $NUM2LEVEL{$level} if exists $NUM2LEVEL{$level}; # sanity check, store if ok my $warn; warn qq{"$level" is an unknown logging level, ignored\n"}, $warn++ if !exists $LEVEL2NUM{ $level || '' }; warn qq{"$action" is an unknown Perl action, ignored\n"}, $warn++ if !exists $ACTION2CODE{$action}; $action[$LEVEL2NUM{$level}]= $ACTION2CODE{$action} if !$warn; } } # set the actions that have not yet been specified $action[0] ||= $ACTION2CODE{''}; $action[1] ||= $ACTION2CODE{''}; $action[2] ||= $ACTION2CODE{warn}; $action[3] ||= $ACTION2CODE{warn}; $action[4] ||= $ACTION2CODE{die}; $action[5] ||= $ACTION2CODE{die}; $action[6] ||= $ACTION2CODE{confess}; $action[7] ||= $ACTION2CODE{confess}; # save this setting $self->{action}= \@action; return $self; } #new #------------------------------------------------------------------------------- # # Instance methods # #------------------------------------------------------------------------------- # log_message # # Required by Log::Dispatch. Log a single message. # # IN: 1 instantiated Log::Dispatch::Perl object # 2..N hash with parameters as required by Log::Dispatch sub log_message { my ( $self, %param )= @_; # huh? my $level= $param{level}; return if !exists $LEVEL2NUM{$level} and !exists $NUM2LEVEL{$level}; # obtain level number my $num= $LEVEL2NUM{$level}; $num= $level if !defined $num; # //= # set message my $message= $param{message}; $message .= "\n" if substr( $message, -1, 1 ) ne "\n"; @_= ($message); # log it the right way goto &{$self->{action}->[$num]}; } #log_message #------------------------------------------------------------------------------- __END__ =head1 NAME Log::Dispatch::Perl - Use core Perl functions for logging =head1 SYNOPSIS use Log::Dispatch::Perl (); my $dispatcher = Log::Dispatch->new; $dispatcher->add( Log::Dispatch::Perl->new( name => 'foo', min_level => 'info', action => { debug => '', info => '', notice => 'warn', warning => 'warn', error => 'die', critical => 'die', alert => 'croak', emergency => 'croak', }, ) ); $dispatcher->warning( "This is a warning" ); =head1 VERSION This documentation describes version 0.04. =head1 DESCRIPTION The "Log::Dispatch::Perl" module offers a logging alternative using standard Perl core functions. It allows you to fall back to the common Perl alternatives for logging, such as "warn" and "cluck". It also adds the possibility for a logging action to halt the current environment, such as with "die" and "croak". =head1 POSSIBLE ACTIONS The following actions are currently supported (in alphabetical order): =head2 (absent or empty string or undef) Indicates no action should be executed. Default for log levels "debug" and "info". =head2 carp Indicates a "carp" action should be executed. See L. Halts execution. =head2 cluck Indicates a "cluck" action should be executed. See L. Does B halt execution. =head2 confess Indicates a "confess" action should be executed. See L. Halts execution. =head2 croak Indicates a "croak" action should be executed. See L. Halts execution. =head2 die Indicates a "die" action should be executed. See L. Halts execution. =head2 warn Indicates a "warn" action should be executed. See L. Does B halt execution. =head1 REQUIRED MODULES Log::Dispatch (1.16) =head1 AUTHOR Elizabeth Mattijsen, . Please report bugs to . =head1 COPYRIGHT Copyright (c) 2004, 2012 Elizabeth Mattijsen . All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut