-BEGIN { chdir 't' if -d 't' };\r
-BEGIN { use lib '../lib' };\r
-\r
-use strict;\r
-use File::Spec;\r
-\r
-### only run interactive tests when there's someone that can answer them\r
-use Test::More -t STDOUT\r
- ? 'no_plan' \r
- : ( skip_all => "No interactive tests from harness" );\r
-\r
-my $Class = 'IPC::Cmd';\r
-my $Child = File::Spec->catfile( qw[src child.pl] );\r
-my @FDs = 0..20;\r
-my $IsWin32 = $^O eq 'MSWin32';\r
-\r
-use_ok( $Class, 'run' );\r
-$IPC::Cmd::DEBUG = 1;\r
-\r
-my $Have_IPC_Run = $Class->can_use_ipc_run;\r
-my $Have_IPC_Open3 = $Class->can_use_ipc_open3;\r
-\r
-### configurations to test IPC::Cmd with\r
-my @Conf = ( \r
- [ $Have_IPC_Run, $Have_IPC_Open3 ], \r
- [ 0, $Have_IPC_Open3 ], \r
- [ 0, 0 ] \r
-);\r
-\r
-\r
-\r
-\r
-### first, check which FD's are open. they should be open\r
-### /after/ we run our tests as well.\r
-### 0, 1 and 2 should be open, as they are STDOUT, STDERR and STDIN\r
-### XXX 2 are opened by Test::Builder at least.. this is 'whitebox'\r
-### knowledge, so unsafe to test against. around line 1322:\r
-# sub _open_testhandles {\r
-# return if $Opened_Testhandles;\r
-# # We dup STDOUT and STDERR so people can change them in their\r
-# # test suites while still getting normal test output.\r
-# open(TESTOUT, ">&STDOUT") or die "Can't dup STDOUT: $!";\r
-# open(TESTERR, ">&STDERR") or die "Can't dup STDERR: $!";\r
-# $Opened_Testhandles = 1;\r
-# }\r
-\r
-my @Opened;\r
-{ for ( @FDs ) {\r
- my $fh;\r
- my $rv = open $fh, "<&$_";\r
- push @Opened, $_ if $rv;\r
- }\r
- diag( "Opened FDs: @Opened" );\r
- cmp_ok( scalar(@Opened), '>=', 3,\r
- "At least 3 FDs are opened" );\r
-}\r
-\r
-for my $aref ( @Conf ) {\r
-\r
- ### stupid warnings\r
- local $IPC::Cmd::USE_IPC_RUN = $aref->[0];\r
- local $IPC::Cmd::USE_IPC_RUN = $aref->[0];\r
-\r
- local $IPC::Cmd::USE_IPC_OPEN3 = $aref->[1];\r
- local $IPC::Cmd::USE_IPC_OPEN3 = $aref->[1];\r
-\r
- diag("Config: IPC::Run = $aref->[0] IPC::Open3 = $aref->[1]");\r
- ok( -t STDIN, "STDIN attached to a tty" );\r
- \r
- for my $cmd ( qq[$^X $Child], qq[$^X $Child | $^X -neprint] ) {\r
- \r
- diag("Please enter some input. It will be echo'd back to you");\r
- my $buffer;\r
- my $ok = run( command => $cmd, verbose => 1, buffer => \$buffer );\r
- \r
- ok( $ok, " Command '$cmd' ran succesfully" );\r
- \r
- SKIP: {\r
- skip "No buffers available", 1 unless $Class->can_capture_buffer;\r
- ok( defined $buffer, " Input captured" );\r
- }\r
- }\r
-}\r
-\r
-### check we didnt leak any FHs\r
-{ ### should be opened\r
- my %open = map { $_ => 1 } @Opened;\r
- \r
- for ( @FDs ) {\r
- my $fh;\r
- my $rv = open $fh, "<&=$_";\r
- \r
- ### these should be open \r
- if( $open{$_} ) {\r
- ok( $rv, "FD $_ opened" );\r
- ok( $fh, " FH indeed opened" );\r
- is( fileno($fh), $_, " Opened at the correct fileno($_)" );\r
- } else {\r
- ok( !$rv, "FD $_ not opened" );\r
- ok( !(fileno($fh)), " FH indeed closed" );\r
-\r
- ### extra debug info if tests fail\r
-# use Devel::Peek;\r
-# use Data::Dumper;\r
-# diag( "RV=$rv FH=$fh Fileno=". fileno($fh). Dump($fh) ) if $rv;\r
-# diag( Dumper( [stat $fh] ) ) if $rv;\r
-\r
- }\r
- }\r
-}\r
+BEGIN { chdir 't' if -d 't' };
+BEGIN { use lib '../lib' };
+
+use strict;
+use File::Spec;
+
+### only run interactive tests when there's someone that can answer them
+use Test::More -t STDOUT
+ ? 'no_plan'
+ : ( skip_all => "No interactive tests from harness" );
+
+my $Class = 'IPC::Cmd';
+my $Child = File::Spec->catfile( qw[src child.pl] );
+my @FDs = 0..20;
+my $IsWin32 = $^O eq 'MSWin32';
+
+use_ok( $Class, 'run' );
+$IPC::Cmd::DEBUG = 1;
+
+my $Have_IPC_Run = $Class->can_use_ipc_run;
+my $Have_IPC_Open3 = $Class->can_use_ipc_open3;
+
+### configurations to test IPC::Cmd with
+my @Conf = (
+ [ $Have_IPC_Run, $Have_IPC_Open3 ],
+ [ 0, $Have_IPC_Open3 ],
+ [ 0, 0 ]
+);
+
+
+
+
+### first, check which FD's are open. they should be open
+### /after/ we run our tests as well.
+### 0, 1 and 2 should be open, as they are STDOUT, STDERR and STDIN
+### XXX 2 are opened by Test::Builder at least.. this is 'whitebox'
+### knowledge, so unsafe to test against. around line 1322:
+# sub _open_testhandles {
+# return if $Opened_Testhandles;
+# # We dup STDOUT and STDERR so people can change them in their
+# # test suites while still getting normal test output.
+# open(TESTOUT, ">&STDOUT") or die "Can't dup STDOUT: $!";
+# open(TESTERR, ">&STDERR") or die "Can't dup STDERR: $!";
+# $Opened_Testhandles = 1;
+# }
+
+my @Opened;
+{ for ( @FDs ) {
+ my $fh;
+ my $rv = open $fh, "<&$_";
+ push @Opened, $_ if $rv;
+ }
+ diag( "Opened FDs: @Opened" );
+ cmp_ok( scalar(@Opened), '>=', 3,
+ "At least 3 FDs are opened" );
+}
+
+for my $aref ( @Conf ) {
+
+ ### stupid warnings
+ local $IPC::Cmd::USE_IPC_RUN = $aref->[0];
+ local $IPC::Cmd::USE_IPC_RUN = $aref->[0];
+
+ local $IPC::Cmd::USE_IPC_OPEN3 = $aref->[1];
+ local $IPC::Cmd::USE_IPC_OPEN3 = $aref->[1];
+
+ diag("Config: IPC::Run = $aref->[0] IPC::Open3 = $aref->[1]");
+ ok( -t STDIN, "STDIN attached to a tty" );
+
+ for my $cmd ( qq[$^X $Child], qq[$^X $Child | $^X -neprint] ) {
+
+ diag("Please enter some input. It will be echo'd back to you");
+ my $buffer;
+ my $ok = run( command => $cmd, verbose => 1, buffer => \$buffer );
+
+ ok( $ok, " Command '$cmd' ran succesfully" );
+
+ SKIP: {
+ skip "No buffers available", 1 unless $Class->can_capture_buffer;
+ ok( defined $buffer, " Input captured" );
+ }
+ }
+}
+
+### check we didnt leak any FHs
+{ ### should be opened
+ my %open = map { $_ => 1 } @Opened;
+
+ for ( @FDs ) {
+ my $fh;
+ my $rv = open $fh, "<&=$_";
+
+ ### these should be open
+ if( $open{$_} ) {
+ ok( $rv, "FD $_ opened" );
+ ok( $fh, " FH indeed opened" );
+ is( fileno($fh), $_, " Opened at the correct fileno($_)" );
+ } else {
+ ok( !$rv, "FD $_ not opened" );
+ ok( !(fileno($fh)), " FH indeed closed" );
+
+ ### extra debug info if tests fail
+# use Devel::Peek;
+# use Data::Dumper;
+# diag( "RV=$rv FH=$fh Fileno=". fileno($fh). Dump($fh) ) if $rv;
+# diag( Dumper( [stat $fh] ) ) if $rv;
+
+ }
+ }
+}
-package Log::Message;\r
-\r
-use strict;\r
-\r
-use Params::Check qw[check];\r
-use Log::Message::Item;\r
-use Log::Message::Config;\r
-use Locale::Maketext::Simple Style => 'gettext';\r
-\r
-local $Params::Check::VERBOSE = 1;\r
-\r
-BEGIN {\r
- use vars qw[$VERSION @ISA $STACK $CONFIG];\r
-\r
- $VERSION = 0.01;\r
-\r
- $STACK = [];\r
-}\r
-\r
-\r
-=pod\r
-\r
-=head1 NAME\r
-\r
-Log::Message - A generic message storing mechanism;\r
-\r
-=head1 SYNOPSIS\r
-\r
- use Log::Message private => 0, config => '/our/cf_file';\r
-\r
- my $log = Log::Message->new( private => 1,\r
- level => 'log',\r
- config => '/my/cf_file',\r
- );\r
-\r
- $log->store('this is my first message');\r
-\r
- $log->store( message => 'message #2',\r
- tag => 'MY_TAG',\r
- level => 'carp',\r
- extra => ['this is an argument to the handler'],\r
- );\r
-\r
- my @last_five_items = $log->retrieve(5);\r
-\r
- my @items = $log->retrieve( tag => qr/my_tag/i,\r
- message => qr/\d/,\r
- remove => 1,\r
- );\r
-\r
- my @items = $log->final( level => qr/carp/, amount => 2 );\r
-\r
- my $first_error = $log->first()\r
-\r
- # croak with the last error on the stack\r
- $log->final->croak;\r
-\r
- # empty the stack\r
- $log->flush();\r
-\r
-\r
-=head1 DESCRIPTION\r
-\r
-Log::Message is a generic message storage mechanism.\r
-It allows you to store messages on a stack -- either shared or private\r
--- and assign meta-data to it.\r
-Some meta-data will automatically be added for you, like a timestamp\r
-and a stack trace, but some can be filled in by the user, like a tag\r
-by which to identify it or group it, and a level at which to handle\r
-the message (for example, log it, or die with it)\r
-\r
-Log::Message also provides a powerful way of searching through items\r
-by regexes on messages, tags and level.\r
-\r
-=head1 Hierarchy\r
-\r
-There are 4 modules of interest when dealing with the Log::Message::*\r
-modules:\r
-\r
-=over 4\r
-\r
-=item Log::Message\r
-\r
-Log::Message provides a few methods to manipulate the stack it keeps.\r
-It has the option of keeping either a private or a public stack.\r
-More on this below.\r
-\r
-=item Log::Message::Item\r
-\r
-These are individual message items, which are objects that contain\r
-the user message as well as the meta-data described above.\r
-See the L<Log::Message::Item> manpage to see how to extract this \r
-meta-data and how to work with the Item objects.\r
-You should never need to create your own Item objects, but knowing\r
-about their methods and accessors is important if you want to write\r
-your own handlers. (See below)\r
-\r
-=item Log::Message::Handlers\r
-\r
-These are a collection of handlers that will be called for a level\r
-that is used on a L<Log::Message::Item> object.\r
-For example, if a message is logged with the 'carp' level, the 'carp'\r
-handler from L<Log::Message::Handlers> will be called.\r
-See the L<Log::Message::Handlers> manpage for more explanation about how\r
-handlers work, which one are available and how to create your own.\r
-\r
-=item Log::Message::Config\r
-\r
-Per Log::Message object, there is a configuration required that will\r
-fill in defaults if the user did not specify arguments to override\r
-them (like for example what tag will be set if none was provided),\r
-L<Log::Message::Config> handles the creation of these configurations.\r
-\r
-Configuration can be specified in 4 ways:\r
-\r
-=over 4\r
-\r
-=item *\r
-\r
-As a configuration file when you C<use Log::Message>\r
-\r
-=item *\r
-\r
-As arguments when you C<use Log::Message>\r
-\r
-=item *\r
-\r
-As a configuration file when you create a new L<Log::Message> object.\r
-(The config will then only apply to that object if you marked it as\r
-private)\r
-\r
-=item *\r
-\r
-As arguments when you create a new Log::Message object.\r
-\r
-You should never need to use the L<Log::Message::Config> module yourself,\r
-as this is transparently done by L<Log::Message>, but its manpage does\r
-provide an explanation of how you can create a config file.\r
-\r
-=back\r
-\r
-=back\r
-\r
-=head1 Options\r
-\r
-When using Log::Message, or creating a new Log::Message object, you can\r
-supply various options to alter its behaviour.\r
-Of course, there are sensible defaults should you choose to omit these\r
-options.\r
-\r
-Below an explanation of all the options and how they work.\r
-\r
-=over 4\r
-\r
-=item config\r
-\r
-The path to a configuration file to be read.\r
-See the manpage of L<Log::Message::Config> for the required format\r
-\r
-These options will be overridden by any explicit arguments passed.\r
-\r
-=item private\r
-\r
-Whether to create, by default, private or shared objects.\r
-If you choose to create shared objects, all Log::Message objects will\r
-use the same stack.\r
-\r
-This means that even though every module may make its own $log object\r
-they will still be sharing the same error stack on which they are\r
-putting errors and from which they are retrieving.\r
-\r
-This can be useful in big projects.\r
-\r
-If you choose to create a private object, then the stack will of\r
-course be private to this object, but it will still fall back to the\r
-shared config should no private config or overriding arguments be\r
-provided.\r
-\r
-=item verbose\r
-\r
-Log::Message makes use of another module to validate its arguments,\r
-which is called L<Params::Check>, which is a lightweight, yet \r
-powerful input checker and parser. (See the L<Params::Check> \r
-manpage for details).\r
-\r
-The verbose setting will control whether this module will\r
-generate warnings if something improper is passed as input, or merely\r
-silently returns undef, at which point Log::Message will generate a\r
-warning.\r
-\r
-It's best to just leave this at its default value, which is '1'\r
-\r
-=item tag\r
-\r
-The tag to add to messages if none was provided. If neither your\r
-config, nor any specific arguments supply a tag, then Log::Message will\r
-set it to 'NONE'\r
-\r
-Tags are useful for searching on or grouping by. For example, you\r
-could tag all the messages you want to go to the user as 'USER ERROR'\r
-and all those that are only debug information with 'DEBUG'.\r
-\r
-At the end of your program, you could then print all the ones tagged\r
-'USER ERROR' to STDOUT, and those marked 'DEBUG' to a log file.\r
-\r
-=item level\r
-\r
-C<level> describes what action to take when a message is logged. Just\r
-like C<tag>, Log::Message will provide a default (which is 'log') if\r
-neither your config file, nor any explicit arguments are given to\r
-override it.\r
-\r
-See the Log::Message::Handlers manpage to see what handlers are\r
-available by default and what they do, as well as to how to add your\r
-own handlers.\r
-\r
-=item remove\r
-\r
-This indicates whether or not to automatically remove the messages\r
-from the stack when you've retrieved them.\r
-The default setting provided by Log::Message is '0': do not remove.\r
-\r
-=item chrono\r
-\r
-This indicates whether messages should always be fetched in\r
-chronological order or not.\r
-This simply means that you can choose whether, when retrieving items,\r
-the item most recently added should be returned first, or the one that\r
-had been added most long ago.\r
-\r
-The default is to return the newest ones first\r
-\r
-=back\r
-\r
-=cut\r
-\r
-\r
-### subs ###\r
-sub import {\r
- my $pkg = shift;\r
- my %hash = @_;\r
-\r
- $CONFIG = new Log::Message::Config( %hash )\r
- or die loc(qq[Problem initialising %1], __PACKAGE__);\r
-\r
-}\r
-\r
-=head1 Methods\r
-\r
-=head2 new\r
-\r
-This creates a new Log::Message object; The parameters it takes are\r
-described in the C<Options> section below and let it just be repeated\r
-that you can use these options like this:\r
-\r
- my $log = Log::Message->new( %options );\r
-\r
-as well as during C<use> time, like this:\r
-\r
- use Log::Message option1 => value, option2 => value\r
-\r
-There are but 3 rules to keep in mind:\r
-\r
-=over 4\r
-\r
-=item *\r
-\r
-Provided arguments take precedence over a configuration file.\r
-\r
-=item *\r
-\r
-Arguments to new take precedence over options provided at C<use> time\r
-\r
-=item *\r
-\r
-An object marked private will always have an empty stack to begin with\r
-\r
-=back\r
-\r
-=cut\r
-\r
-sub new {\r
- my $class = shift;\r
- my %hash = @_;\r
-\r
- my $conf = new Log::Message::Config( %hash, default => $CONFIG ) or return undef;\r
-\r
- if( $conf->private || $CONFIG->private ) {\r
-\r
- return _new_stack( $class, config => $conf );\r
-\r
- } else {\r
- my $obj = _new_stack( $class, config => $conf, stack => $STACK );\r
-\r
- ### if it was an empty stack, this was the first object\r
- ### in that case, set the global stack to match it for\r
- ### subsequent new, non-private objects\r
- $STACK = $obj->{STACK} unless scalar @$STACK;\r
-\r
- return $obj;\r
- }\r
-}\r
-\r
-sub _new_stack {\r
- my $class = shift;\r
- my %hash = @_;\r
-\r
- my $tmpl = {\r
- stack => { default => [] },\r
- config => { default => bless( {}, 'Log::Message::Config'),\r
- required => 1,\r
- strict_type => 1\r
- },\r
- };\r
-\r
- my $args = check( $tmpl, \%hash, $CONFIG->verbose ) or (\r
- warn(loc(q[Could not create a new stack object: %1], \r
- Params::Check->last_error)\r
- ),\r
- return\r
- );\r
-\r
-\r
- my %self = map { uc, $args->{$_} } keys %$args;\r
-\r
- return bless \%self, $class;\r
-}\r
-\r
-sub _get_conf {\r
- my $self = shift;\r
- my $what = shift;\r
-\r
- return defined $self->{CONFIG}->$what()\r
- ? $self->{CONFIG}->$what()\r
- : defined $CONFIG->$what()\r
- ? $CONFIG->$what()\r
- : undef; # should never get here\r
-}\r
-\r
-=head2 store\r
-\r
-This will create a new Item object and store it on the stack.\r
-\r
-Possible arguments you can give to it are:\r
-\r
-=over 4\r
-\r
-=item message\r
-\r
-This is the only argument that is required. If no other arguments\r
-are given, you may even leave off the C<message> key. The argument\r
-will then automatically be assumed to be the message.\r
-\r
-=item tag\r
-\r
-The tag to add to this message. If not provided, Log::Message will look\r
-in your configuration for one.\r
-\r
-=item level\r
-\r
-The level at which this message should be handled. If not provided,\r
-Log::Message will look in your configuration for one.\r
-\r
-=item extra\r
-\r
-This is an array ref with arguments passed to the handler for this\r
-message, when it is called from store();\r
-\r
-The handler will receive them as a normal list\r
-\r
-=back\r
-\r
-store() will return true upon success and undef upon failure, as well\r
-as issue a warning as to why it failed.\r
-\r
-=cut\r
-\r
-### should extra be stored in the item object perhaps for later retrieval?\r
-sub store {\r
- my $self = shift;\r
- my %hash = ();\r
-\r
- my $tmpl = {\r
- message => {\r
- default => '',\r
- strict_type => 1,\r
- required => 1,\r
- },\r
- tag => { default => $self->_get_conf('tag') },\r
- level => { default => $self->_get_conf('level'), },\r
- extra => { default => [], strict_type => 1 },\r
- };\r
-\r
- ### single arg means just the message\r
- ### otherwise, they are named\r
- if( @_ == 1 ) {\r
- $hash{message} = shift;\r
- } else {\r
- %hash = @_;\r
- }\r
-\r
- my $args = check( $tmpl, \%hash ) or ( \r
- warn( loc(q[Could not store error: %1], Params::Check->last_error) ), \r
- return \r
- );\r
-\r
- my $extra = delete $args->{extra};\r
- my $item = Log::Message::Item->new( %$args,\r
- parent => $self,\r
- id => scalar @{$self->{STACK}}\r
- )\r
- or ( warn( loc(q[Could not create new log item!]) ), return undef );\r
-\r
- push @{$self->{STACK}}, $item;\r
-\r
- { no strict 'refs';\r
-\r
- my $sub = $args->{level};\r
-\r
- $item->$sub( @$extra );\r
- }\r
-\r
- return 1;\r
-}\r
-\r
-=head2 retrieve\r
-\r
-This will retrieve all message items matching the criteria specified\r
-from the stack.\r
-\r
-Here are the criteria you can discriminate on:\r
-\r
-=over 4\r
-\r
-=item tag\r
-\r
-A regex to which the tag must adhere. For example C<qr/\w/>.\r
-\r
-=item level\r
-\r
-A regex to which the level must adhere.\r
-\r
-=item message\r
-\r
-A regex to which the message must adhere.\r
-\r
-=item amount\r
-\r
-Maximum amount of errors to return\r
-\r
-=item chrono\r
-\r
-Return in chronological order, or not?\r
-\r
-=item remove\r
-\r
-Remove items from the stack upon retrieval?\r
-\r
-=back\r
-\r
-In scalar context it will return the first item matching your criteria\r
-and in list context, it will return all of them.\r
-\r
-If an error occurs while retrieving, a warning will be issued and\r
-undef will be returned.\r
-\r
-=cut\r
-\r
-sub retrieve {\r
- my $self = shift;\r
- my %hash = ();\r
-\r
- my $tmpl = {\r
- tag => { default => qr/.*/ },\r
- level => { default => qr/.*/ },\r
- message => { default => qr/.*/ },\r
- amount => { default => '' },\r
- remove => { default => $self->_get_conf('remove') },\r
- chrono => { default => $self->_get_conf('chrono') },\r
- };\r
-\r
- ### single arg means just the amount\r
- ### otherwise, they are named\r
- if( @_ == 1 ) {\r
- $hash{amount} = shift;\r
- } else {\r
- %hash = @_;\r
- }\r
-\r
- my $args = check( $tmpl, \%hash ) or (\r
- warn( loc(q[Could not parse input: %1], Params::Check->last_error) ), \r
- return \r
- );\r
- \r
- my @list =\r
- grep { $_->tag =~ /$args->{tag}/ ? 1 : 0 }\r
- grep { $_->level =~ /$args->{level}/ ? 1 : 0 }\r
- grep { $_->message =~ /$args->{message}/ ? 1 : 0 }\r
- grep { defined }\r
- $args->{chrono}\r
- ? @{$self->{STACK}}\r
- : reverse @{$self->{STACK}};\r
-\r
- my $amount = $args->{amount} || scalar @list;\r
-\r
- my @rv = map {\r
- $args->{remove} ? $_->remove : $_\r
- } scalar @list > $amount\r
- ? splice(@list,0,$amount)\r
- : @list;\r
-\r
- return wantarray ? @rv : $rv[0];\r
-}\r
-\r
-=head2 first\r
-\r
-This is a shortcut for retrieving the first item(s) stored on the\r
-stack. It will default to only retrieving one if called with no\r
-arguments, and will always return results in chronological order.\r
-\r
-If you only supply one argument, it is assumed to be the amount you\r
-wish returned.\r
-\r
-Furthermore, it can take the same arguments as C<retrieve> can.\r
-\r
-=cut\r
-\r
-sub first {\r
- my $self = shift;\r
-\r
- my $amt = @_ == 1 ? shift : 1;\r
- return $self->retrieve( amount => $amt, @_, chrono => 1 );\r
-}\r
-\r
-=head2 last\r
-\r
-This is a shortcut for retrieving the last item(s) stored on the\r
-stack. It will default to only retrieving one if called with no\r
-arguments, and will always return results in reverse chronological\r
-order.\r
-\r
-If you only supply one argument, it is assumed to be the amount you\r
-wish returned.\r
-\r
-Furthermore, it can take the same arguments as C<retrieve> can.\r
-\r
-=cut\r
-\r
-sub final {\r
- my $self = shift;\r
-\r
- my $amt = @_ == 1 ? shift : 1;\r
- return $self->retrieve( amount => $amt, @_, chrono => 0 );\r
-}\r
-\r
-=head2 flush\r
-\r
-This removes all items from the stack and returns them to the caller\r
-\r
-=cut\r
-\r
-sub flush {\r
- my $self = shift;\r
- \r
- return splice @{$self->{STACK}};\r
-}\r
-\r
-=head1 SEE ALSO\r
-\r
-L<Log::Message::Item>, L<Log::Message::Handlers>, L<Log::Message::Config>\r
-\r
-=head1 AUTHOR\r
-\r
-This module by\r
-Jos Boumans E<lt>kane@cpan.orgE<gt>.\r
-\r
-=head1 Acknowledgements\r
-\r
-Thanks to Ann Barcomb for her suggestions.\r
-\r
-=head1 COPYRIGHT\r
-\r
-This module is\r
-copyright (c) 2002 Jos Boumans E<lt>kane@cpan.orgE<gt>.\r
-All rights reserved.\r
-\r
-This library is free software;\r
-you may redistribute and/or modify it under the same\r
-terms as Perl itself.\r
-\r
-=cut\r
-\r
-1;\r
-\r
-# Local variables:\r
-# c-indentation-style: bsd\r
-# c-basic-offset: 4\r
-# indent-tabs-mode: nil\r
-# End:\r
-# vim: expandtab shiftwidth=4:\r
+package Log::Message;
+
+use strict;
+
+use Params::Check qw[check];
+use Log::Message::Item;
+use Log::Message::Config;
+use Locale::Maketext::Simple Style => 'gettext';
+
+local $Params::Check::VERBOSE = 1;
+
+BEGIN {
+ use vars qw[$VERSION @ISA $STACK $CONFIG];
+
+ $VERSION = 0.01;
+
+ $STACK = [];
+}
+
+
+=pod
+
+=head1 NAME
+
+Log::Message - A generic message storing mechanism;
+
+=head1 SYNOPSIS
+
+ use Log::Message private => 0, config => '/our/cf_file';
+
+ my $log = Log::Message->new( private => 1,
+ level => 'log',
+ config => '/my/cf_file',
+ );
+
+ $log->store('this is my first message');
+
+ $log->store( message => 'message #2',
+ tag => 'MY_TAG',
+ level => 'carp',
+ extra => ['this is an argument to the handler'],
+ );
+
+ my @last_five_items = $log->retrieve(5);
+
+ my @items = $log->retrieve( tag => qr/my_tag/i,
+ message => qr/\d/,
+ remove => 1,
+ );
+
+ my @items = $log->final( level => qr/carp/, amount => 2 );
+
+ my $first_error = $log->first()
+
+ # croak with the last error on the stack
+ $log->final->croak;
+
+ # empty the stack
+ $log->flush();
+
+
+=head1 DESCRIPTION
+
+Log::Message is a generic message storage mechanism.
+It allows you to store messages on a stack -- either shared or private
+-- and assign meta-data to it.
+Some meta-data will automatically be added for you, like a timestamp
+and a stack trace, but some can be filled in by the user, like a tag
+by which to identify it or group it, and a level at which to handle
+the message (for example, log it, or die with it)
+
+Log::Message also provides a powerful way of searching through items
+by regexes on messages, tags and level.
+
+=head1 Hierarchy
+
+There are 4 modules of interest when dealing with the Log::Message::*
+modules:
+
+=over 4
+
+=item Log::Message
+
+Log::Message provides a few methods to manipulate the stack it keeps.
+It has the option of keeping either a private or a public stack.
+More on this below.
+
+=item Log::Message::Item
+
+These are individual message items, which are objects that contain
+the user message as well as the meta-data described above.
+See the L<Log::Message::Item> manpage to see how to extract this
+meta-data and how to work with the Item objects.
+You should never need to create your own Item objects, but knowing
+about their methods and accessors is important if you want to write
+your own handlers. (See below)
+
+=item Log::Message::Handlers
+
+These are a collection of handlers that will be called for a level
+that is used on a L<Log::Message::Item> object.
+For example, if a message is logged with the 'carp' level, the 'carp'
+handler from L<Log::Message::Handlers> will be called.
+See the L<Log::Message::Handlers> manpage for more explanation about how
+handlers work, which one are available and how to create your own.
+
+=item Log::Message::Config
+
+Per Log::Message object, there is a configuration required that will
+fill in defaults if the user did not specify arguments to override
+them (like for example what tag will be set if none was provided),
+L<Log::Message::Config> handles the creation of these configurations.
+
+Configuration can be specified in 4 ways:
+
+=over 4
+
+=item *
+
+As a configuration file when you C<use Log::Message>
+
+=item *
+
+As arguments when you C<use Log::Message>
+
+=item *
+
+As a configuration file when you create a new L<Log::Message> object.
+(The config will then only apply to that object if you marked it as
+private)
+
+=item *
+
+As arguments when you create a new Log::Message object.
+
+You should never need to use the L<Log::Message::Config> module yourself,
+as this is transparently done by L<Log::Message>, but its manpage does
+provide an explanation of how you can create a config file.
+
+=back
+
+=back
+
+=head1 Options
+
+When using Log::Message, or creating a new Log::Message object, you can
+supply various options to alter its behaviour.
+Of course, there are sensible defaults should you choose to omit these
+options.
+
+Below an explanation of all the options and how they work.
+
+=over 4
+
+=item config
+
+The path to a configuration file to be read.
+See the manpage of L<Log::Message::Config> for the required format
+
+These options will be overridden by any explicit arguments passed.
+
+=item private
+
+Whether to create, by default, private or shared objects.
+If you choose to create shared objects, all Log::Message objects will
+use the same stack.
+
+This means that even though every module may make its own $log object
+they will still be sharing the same error stack on which they are
+putting errors and from which they are retrieving.
+
+This can be useful in big projects.
+
+If you choose to create a private object, then the stack will of
+course be private to this object, but it will still fall back to the
+shared config should no private config or overriding arguments be
+provided.
+
+=item verbose
+
+Log::Message makes use of another module to validate its arguments,
+which is called L<Params::Check>, which is a lightweight, yet
+powerful input checker and parser. (See the L<Params::Check>
+manpage for details).
+
+The verbose setting will control whether this module will
+generate warnings if something improper is passed as input, or merely
+silently returns undef, at which point Log::Message will generate a
+warning.
+
+It's best to just leave this at its default value, which is '1'
+
+=item tag
+
+The tag to add to messages if none was provided. If neither your
+config, nor any specific arguments supply a tag, then Log::Message will
+set it to 'NONE'
+
+Tags are useful for searching on or grouping by. For example, you
+could tag all the messages you want to go to the user as 'USER ERROR'
+and all those that are only debug information with 'DEBUG'.
+
+At the end of your program, you could then print all the ones tagged
+'USER ERROR' to STDOUT, and those marked 'DEBUG' to a log file.
+
+=item level
+
+C<level> describes what action to take when a message is logged. Just
+like C<tag>, Log::Message will provide a default (which is 'log') if
+neither your config file, nor any explicit arguments are given to
+override it.
+
+See the Log::Message::Handlers manpage to see what handlers are
+available by default and what they do, as well as to how to add your
+own handlers.
+
+=item remove
+
+This indicates whether or not to automatically remove the messages
+from the stack when you've retrieved them.
+The default setting provided by Log::Message is '0': do not remove.
+
+=item chrono
+
+This indicates whether messages should always be fetched in
+chronological order or not.
+This simply means that you can choose whether, when retrieving items,
+the item most recently added should be returned first, or the one that
+had been added most long ago.
+
+The default is to return the newest ones first
+
+=back
+
+=cut
+
+
+### subs ###
+sub import {
+ my $pkg = shift;
+ my %hash = @_;
+
+ $CONFIG = new Log::Message::Config( %hash )
+ or die loc(qq[Problem initialising %1], __PACKAGE__);
+
+}
+
+=head1 Methods
+
+=head2 new
+
+This creates a new Log::Message object; The parameters it takes are
+described in the C<Options> section below and let it just be repeated
+that you can use these options like this:
+
+ my $log = Log::Message->new( %options );
+
+as well as during C<use> time, like this:
+
+ use Log::Message option1 => value, option2 => value
+
+There are but 3 rules to keep in mind:
+
+=over 4
+
+=item *
+
+Provided arguments take precedence over a configuration file.
+
+=item *
+
+Arguments to new take precedence over options provided at C<use> time
+
+=item *
+
+An object marked private will always have an empty stack to begin with
+
+=back
+
+=cut
+
+sub new {
+ my $class = shift;
+ my %hash = @_;
+
+ my $conf = new Log::Message::Config( %hash, default => $CONFIG ) or return undef;
+
+ if( $conf->private || $CONFIG->private ) {
+
+ return _new_stack( $class, config => $conf );
+
+ } else {
+ my $obj = _new_stack( $class, config => $conf, stack => $STACK );
+
+ ### if it was an empty stack, this was the first object
+ ### in that case, set the global stack to match it for
+ ### subsequent new, non-private objects
+ $STACK = $obj->{STACK} unless scalar @$STACK;
+
+ return $obj;
+ }
+}
+
+sub _new_stack {
+ my $class = shift;
+ my %hash = @_;
+
+ my $tmpl = {
+ stack => { default => [] },
+ config => { default => bless( {}, 'Log::Message::Config'),
+ required => 1,
+ strict_type => 1
+ },
+ };
+
+ my $args = check( $tmpl, \%hash, $CONFIG->verbose ) or (
+ warn(loc(q[Could not create a new stack object: %1],
+ Params::Check->last_error)
+ ),
+ return
+ );
+
+
+ my %self = map { uc, $args->{$_} } keys %$args;
+
+ return bless \%self, $class;
+}
+
+sub _get_conf {
+ my $self = shift;
+ my $what = shift;
+
+ return defined $self->{CONFIG}->$what()
+ ? $self->{CONFIG}->$what()
+ : defined $CONFIG->$what()
+ ? $CONFIG->$what()
+ : undef; # should never get here
+}
+
+=head2 store
+
+This will create a new Item object and store it on the stack.
+
+Possible arguments you can give to it are:
+
+=over 4
+
+=item message
+
+This is the only argument that is required. If no other arguments
+are given, you may even leave off the C<message> key. The argument
+will then automatically be assumed to be the message.
+
+=item tag
+
+The tag to add to this message. If not provided, Log::Message will look
+in your configuration for one.
+
+=item level
+
+The level at which this message should be handled. If not provided,
+Log::Message will look in your configuration for one.
+
+=item extra
+
+This is an array ref with arguments passed to the handler for this
+message, when it is called from store();
+
+The handler will receive them as a normal list
+
+=back
+
+store() will return true upon success and undef upon failure, as well
+as issue a warning as to why it failed.
+
+=cut
+
+### should extra be stored in the item object perhaps for later retrieval?
+sub store {
+ my $self = shift;
+ my %hash = ();
+
+ my $tmpl = {
+ message => {
+ default => '',
+ strict_type => 1,
+ required => 1,
+ },
+ tag => { default => $self->_get_conf('tag') },
+ level => { default => $self->_get_conf('level'), },
+ extra => { default => [], strict_type => 1 },
+ };
+
+ ### single arg means just the message
+ ### otherwise, they are named
+ if( @_ == 1 ) {
+ $hash{message} = shift;
+ } else {
+ %hash = @_;
+ }
+
+ my $args = check( $tmpl, \%hash ) or (
+ warn( loc(q[Could not store error: %1], Params::Check->last_error) ),
+ return
+ );
+
+ my $extra = delete $args->{extra};
+ my $item = Log::Message::Item->new( %$args,
+ parent => $self,
+ id => scalar @{$self->{STACK}}
+ )
+ or ( warn( loc(q[Could not create new log item!]) ), return undef );
+
+ push @{$self->{STACK}}, $item;
+
+ { no strict 'refs';
+
+ my $sub = $args->{level};
+
+ $item->$sub( @$extra );
+ }
+
+ return 1;
+}
+
+=head2 retrieve
+
+This will retrieve all message items matching the criteria specified
+from the stack.
+
+Here are the criteria you can discriminate on:
+
+=over 4
+
+=item tag
+
+A regex to which the tag must adhere. For example C<qr/\w/>.
+
+=item level
+
+A regex to which the level must adhere.
+
+=item message
+
+A regex to which the message must adhere.
+
+=item amount
+
+Maximum amount of errors to return
+
+=item chrono
+
+Return in chronological order, or not?
+
+=item remove
+
+Remove items from the stack upon retrieval?
+
+=back
+
+In scalar context it will return the first item matching your criteria
+and in list context, it will return all of them.
+
+If an error occurs while retrieving, a warning will be issued and
+undef will be returned.
+
+=cut
+
+sub retrieve {
+ my $self = shift;
+ my %hash = ();
+
+ my $tmpl = {
+ tag => { default => qr/.*/ },
+ level => { default => qr/.*/ },
+ message => { default => qr/.*/ },
+ amount => { default => '' },
+ remove => { default => $self->_get_conf('remove') },
+ chrono => { default => $self->_get_conf('chrono') },
+ };
+
+ ### single arg means just the amount
+ ### otherwise, they are named
+ if( @_ == 1 ) {
+ $hash{amount} = shift;
+ } else {
+ %hash = @_;
+ }
+
+ my $args = check( $tmpl, \%hash ) or (
+ warn( loc(q[Could not parse input: %1], Params::Check->last_error) ),
+ return
+ );
+
+ my @list =
+ grep { $_->tag =~ /$args->{tag}/ ? 1 : 0 }
+ grep { $_->level =~ /$args->{level}/ ? 1 : 0 }
+ grep { $_->message =~ /$args->{message}/ ? 1 : 0 }
+ grep { defined }
+ $args->{chrono}
+ ? @{$self->{STACK}}
+ : reverse @{$self->{STACK}};
+
+ my $amount = $args->{amount} || scalar @list;
+
+ my @rv = map {
+ $args->{remove} ? $_->remove : $_
+ } scalar @list > $amount
+ ? splice(@list,0,$amount)
+ : @list;
+
+ return wantarray ? @rv : $rv[0];
+}
+
+=head2 first
+
+This is a shortcut for retrieving the first item(s) stored on the
+stack. It will default to only retrieving one if called with no
+arguments, and will always return results in chronological order.
+
+If you only supply one argument, it is assumed to be the amount you
+wish returned.
+
+Furthermore, it can take the same arguments as C<retrieve> can.
+
+=cut
+
+sub first {
+ my $self = shift;
+
+ my $amt = @_ == 1 ? shift : 1;
+ return $self->retrieve( amount => $amt, @_, chrono => 1 );
+}
+
+=head2 last
+
+This is a shortcut for retrieving the last item(s) stored on the
+stack. It will default to only retrieving one if called with no
+arguments, and will always return results in reverse chronological
+order.
+
+If you only supply one argument, it is assumed to be the amount you
+wish returned.
+
+Furthermore, it can take the same arguments as C<retrieve> can.
+
+=cut
+
+sub final {
+ my $self = shift;
+
+ my $amt = @_ == 1 ? shift : 1;
+ return $self->retrieve( amount => $amt, @_, chrono => 0 );
+}
+
+=head2 flush
+
+This removes all items from the stack and returns them to the caller
+
+=cut
+
+sub flush {
+ my $self = shift;
+
+ return splice @{$self->{STACK}};
+}
+
+=head1 SEE ALSO
+
+L<Log::Message::Item>, L<Log::Message::Handlers>, L<Log::Message::Config>
+
+=head1 AUTHOR
+
+This module by
+Jos Boumans E<lt>kane@cpan.orgE<gt>.
+
+=head1 Acknowledgements
+
+Thanks to Ann Barcomb for her suggestions.
+
+=head1 COPYRIGHT
+
+This module is
+copyright (c) 2002 Jos Boumans E<lt>kane@cpan.orgE<gt>.
+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:
-package Log::Message::Config;\r
-use strict;\r
-\r
-use Params::Check qw[check];\r
-use Module::Load;\r
-use FileHandle;\r
-use Locale::Maketext::Simple Style => 'gettext';\r
-\r
-BEGIN {\r
- use vars qw[$VERSION $AUTOLOAD];\r
- $VERSION = 0.01;\r
-}\r
-\r
-sub new {\r
- my $class = shift;\r
- my %hash = @_;\r
-\r
- ### find out if the user specified a config file to use\r
- ### and/or a default configuration object\r
- ### and remove them from the argument hash\r
- my %special = map { lc, delete $hash{$_} }\r
- grep /^config|default$/i, keys %hash;\r
-\r
- ### allow provided arguments to override the values from the config ###\r
- my $tmpl = {\r
- private => { default => undef, },\r
- verbose => { default => 1 },\r
- tag => { default => 'NONE', },\r
- level => { default => 'log', },\r
- remove => { default => 0 },\r
- chrono => { default => 1 },\r
- };\r
-\r
- my %lc_hash = map { lc, $hash{$_} } keys %hash;\r
-\r
- my $file_conf;\r
- if( $special{config} ) {\r
- $file_conf = _read_config_file( $special{config} )\r
- or ( warn( loc(q[Could not parse config file!]) ), return );\r
- }\r
-\r
- my $def_conf = \%{ $special{default} || {} };\r
-\r
- ### make sure to only include keys that are actually defined --\r
- ### the checker will assign even 'undef' if you have provided that\r
- ### as a value\r
- ### priorities goes as follows:\r
- ### 1: arguments passed\r
- ### 2: any config file passed\r
- ### 3: any default config passed\r
- my %to_check = map { @$_ }\r
- grep { defined $_->[1] }\r
- map { [ $_ =>\r
- defined $lc_hash{$_} ? $lc_hash{$_} :\r
- defined $file_conf->{$_} ? $file_conf->{$_} :\r
- defined $def_conf->{$_} ? $def_conf->{$_} :\r
- undef\r
- ]\r
- } keys %$tmpl;\r
-\r
- my $rv = check( $tmpl, \%to_check, 1 )\r
- or ( warn( loc(q[Could not validate arguments!]) ), return );\r
-\r
- return bless $rv, $class;\r
-}\r
-\r
-sub _read_config_file {\r
- my $file = shift or return;\r
-\r
- my $conf = {};\r
- my $FH = new FileHandle;\r
- $FH->open("$file") or (\r
- warn(loc(q[Could not open config file '%1': %2],$file,$!)),\r
- return {}\r
- );\r
-\r
- while(<$FH>) {\r
- next if /\s*#/;\r
- next unless /\S/;\r
-\r
- chomp; s/^\s*//; s/\s*$//;\r
-\r
- my ($param,$val) = split /\s*=\s*/;\r
-\r
- if( (lc $param) eq 'include' ) {\r
- load $val;\r
- next;\r
- }\r
-\r
- ### add these to the config hash ###\r
- $conf->{ lc $param } = $val;\r
- }\r
- close $FH;\r
-\r
- return $conf;\r
-}\r
-\r
-sub AUTOLOAD {\r
- $AUTOLOAD =~ s/.+:://;\r
-\r
- my $self = shift;\r
-\r
- return $self->{ lc $AUTOLOAD } if exists $self->{ lc $AUTOLOAD };\r
-\r
- die loc(q[No such accessor '%1' for class '%2'], $AUTOLOAD, ref $self);\r
-}\r
-\r
-sub DESTROY { 1 }\r
-\r
-1;\r
-\r
-__END__\r
-\r
-=pod\r
-\r
-=head1 NAME\r
-\r
-Log::Message::Config - Configuration options for Log::Message\r
-\r
-=head1 SYNOPSIS\r
-\r
- # This module is implicitly used by Log::Message to create a config\r
- # which it uses to log messages.\r
- # For the options you can pass, see the C<Log::Message new()> method.\r
-\r
- # Below is a sample of a config file you could use\r
-\r
- # comments are denoted by a single '#'\r
- # use a shared stack, or have a private instance?\r
- # if none provided, set to '0',\r
- private = 1\r
-\r
- # do not be verbose\r
- verbose = 0\r
-\r
- # default tag to set on new items\r
- # if none provided, set to 'NONE'\r
- tag = SOME TAG\r
-\r
- # default level to handle items\r
- # if none provided, set to 'log'\r
- level = carp\r
-\r
- # extra files to include\r
- # if none provided, no files are auto included\r
- include = mylib.pl\r
- include = ../my/other/lib.pl\r
-\r
- # automatically delete items\r
- # when you retrieve them from the stack?\r
- # if none provided, set to '0'\r
- remove = 1\r
-\r
- # retrieve errors in chronological order, or not?\r
- # if none provided, set to '1'\r
- chrono = 0\r
-\r
-=head1 DESCRIPTION\r
-\r
-Log::Message::Config provides a standardized config object for\r
-Log::Message objects.\r
-\r
-It can either read options as perl arguments, or as a config file.\r
-See the Log::Message manpage for more information about what arguments\r
-are valid, and see the Synopsis for an example config file you can use\r
-\r
-=head1 SEE ALSO\r
-\r
-L<Log::Message>, L<Log::Message::Item>, L<Log::Message::Handlers>\r
-\r
-=head1 AUTHOR\r
-\r
-This module by\r
-Jos Boumans E<lt>kane@cpan.orgE<gt>.\r
-\r
-=head1 Acknowledgements\r
-\r
-Thanks to Ann Barcomb for her suggestions.\r
-\r
-=head1 COPYRIGHT\r
-\r
-This module is\r
-copyright (c) 2002 Jos Boumans E<lt>kane@cpan.orgE<gt>.\r
-All rights reserved.\r
-\r
-This library is free software;\r
-you may redistribute and/or modify it under the same\r
-terms as Perl itself.\r
-\r
-=cut\r
-\r
-# Local variables:\r
-# c-indentation-style: bsd\r
-# c-basic-offset: 4\r
-# indent-tabs-mode: nil\r
-# End:\r
-# vim: expandtab shiftwidth=4:\r
+package Log::Message::Config;
+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.01;
+}
+
+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") 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<Log::Message new()> 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<Log::Message>, L<Log::Message::Item>, L<Log::Message::Handlers>
+
+=head1 AUTHOR
+
+This module by
+Jos Boumans E<lt>kane@cpan.orgE<gt>.
+
+=head1 Acknowledgements
+
+Thanks to Ann Barcomb for her suggestions.
+
+=head1 COPYRIGHT
+
+This module is
+copyright (c) 2002 Jos Boumans E<lt>kane@cpan.orgE<gt>.
+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:
-package Log::Message::Handlers;\r
-use strict;\r
-\r
-=pod\r
-\r
-=head1 NAME\r
-\r
-Log::Message::Handlers - Message handlers for Log::Message\r
-\r
-=head1 SYNOPSIS\r
-\r
- # Implicitly used by Log::Message to serve as handlers for\r
- # Log::Message::Item objects\r
-\r
- # Create your own file with a package called\r
- # Log::Message::Handlers to add to the existing ones, or to even\r
- # overwrite them\r
-\r
- $item->carp;\r
-\r
- $item->trace;\r
-\r
-\r
-=head1 DESCRIPTION\r
-\r
-Log::Message::Handlers provides handlers for Log::Message::Item objects.\r
-The handler corresponding to the level (see Log::Message::Item manpage\r
-for an explanation about levels) will be called automatically upon\r
-storing the error.\r
-\r
-Handlers may also explicitly be called on an Log::Message::Item object\r
-if one so desires (see the Log::Message manpage on how to retrieve the\r
-Item objects).\r
-\r
-=head1 Default Handlers\r
-\r
-=head2 log\r
-\r
-Will simply log the error on the stack, and do nothing special\r
-\r
-=cut\r
-\r
-sub log { 1 }\r
-\r
-=head2 carp\r
-\r
-Will carp (see the Carp manpage) with the error, and add the timestamp\r
-of when it occurred.\r
-\r
-=cut\r
-\r
-sub carp {\r
- my $self = shift;\r
- warn join " ", $self->message, $self->shortmess, 'at', $self->when, "\n";\r
-}\r
-\r
-=head2 croak\r
-\r
-Will croak (see the Carp manpage) with the error, and add the\r
-timestamp of when it occurred.\r
-\r
-=cut\r
-\r
-sub croak {\r
- my $self = shift;\r
- die join " ", $self->message, $self->shortmess, 'at', $self->when, "\n";\r
-}\r
-\r
-=head2 cluck\r
-\r
-Will cluck (see the Carp manpage) with the error, and add the\r
-timestamp of when it occurred.\r
-\r
-=cut\r
-\r
-sub cluck {\r
- my $self = shift;\r
- warn join " ", $self->message, $self->longmess, 'at', $self->when, "\n";\r
-}\r
-\r
-=head2 confess\r
-\r
-Will confess (see the Carp manpage) with the error, and add the\r
-timestamp of when it occurred\r
-\r
-=cut\r
-\r
-sub confess {\r
- my $self = shift;\r
- die join " ", $self->message, $self->longmess, 'at', $self->when, "\n";\r
-}\r
-\r
-=head2 die\r
-\r
-Will simply die with the error message of the item\r
-\r
-=cut\r
-\r
-sub die { die shift->message; }\r
-\r
-\r
-=head2 warn\r
-\r
-Will simply warn with the error message of the item\r
-\r
-=cut\r
-\r
-sub warn { warn shift->message; }\r
-\r
-\r
-=head2 trace\r
-\r
-Will provide a traceback of this error item back to the first one that\r
-occurrent, clucking with every item as it comes across it.\r
-\r
-=cut\r
-\r
-sub trace {\r
- my $self = shift;\r
-\r
- for my $item( $self->parent->retrieve( chrono => 0 ) ) {\r
- $item->cluck;\r
- }\r
-}\r
-\r
-=head1 Custom Handlers\r
-\r
-If you wish to provide your own handlers, you can simply do the\r
-following:\r
-\r
-=over 4\r
-\r
-=item *\r
-\r
-Create a file that holds a package by the name of\r
-C<Log::Message::Handlers>\r
-\r
-=item *\r
-\r
-Create subroutines with the same name as the levels you wish to\r
-handle in the Log::Message module (see the Log::Message manpage for\r
-explanation on levels)\r
-\r
-=item *\r
-\r
-Require that file in your program, or add it in your configuration\r
-(see the Log::Message::Config manpage for explanation on how to use a\r
-config file)\r
-\r
-=back\r
-\r
-And that is it, the handler will now be available to handle messages\r
-for you.\r
-\r
-The arguments a handler may receive are those specified by the\r
-C<extra> key, when storing the message.\r
-See the Log::Message manpage for details on the arguments.\r
-\r
-=head1 SEE ALSO\r
-\r
-L<Log::Message>, L<Log::Message::Item>, L<Log::Message::Config>\r
-\r
-=head1 AUTHOR\r
-\r
-This module by\r
-Jos Boumans E<lt>kane@cpan.orgE<gt>.\r
-\r
-=head1 Acknowledgements\r
-\r
-Thanks to Ann Barcomb for her suggestions.\r
-\r
-=head1 COPYRIGHT\r
-\r
-This module is\r
-copyright (c) 2002 Jos Boumans E<lt>kane@cpan.orgE<gt>.\r
-All rights reserved.\r
-\r
-This library is free software;\r
-you may redistribute and/or modify it under the same\r
-terms as Perl itself.\r
-\r
-=cut\r
-\r
-1;\r
-\r
-# Local variables:\r
-# c-indentation-style: bsd\r
-# c-basic-offset: 4\r
-# indent-tabs-mode: nil\r
-# End:\r
-# vim: expandtab shiftwidth=4:\r
+package Log::Message::Handlers;
+use strict;
+
+=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
+occurrent, 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<Log::Message::Handlers>
+
+=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<extra> key, when storing the message.
+See the Log::Message manpage for details on the arguments.
+
+=head1 SEE ALSO
+
+L<Log::Message>, L<Log::Message::Item>, L<Log::Message::Config>
+
+=head1 AUTHOR
+
+This module by
+Jos Boumans E<lt>kane@cpan.orgE<gt>.
+
+=head1 Acknowledgements
+
+Thanks to Ann Barcomb for her suggestions.
+
+=head1 COPYRIGHT
+
+This module is
+copyright (c) 2002 Jos Boumans E<lt>kane@cpan.orgE<gt>.
+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:
-package Log::Message::Item;\r
-\r
-use strict;\r
-use Params::Check qw[check];\r
-use Log::Message::Handlers;\r
-\r
-### for the messages to store ###\r
-use Carp ();\r
-\r
-BEGIN {\r
- use vars qw[$AUTOLOAD $VERSION];\r
-\r
- $VERSION = $Log::Message::VERSION;\r
-}\r
-\r
-### create a new item.\r
-### note that only an id (position on the stack), message and a reference\r
-### to its parent are required. all the other things it can fill in itself\r
-sub new {\r
- my $class = shift;\r
- my %hash = @_;\r
-\r
- my $tmpl = {\r
- when => { no_override => 1, default => scalar localtime },\r
- id => { required => 1 },\r
- message => { required => 1 },\r
- parent => { required => 1 },\r
- level => { default => '' }, # default may be conf dependant\r
- tag => { default => '' }, # default may be conf dependant\r
- longmess => { default => _clean(Carp::longmess()) },\r
- shortmess => { default => _clean(Carp::shortmess())},\r
- };\r
-\r
- my $args = check($tmpl, \%hash) or return undef;\r
-\r
- return bless $args, $class;\r
-}\r
-\r
-sub _clean { map { s/\s*//; chomp; $_ } shift; }\r
-\r
-sub remove {\r
- my $item = shift;\r
- my $self = $item->parent;\r
-\r
- return splice( @{$self->{STACK}}, $item->id, 1, undef );\r
-}\r
-\r
-sub AUTOLOAD {\r
- my $self = $_[0];\r
-\r
- $AUTOLOAD =~ s/.+:://;\r
-\r
- return $self->{$AUTOLOAD} if exists $self->{$AUTOLOAD};\r
-\r
- local $Carp::CarpLevel = $Carp::CarpLevel + 3;\r
-\r
- { no strict 'refs';\r
- return *{"Log::Message::Handlers::${AUTOLOAD}"}->(@_);\r
- }\r
-}\r
-\r
-sub DESTROY { 1 }\r
-\r
-1;\r
-\r
-__END__\r
-\r
-=pod\r
-\r
-=head1 NAME\r
-\r
-Log::Message::Item - Message objects for Log::Message\r
-\r
-=head1 SYNOPSIS\r
-\r
- # Implicitly used by Log::Message to create Log::Message::Item objects\r
-\r
- print "this is the message's id: ", $item->id;\r
-\r
- print "this is the message stored: ", $item->message;\r
-\r
- print "this is when it happened: ", $item->when;\r
-\r
- print "the message was tagged: ", $item->tag;\r
-\r
- print "this was the severity level: ", $item->level;\r
-\r
- $item->remove; # delete the item from the stack it was on\r
-\r
- # Besides these methods, you can also call the handlers on\r
- # the object specificallly.\r
- # See the Log::Message::Handlers manpage for documentation on what\r
- # handlers are available by default and how to add your own\r
-\r
-\r
-=head1 DESCRIPTION\r
-\r
-Log::Message::Item is a class that generates generic Log items.\r
-These items are stored on a Log::Message stack, so see the Log::Message\r
-manpage about details how to retrieve them.\r
-\r
-You should probably not create new items by yourself, but use the\r
-storing mechanism provided by Log::Message.\r
-\r
-However, the accessors and handlers are of interest if you want to do\r
-fine tuning of how your messages are handled.\r
-\r
-The accessors and methods are described below, the handlers are\r
-documented in the Log::Message::Handlers manpage.\r
-\r
-=head1 Methods and Accessors\r
-\r
-=head2 remove\r
-\r
-Calling remove will remove the object from the stack it was on, so it\r
-will not show up any more in subsequent fetches of messages.\r
-\r
-You can still call accessors and handlers on it however, to handle it\r
-as you will.\r
-\r
-=head2 id\r
-\r
-Returns the internal ID of the item. This may be useful for comparing\r
-since the ID is incremented each time a new item is created.\r
-Therefore, an item with ID 4 must have been logged before an item with\r
-ID 9.\r
-\r
-=head2 when\r
-\r
-Returns the timestamp of when the message was logged\r
-\r
-=head2 message\r
-\r
-The actual message that was stored\r
-\r
-=head2 level\r
-\r
-The severity type of this message, as well as the name of the handler\r
-that was called upon storing it.\r
-\r
-=head2 tag\r
-\r
-Returns the identification tag that was put on the message.\r
-\r
-=head2 shortmess\r
-\r
-Returns the equivalent of a C<Carp::shortmess> for this item.\r
-See the C<Carp> manpage for details.\r
-\r
-=head2 longmess\r
-\r
-Returns the equivalent of a C<Carp::longmess> for this item, which\r
-is essentially a stack trace.\r
-See the C<Carp> manpage for details.\r
-\r
-=head2 parent\r
-\r
-Returns a reference to the Log::Message object that stored this item.\r
-This is useful if you want to have access to the full stack in a\r
-handler.\r
-\r
-=head1 SEE ALSO\r
-\r
-L<Log::Message>, L<Log::Message::Handlers>, L<Log::Message::Config>\r
-\r
-=head1 AUTHOR\r
-\r
-This module by\r
-Jos Boumans E<lt>kane@cpan.orgE<gt>.\r
-\r
-=head1 Acknowledgements\r
-\r
-Thanks to Ann Barcomb for her suggestions.\r
-\r
-=head1 COPYRIGHT\r
-\r
-This module is\r
-copyright (c) 2002 Jos Boumans E<lt>kane@cpan.orgE<gt>.\r
-All rights reserved.\r
-\r
-This library is free software;\r
-you may redistribute and/or modify it under the same\r
-terms as Perl itself.\r
-\r
-=cut\r
-\r
-# Local variables:\r
-# c-indentation-style: bsd\r
-# c-basic-offset: 4\r
-# indent-tabs-mode: nil\r
-# End:\r
-# vim: expandtab shiftwidth=4:\r
+package Log::Message::Item;
+
+use strict;
+use Params::Check qw[check];
+use Log::Message::Handlers;
+
+### for the messages to store ###
+use Carp ();
+
+BEGIN {
+ use vars qw[$AUTOLOAD $VERSION];
+
+ $VERSION = $Log::Message::VERSION;
+}
+
+### 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 specificallly.
+ # 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<Carp::shortmess> for this item.
+See the C<Carp> manpage for details.
+
+=head2 longmess
+
+Returns the equivalent of a C<Carp::longmess> for this item, which
+is essentially a stack trace.
+See the C<Carp> 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<Log::Message>, L<Log::Message::Handlers>, L<Log::Message::Config>
+
+=head1 AUTHOR
+
+This module by
+Jos Boumans E<lt>kane@cpan.orgE<gt>.
+
+=head1 Acknowledgements
+
+Thanks to Ann Barcomb for her suggestions.
+
+=head1 COPYRIGHT
+
+This module is
+copyright (c) 2002 Jos Boumans E<lt>kane@cpan.orgE<gt>.
+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:
- # Below is a sample of a config file you could use\r
-\r
- # comments are denoted by a single '#'\r
- # use a shared stack, or have a private instance?\r
- # if none provided, set to '0',\r
- private = 1\r
-\r
- # do not be verbose\r
- verbose = 0\r
-\r
- # default tag to set on new items\r
- # if none provided, set to 'NONE'\r
- tag = SOME TAG\r
-\r
- # default level to handle items\r
- # if none provided, set to 'log'\r
- level = carp\r
-\r
- # extra files to include\r
- # if none provided, no files are auto included\r
- include = LoadMe.pl\r
-\r
- # automatically delete items\r
- # when you retrieve them from the stack?\r
- # if none provided, set to '0'\r
- remove = 1\r
-\r
- # retrieve errors in chronological order, or not?\r
- # if none provided, set to '1'\r
- chrono = 0
\ No newline at end of file
+ # 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 = LoadMe.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
-# $VERSION = 1;\r
-$VERSION = 2;\r
-\r
-1;\r
+# $VERSION = 1;
+$VERSION = 2;
+
+1;
-$VERSION = 1;\r
-\r
-1;
\ No newline at end of file
+$VERSION = 1;
+
+1;
-$VERSION = 0.01;\r
-\r
-1;
\ No newline at end of file
+$VERSION = 0.01;
+
+1;
projects / platform / upstream / perl.git / commitdiff