r27063 - in /trunk/liblog-handler-perl: ./ debian/ examples/ lib/Log/ lib/Log/Handler/ lib/Log/Handler/Output/ t/

rmayorga-guest at users.alioth.debian.org rmayorga-guest at users.alioth.debian.org
Sat Nov 22 08:40:08 UTC 2008


Author: rmayorga-guest
Date: Sat Nov 22 08:40:05 2008
New Revision: 27063

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=27063
Log:
New upstream release

Added:
    trunk/liblog-handler-perl/examples/server.log
      - copied unchanged from r27062, branches/upstream/liblog-handler-perl/current/examples/server.log
    trunk/liblog-handler-perl/t/090-test-undef.t
      - copied unchanged from r27062, branches/upstream/liblog-handler-perl/current/t/090-test-undef.t
Modified:
    trunk/liblog-handler-perl/ChangeLog
    trunk/liblog-handler-perl/MANIFEST
    trunk/liblog-handler-perl/META.yml
    trunk/liblog-handler-perl/Makefile.PL
    trunk/liblog-handler-perl/README
    trunk/liblog-handler-perl/debian/changelog
    trunk/liblog-handler-perl/examples/benchmark.pl
    trunk/liblog-handler-perl/examples/client.pl
    trunk/liblog-handler-perl/examples/server.pl
    trunk/liblog-handler-perl/lib/Log/Handler.pm
    trunk/liblog-handler-perl/lib/Log/Handler/Output.pm
    trunk/liblog-handler-perl/lib/Log/Handler/Output/DBI.pm
    trunk/liblog-handler-perl/lib/Log/Handler/Output/Email.pm
    trunk/liblog-handler-perl/lib/Log/Handler/Output/Socket.pm
    trunk/liblog-handler-perl/lib/Log/Handler/Pattern.pm

Modified: trunk/liblog-handler-perl/ChangeLog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-handler-perl/ChangeLog?rev=27063&op=diff
==============================================================================
--- trunk/liblog-handler-perl/ChangeLog (original)
+++ trunk/liblog-handler-perl/ChangeLog Sat Nov 22 08:40:05 2008
@@ -1,3 +1,10 @@
+0.49    Released at 2008-11-16.
+        - Added patterns %U and %G (user, group).
+        - Fixed a bug in Socket.pm. If the server gone then
+           Log::Handler croaks even if die_on_errors is disabled.
+        - Fixed a bug in Output.pm. $log->error(0) logs nothing.
+          $log->error('foo', undef, 'bar') caused a warning.
+
 0.48    Released at 2008-10-28.
         - Fixed a bug in Email.pm - no error message if a email
           couldn't be send.

Modified: trunk/liblog-handler-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-handler-perl/MANIFEST?rev=27063&op=diff
==============================================================================
--- trunk/liblog-handler-perl/MANIFEST (original)
+++ trunk/liblog-handler-perl/MANIFEST Sat Nov 22 08:40:05 2008
@@ -9,6 +9,7 @@
 examples/example.yaml
 examples/layout.pl
 examples/runtime.pl
+examples/server.log
 examples/server.pl
 INSTALL
 lib/Log/Handler.pm
@@ -49,5 +50,6 @@
 t/040-output-email.t
 t/050-output-dbi.t
 t/060-output-socket.t
+t/090-test-undef.t
 t/100-config.t
 t/200-backward-compatibility.t

Modified: trunk/liblog-handler-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-handler-perl/META.yml?rev=27063&op=diff
==============================================================================
--- trunk/liblog-handler-perl/META.yml (original)
+++ trunk/liblog-handler-perl/META.yml Sat Nov 22 08:40:05 2008
@@ -1,6 +1,6 @@
 ---
 name: Log-Handler
-version: 0.48
+version: 0.49
 author:
   - Jonny Schulz
 abstract: Log messages to several outputs.
@@ -31,7 +31,7 @@
 provides:
   Log::Handler:
     file: lib/Log/Handler.pm
-    version: 0.48
+    version: 0.49
   Log::Handler::Config:
     file: lib/Log/Handler/Config.pm
     version: 0.04
@@ -40,7 +40,7 @@
     version: 0.05
   Log::Handler::Output:
     file: lib/Log/Handler/Output.pm
-    version: 0.04
+    version: 0.05
   Log::Handler::Output::DBI:
     file: lib/Log/Handler/Output/DBI.pm
     version: 0.03
@@ -58,7 +58,7 @@
     version: 0.02
   Log::Handler::Output::Socket:
     file: lib/Log/Handler/Output/Socket.pm
-    version: 0.04
+    version: 0.05
   Log::Handler::Pattern:
     file: lib/Log/Handler/Pattern.pm
     version: 0.03
@@ -71,7 +71,7 @@
   Log::Handler::Plugin::YAML:
     file: lib/Log/Handler/Plugin/YAML.pm
     version: 0.03
-generated_by: Module::Build version 0.2808
+generated_by: Module::Build version 0.3
 meta-spec:
   url: http://module-build.sourceforge.net/META-spec-v1.2.html
   version: 1.2

Modified: trunk/liblog-handler-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-handler-perl/Makefile.PL?rev=27063&op=diff
==============================================================================
--- trunk/liblog-handler-perl/Makefile.PL (original)
+++ trunk/liblog-handler-perl/Makefile.PL Sat Nov 22 08:40:05 2008
@@ -1,4 +1,5 @@
-# Note: this file was auto-generated by Module::Build::Compat version 0.03
+# Note: this file was auto-generated by Module::Build::Compat version 0.30
+require 5.006_001;
 use ExtUtils::MakeMaker;
 WriteMakefile
 (

Modified: trunk/liblog-handler-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-handler-perl/README?rev=27063&op=diff
==============================================================================
--- trunk/liblog-handler-perl/README (original)
+++ trunk/liblog-handler-perl/README Sat Nov 22 08:40:05 2008
@@ -132,6 +132,8 @@
             %D   Date (option dateformat)
             %P   PID
             %H   Hostname
+            %U   User name
+            %G   Group name
             %N   Newline
             %S   Program name
             %C   Caller - filename and line number
@@ -140,7 +142,7 @@
             %l   Caller - line number
             %s   Caller - subroutine name
             %r   Runtime in seconds since program start
-            %t   Time measurement - replaced with the time since the last call of $level
+            %t   Time measurement - replaced with the time since the last call of $log->$level
             %m   Message
             %%   Procent
 
@@ -174,8 +176,8 @@
     message_pattern
         This option is just useful if you want to forward messages to output
         modules that needs the parts of a message as a hash reference - as
-        example Log::Handler::Output::Forward, Log::Handler::Output::DBI or
-        Log::Handler::Output::Screen.
+        example Log::Handler::Output::Forward, Log::Handler::Output::DBI,
+        Log::Handler::Output::Email or Log::Handler::Output::Screen.
 
         The option expects a list of placeholders:
 
@@ -184,7 +186,7 @@
 
             # or as a string
             message_pattern => '%T %L %H %m'
- 
+
         The patterns will be replaced with real names as hash keys.
 
             %L   level
@@ -192,6 +194,8 @@
             %D   date
             %P   pid
             %H   hostname
+            %U   user
+            %G   group
             %N   newline
             %r   runtime
             %C   caller
@@ -237,16 +241,16 @@
 
         We add a output with no priority
 
-            $log->add(file => { filename => 'file.log' });
+            $log->add(file => { filename => 'file1.log' });
 
         This output gets the priority of 10. Now we add another output
 
-            $log->add(file => { filename => 'file.log' });
+            $log->add(file => { filename => 'file2.log' });
 
         This output gets the priority of 11... and so on.
 
         Messages would be logged at first to the output with the priority of
-        10 and to the output with the priority of 11. Now you can add
+        10 and then to the output with the priority of 11. Now you can add
         another output and set the priority to 1.
 
             $log->add(screen => { dump => 1, priority => 1 });
@@ -405,7 +409,7 @@
 
         Output:
 
-            Apr 26 12:54:11 [WARNING] 
+            Apr 26 12:54:11 [WARNING]
                CALL(4): package(main) filename(./trace.pl) line(15) subroutine(main::test2) hasargs(0)
                CALL(3): package(main) filename(./trace.pl) line(13) subroutine(main::test1) hasargs(0)
                CALL(2): package(main) filename(./trace.pl) line(12) subroutine(Log::Handler::__ANON__) hasargs(1)
@@ -419,7 +423,7 @@
 
         Output:
 
-           Apr 26 12:52:17 [DEBUG] 
+           Apr 26 12:52:17 [DEBUG]
               CALL(4):
                  package     main
                  filename    ./trace.pl

Modified: trunk/liblog-handler-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-handler-perl/debian/changelog?rev=27063&op=diff
==============================================================================
--- trunk/liblog-handler-perl/debian/changelog (original)
+++ trunk/liblog-handler-perl/debian/changelog Sat Nov 22 08:40:05 2008
@@ -1,9 +1,13 @@
-liblog-handler-perl (0.48-2) UNRELEASED; urgency=low
+liblog-handler-perl (0.49-1) unstable; urgency=low
 
+  [ gregor herrmann ]
   * debian/control: Changed: Switched Vcs-Browser field to ViewSVN
     (source stanza).
 
- -- gregor herrmann <gregoa at debian.org>  Sun, 16 Nov 2008 20:44:21 +0100
+  [ Rene Mayorga ]
+  * New upstream release
+
+ -- Rene Mayorga <rmayorga at debian.org.sv>  Sat, 22 Nov 2008 02:31:47 -0600
 
 liblog-handler-perl (0.48-1) unstable; urgency=low
 

Modified: trunk/liblog-handler-perl/examples/benchmark.pl
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-handler-perl/examples/benchmark.pl?rev=27063&op=diff
==============================================================================
--- trunk/liblog-handler-perl/examples/benchmark.pl (original)
+++ trunk/liblog-handler-perl/examples/benchmark.pl Sat Nov 22 08:40:05 2008
@@ -31,7 +31,7 @@
 
 my $BUFFER;
 sub buffer {
-    $BUFFER .= shift->{message};
+    $BUFFER .= $_[0]->{message};
 }
 
 my $log = Log::Handler->new();
@@ -69,18 +69,6 @@
 
 $log->add(
     forward => {
-        alias      => 'message pattern',
-        maxlevel   => 'error',
-        minlevel   => 'error',
-        newline    => 1,
-        forward_to => \&buffer,
-        message_layout  => '%m',
-        message_pattern => [qw/%T %L %P/],
-    }
-);
-
-$log->add(
-    forward => {
         alias      => 'filter caller',
         maxlevel   => 'emerg',
         minlevel   => 'emerg',
@@ -102,21 +90,21 @@
 );
 
 my $count   = 100_000;
-my $message = 'foo bar baz';
+my $message = 'foobarbaz';
 
-run("simple pattern output took",    $count, sub { $log->notice($message)  } );
-run("default pattern output took",   $count, sub { $log->warning($message) } );
-run("complex pattern output took",   $count, sub { $log->info($message)    } );
-run("message pattern output took",   $count, sub { $log->error($message)   } );
-run("suppressed output took",        $count, sub { $log->debug($message)   } );
-run("filtered caller output took",   $count, \&Foo::Bar::emerg               );
-run("suppressed caller output took", $count, \&Foo::Baz::emerg               );
-run("filterd messages output took",  $count, sub { $log->alert($message)   } );
+print "Iterations: $count\n";
+run("simple pattern output took",    sub { $log->notice($message)  for 1..$count } );
+run("default pattern output took",   sub { $log->warning($message) for 1..$count } );
+run("complex pattern output took",   sub { $log->info($message)    for 1..$count } );
+run("suppressed output took",        sub { $log->debug($message)   for 1..$count } );
+run("filtered caller output took",   sub { &Foo::Bar::emerg        for 1..$count } );
+run("suppressed caller output took", sub { &Foo::Baz::emerg        for 1..$count } );
+run("filterd messages output took",  sub { $log->alert($message)   for 1..$count } );
 
 sub run {
-    my ($desc, $count, $bench) = @_;
-    my $time = timeit($count, $bench);
-    print sprintf('%-35s', $desc), ' : ', timestr($time), "\n";
+    my ($desc, $bench) = @_;
+    my $time = timeit(1, $bench);
+    printf "%-30s : %10s/s\n", $desc, sprintf('%.2f', $count/$time->[1]);
     undef $BUFFER;
 }
 

Modified: trunk/liblog-handler-perl/examples/client.pl
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-handler-perl/examples/client.pl?rev=27063&op=diff
==============================================================================
--- trunk/liblog-handler-perl/examples/client.pl (original)
+++ trunk/liblog-handler-perl/examples/client.pl Sat Nov 22 08:40:05 2008
@@ -36,12 +36,17 @@
         peerport => 44444,
         newline  => 1,
         maxlevel => 'info',
-        die_on_errors => 0,
+        die_on_errors  => 0,
+        message_layout => '%T [%L] %U %H %S[%P] %m',
     }
 );
+
+my $err = Log::Handler->new();
+$err->add(screen => { newline => 1 });
 
 while ( 1 ) {
     $log->info('test')
         or warn "unable to send message: ", $log->errstr;
     sleep 1;
 }
+

Modified: trunk/liblog-handler-perl/examples/server.pl
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-handler-perl/examples/server.pl?rev=27063&op=diff
==============================================================================
--- trunk/liblog-handler-perl/examples/server.pl (original)
+++ trunk/liblog-handler-perl/examples/server.pl Sat Nov 22 08:40:05 2008
@@ -46,9 +46,9 @@
     $file->log(message => "waiting for next connection\n");
 
     while (my $request = $sock->accept) {
-        my $ipaddr = sprintf('%-15s', $request->peerhost);
         while (my $message = <$request>) {
-            $file->log(message => "$ipaddr - $message");
+            $file->log(message => $message);
         }
     }
 }
+

Modified: trunk/liblog-handler-perl/lib/Log/Handler.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-handler-perl/lib/Log/Handler.pm?rev=27063&op=diff
==============================================================================
--- trunk/liblog-handler-perl/lib/Log/Handler.pm (original)
+++ trunk/liblog-handler-perl/lib/Log/Handler.pm Sat Nov 22 08:40:05 2008
@@ -140,6 +140,8 @@
     %D   Date (option dateformat)
     %P   PID
     %H   Hostname
+    %U   User name
+    %G   Group name
     %N   Newline
     %S   Program name
     %C   Caller - filename and line number
@@ -148,7 +150,7 @@
     %l   Caller - line number
     %s   Caller - subroutine name
     %r   Runtime in seconds since program start
-    %t   Time measurement - replaced with the time since the last call of $level
+    %t   Time measurement - replaced with the time since the last call of $log->$level
     %m   Message
     %%   Procent
 
@@ -182,8 +184,8 @@
 
 This option is just useful if you want to forward messages to output
 modules that needs the parts of a message as a hash reference - as
-example L<Log::Handler::Output::Forward>, L<Log::Handler::Output::DBI>
-or L<Log::Handler::Output::Screen>.
+example L<Log::Handler::Output::Forward>, L<Log::Handler::Output::DBI>,
+L<Log::Handler::Output::Email> or L<Log::Handler::Output::Screen>.
 
 The option expects a list of placeholders:
 
@@ -192,7 +194,7 @@
 
     # or as a string
     message_pattern => '%T %L %H %m'
- 
+
 The patterns will be replaced with real names as hash keys.
 
     %L   level
@@ -200,6 +202,8 @@
     %D   date
     %P   pid
     %H   hostname
+    %U   user
+    %G   group
     %N   newline
     %r   runtime
     %C   caller
@@ -245,16 +249,16 @@
 
 We add a output with no priority
 
-    $log->add(file => { filename => 'file.log' });
+    $log->add(file => { filename => 'file1.log' });
 
 This output gets the priority of 10. Now we add another output
 
-    $log->add(file => { filename => 'file.log' });
+    $log->add(file => { filename => 'file2.log' });
 
 This output gets the priority of 11... and so on.
 
-Messages would be logged at first to the output with the priority of 10 and to
-the output with the priority of 11. Now you can add another output and set the
+Messages would be logged at first to the output with the priority of 10 and then
+to the output with the priority of 11. Now you can add another output and set the
 priority to 1.
 
     $log->add(screen => { dump => 1, priority => 1 });
@@ -414,7 +418,7 @@
 
 Output:
 
-    Apr 26 12:54:11 [WARNING] 
+    Apr 26 12:54:11 [WARNING]
        CALL(4): package(main) filename(./trace.pl) line(15) subroutine(main::test2) hasargs(0)
        CALL(3): package(main) filename(./trace.pl) line(13) subroutine(main::test1) hasargs(0)
        CALL(2): package(main) filename(./trace.pl) line(12) subroutine(Log::Handler::__ANON__) hasargs(1)
@@ -427,7 +431,7 @@
 
 Output:
 
-   Apr 26 12:52:17 [DEBUG] 
+   Apr 26 12:52:17 [DEBUG]
       CALL(4):
          package     main
          filename    ./trace.pl
@@ -625,7 +629,7 @@
 
 =head2 output()
 
-Call C<output($alias)> to get the output object that you added with 
+Call C<output($alias)> to get the output object that you added with
 the option C<alias>.
 
 It's possible to access a output directly:
@@ -849,7 +853,7 @@
 use Log::Handler::Pattern;
 use base qw(Log::Handler::Levels);
 
-our $VERSION = '0.48';
+our $VERSION = '0.49';
 our $ERRSTR  = '';
 
 # $TRACE and $CALLER_LEVEL are both used as global
@@ -858,8 +862,7 @@
 #
 # $TRACE is used to turn on/off tracing.
 #
-# $CALLER_LEVEL is used to determine the current
-# caller level
+# $CALLER_LEVEL is used to determine the current caller level
 our $CALLER_LEVEL = 0;
 our $TRACE        = 0;
 
@@ -881,19 +884,19 @@
 )\z/x;
 
 # to convert minlevel and maxlevel to a number
-our %LEVEL_BY_STRING = ( 
-    DEBUG     =>  7,  
-    INFO      =>  6,  
-    NOTICE    =>  5,  
-    WARNING   =>  4,  
-    WARN      =>  4,  
-    ERROR     =>  3,  
-    ERR       =>  3,  
-    CRITICAL  =>  2,  
-    CRIT      =>  2,  
-    ALERT     =>  1,  
-    EMERGENCY =>  0,  
-    EMERG     =>  0,  
+our %LEVEL_BY_STRING = (
+    DEBUG     =>  7,
+    INFO      =>  6,
+    NOTICE    =>  5,
+    WARNING   =>  4,
+    WARN      =>  4,
+    ERROR     =>  3,
+    ERR       =>  3,
+    CRITICAL  =>  2,
+    CRIT      =>  2,
+    ALERT     =>  1,
+    EMERGENCY =>  0,
+    EMERG     =>  0,
     FATAL     =>  0,
 );
 
@@ -1307,7 +1310,7 @@
         #
         #   sub {
         #       my ($w, $m) = @_; # %wanted pattern, %message
-        #       $m->{'message'} = 
+        #       $m->{'message'} =
         #           $w->{'time'}
         #           . ' ['
         #           . $w->{'level'}

Modified: trunk/liblog-handler-perl/lib/Log/Handler/Output.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-handler-perl/lib/Log/Handler/Output.pm?rev=27063&op=diff
==============================================================================
--- trunk/liblog-handler-perl/lib/Log/Handler/Output.pm (original)
+++ trunk/liblog-handler-perl/lib/Log/Handler/Output.pm Sat Nov 22 08:40:05 2008
@@ -43,7 +43,7 @@
 use UNIVERSAL;
 use Devel::Backtrace;
 
-our $VERSION = '0.04';
+our $VERSION = '0.05';
 our $ERRSTR  = '';
 
 sub new {
@@ -56,7 +56,7 @@
 sub log {
     my $self    = shift;
     my $level   = shift;
-    my $wanted  = {message=>join(' ', @_)||''};
+    my $wanted  = {message=>join(' ', grep defined, @_)};
     my $output  = $self->{output};
     my $pattern = $self->{pattern};
     my $message = { };

Modified: trunk/liblog-handler-perl/lib/Log/Handler/Output/DBI.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-handler-perl/lib/Log/Handler/Output/DBI.pm?rev=27063&op=diff
==============================================================================
--- trunk/liblog-handler-perl/lib/Log/Handler/Output/DBI.pm (original)
+++ trunk/liblog-handler-perl/lib/Log/Handler/Output/DBI.pm Sat Nov 22 08:40:05 2008
@@ -125,7 +125,7 @@
         values => [ qw/%level %time %date %pid %hostname %progname %message/ ],
 
 The placeholders are identical with the pattern names that you have to pass
-with the option C<message_pattern>.
+with the option C<message_pattern> from L<Log::Handler>.
 
     %L   level
     %T   time

Modified: trunk/liblog-handler-perl/lib/Log/Handler/Output/Email.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-handler-perl/lib/Log/Handler/Output/Email.pm?rev=27063&op=diff
==============================================================================
--- trunk/liblog-handler-perl/lib/Log/Handler/Output/Email.pm (original)
+++ trunk/liblog-handler-perl/lib/Log/Handler/Output/Email.pm Sat Nov 22 08:40:05 2008
@@ -105,8 +105,21 @@
 
     $email->log(
         message => 'this message will be mailed',
-        subject => 'non default subject',
+        subject => 'your subject',
+        level   => 'INFO',
     );
+
+If you pass C<"level => 'INFO'"> then the level is placed into the subject:
+
+    INFO: your subject
+
+As example you can use message_pattern from L<Log::Handler> to pass the level:
+
+    message_pattern => '%L'
+
+then the level is placed into the subject.
+
+If you use a buffer higher than 0 then the level from the last message is used.
 
 =head2 flush()
 

Modified: trunk/liblog-handler-perl/lib/Log/Handler/Output/Socket.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-handler-perl/lib/Log/Handler/Output/Socket.pm?rev=27063&op=diff
==============================================================================
--- trunk/liblog-handler-perl/lib/Log/Handler/Output/Socket.pm (original)
+++ trunk/liblog-handler-perl/lib/Log/Handler/Output/Socket.pm Sat Nov 22 08:40:05 2008
@@ -43,7 +43,7 @@
 
 =item B<timeout>
 
-The timeout to send message. The default is 1.
+The timeout to send message. The default is 5 seconds.
 
 =item B<persistent> and B<reconnect>
 
@@ -148,7 +148,7 @@
 use IO::Socket::INET;
 use Data::Dumper;
 
-our $VERSION = '0.04';
+our $VERSION = '0.05';
 our $ERRSTR  = '';
 
 sub new {
@@ -178,14 +178,18 @@
             or return undef;
     }
 
-    local $SIG{PIPE} = 'IGNORE';
-    if ( ! $socket->send($message->{message}) ) {
+    # If the peer is done then send() croaks
+    eval { $socket->send($message->{message}) };
+
+    if ($@) {
         if ($self->{persistent} && $self->{reconnect}) {
             $self->connect or return undef;
-            $socket->send($message->{message})
-                or return $self->_raise_error("Lost connection! Reconnect failed: $!");
+            eval { $socket->send($message->{message}) };
+            if ($@) {
+                return $self->_raise_error("something curious happends: $@");
+            }
         } else {
-            return $self->_raise_error("unable to send message: $!");
+            return $self->_raise_error("unable to send message: $@");
         }
     }
 

Modified: trunk/liblog-handler-perl/lib/Log/Handler/Pattern.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liblog-handler-perl/lib/Log/Handler/Pattern.pm?rev=27063&op=diff
==============================================================================
--- trunk/liblog-handler-perl/lib/Log/Handler/Pattern.pm (original)
+++ trunk/liblog-handler-perl/lib/Log/Handler/Pattern.pm Sat Nov 22 08:40:05 2008
@@ -61,6 +61,10 @@
                     code => "\n" },
         '%S'  => {  name => 'progname',
                     code => $progname },
+        '%U'  => {  name => 'user',
+                    code => \&_get_user },
+        '%G'  => {  name => 'group',
+                    code => \&_get_group },
         '%C'  => {  name => 'caller',
                     code => \&_get_caller },
         '%r'  => {  name => 'runtime',
@@ -96,6 +100,8 @@
 sub _get_c_line  { (caller(2+$Log::Handler::CALLER_LEVEL))[2] }
 sub _get_c_sub   { (caller(2+$Log::Handler::CALLER_LEVEL))[3] }
 sub _get_runtime { return sprintf('%.6f', Time::HiRes::gettimeofday - START_TIME) }
+sub _get_user    { getpwuid($<) || $<     }
+sub _get_group   { getgrgid($(+0) || $(+0 }
 
 sub _get_hires {
     my $self = shift;




More information about the Pkg-perl-cvs-commits mailing list