Re: [log4perl-devel] Patch for suggested new behaviour

[Kevin G. <ke...@go...>]

+        # Check if the appender's got its own input_filter
+    unless($appender->can("input_filter")) {
+        # No ? Then just slip it our own
+        eval "*${appenderclass}::input_filter = *input_filter";
+    }

<Edvard Munch Scream>Noooooooo!</Edvard Munch Scream>  Are you 
guaranteeing that no Log::Dispatch::* class will ever have a subroutine 
called "input_filter"? (Or "can()" for that matter?)  Don't be mucking 
about in namespaces of modules you ain't even met yet ;-)

I think can() is more work than we need to do, it has to traverse the 
class heirarchy all the way back up to UNIVERSAL, I've seen it fail in 
wierd cases where it looks like it's actually running the method it's 
supposed to be checking.  And why call a method *all* the time when 
*most* of the time we're just doing a join?

How about something like this instead.  Munging the message should be a 
function of the Layout class, shouldn't it?  Why not pass the message 
arrayref straight through to {layout}->render(...), and let it do a
	join unless $dontCollapse
or something?

If need be, I might have time tonight to generate a patch for discussion 
purposes.

I realize that I'm focusing on the specific problem of  where a list 
gets collapsed instead of the more generalized question of these input 
filters (I don't know POE), but this filter parameter doesn't sound very 
log4j-ish, wouldn't the log4j idiom be to subclass the Layout if you 
want different behavior?


msc...@ao... wrote:
 > Hey Kevin,
 >
 > here's a patch implementing what I've suggested earlier -- I haven't
 > tested the new functionality extensivly, but the patch passes the
 > existing test suite.
 >
 > There's a couple of open issues :
 >
 > [1] There's a "join" command in generate_noop_coderef() which
 > concatenates the message chunks together to somehow log the message
 > later if a config_and_watch event occurs. Think that won't work even
 > with the old DBI appender -- right ;) ?
 >
 > [2] In case a log event passes several message chunks on to an
 > appender, could there be appenders which want to render each chunk
 > individually? Just a thought, maybe not.
 >
 > The code in the patch is not well commented, hope it's somehow
 > decipherable :) Basically what I did is slip in a default
 > input_filter method into the filter's package if it doesn't define
 > one. The input_filter method will take a array ref of parameters
 > (always) and return either a single string (in case the appender
 > wants to collapse) or an array ref with the new elements. Arguments
 > to debug(), info(), etc. are now plain arguments, hashes indicate
 > parameter with special filtering needs. Code refs is also evaluated.
 >
 > Please let me know if that all makes sense ... :)
 >
 >
 >
 > ------------------------------------------------------------------------
 >
 >
 > Index: lib/Log/Log4perl/Appender.pm
 > ===================================================================
 > RCS file:
 > /cvsroot/log4perl/Log-Log4perl/lib/Log/Log4perl/Appender.pm,v
 > retrieving revision 1.18 diff -a -u -r1.18 Appender.pm ---
 > lib/Log/Log4perl/Appender.pm	26 Dec 2002 23:57:35 -0000	1.18 +++
 > lib/Log/Log4perl/Appender.pm	14 Jan 2003 09:25:58 -0000 @@ -37,8
 > +37,8 @@ no strict 'refs'; # see 'perldoc -f require' for why two
 > evals eval "require $appenderclass" -             unless
 > ${$appenderclass.'::IS_LOADED'};  #for unit tests, see 004Config -
 > ; +             unless ${$appenderclass.'::IS_LOADED'};  #for unit
 > tests, +                                                      #see
 > 004Config die $@ if $@;
 >
 > # Eval erroneously succeeds on unknown appender classes if @@ -68,6
 > +68,12 @@ map { $_ => $params{$_} } keys %params, );
 >
 > +        # Check if the appender's got its own input_filter +
 > unless($appender->can("input_filter")) { +        # No ? Then just
 > slip it our own +        eval "*${appenderclass}::input_filter =
 > *input_filter"; +    } + my $self = { appender => $appender, name
 > => $params{name}, @@ -116,13 +122,34 @@ #doing the rendering in here
 > 'cause this is #where we keep the layout
 >
 > -    $p->{message} = $self->{layout}->render($p->{message}, -
 > $category, -                                            $level, -
 > 3 + $Log::Log4perl::caller_depth, -
 > ); +    #use Data::Dumper; +    #print "Message1 = ",
 > Data::Dumper::Dumper($p->{message}), "\n"; + +        # Call the
 > appender's input filter to modify our arguments +        # (either
 > collapse, pass them as an array, etc.) +    $p->{message} =
 > $self->{appender}->input_filter($p->{message}); + +    if(ref
 > $p->{message} eq "ARRAY") { +            # Render each element
 > individually +# For now, disable that +#        for(0 ..
 > $#{$p->{message}}) { +#            $p->{message}->[$_] = +#
 > $self->{layout}->render($p->{message}->[$_], +#
 > $category, +#                                        $level, +#
 > 3 + $Log::Log4perl::caller_depth, +#
 > ); +#        } +    } else { +            $p->{message} = +
 > $self->{layout}->render($p->{message}, +
 > $category, +                                        $level, +
 > 3 + $Log::Log4perl::caller_depth, +
 > ); +    }
 >
 > -    $self->{appender}->log(%$p, +    $self->{appender}->log(%$p,
 > #these are used by our Appender::DBI log4p_category => $category,
 > log4p_level  => $level,); @@ -156,10 +183,27 @@ }elsif (!
 > $self->{layout}) { $self->{layout} =
 > Log::Log4perl::Layout::SimpleLayout ->new($self->{name}); - }
 >
 > return $self->{layout}; +} +
 > +########################################### +sub input_filter {
 > +########################################### +    # Expects a
 > (single!) array ref as arg +    # +    # Default input filter. Active
 > if the appender +    # (subclass) doesn't define one of its own. +
 > # +    # The default input filter just takes the +    # array passed
 > in as a ref, concatenates all +    # elements and returns a single
 > string as result + +#use Data::Dumper; +#print "input_filter(a) got
 > ", Data::Dumper::Dumper(\@_), "\n"; + +    return join('', @{$_[1]});
 >  }
 >
 > ################################################## Index:
 > lib/Log/Log4perl/Logger.pm
 > ===================================================================
 > RCS file: /cvsroot/log4perl/Log-Log4perl/lib/Log/Log4perl/Logger.pm,v
 >  retrieving revision 1.42 diff -a -u -r1.42 Logger.pm ---
 > lib/Log/Log4perl/Logger.pm	31 Dec 2002 00:57:05 -0000	1.42 +++
 > lib/Log/Log4perl/Logger.pm	14 Jan 2003 09:26:00 -0000 @@ -198,20
 > +198,30 @@ \$coderef = sub { my (\$logger)  = shift; my (\$level)   =
 > pop; -      my \$message; my \$appenders_fired = 0;
 >
 > -      \$message = ref \$_[0] eq 'ARRAY' ? \$_[0] : -
 > join('', map { ref \$_ eq "CODE" ? \$_->() : defined \$_ ? \$_ : '' }
 > \@_); - -      print("coderef: \$logger->{category}\n") if DEBUG; +
 > # Evaluate all parameters that need to evaluated. Two kinds: +      #
 >  +      # (1) It's a hash like { filter => "filtername", +      #
 > value  => "value" } +      #     => filtername(value) +      # +
 > # (2) It's a code ref +      #     => coderef() +      # + +      my
 > \$message   = [map { ref \$_ eq "HASH" ? +
 > \$_->{filter}->(\$_->{value}) : +                              ref
 > \$_ eq "CODE" ? +                                  \$_->() : \$_ +
 > } \@_];
 >
 > $watch_delay_code;  #note interpolation here
 >
 > foreach my \$a (\@\$appenders) {   #note the closure here my
 > (\$appender_name, \$appender) = \@\$a;
 >
 > -          print("  Sending message '\$message' (\$level) " . +
 > print("  Sending message '<\$message>' (\$level) " . "to
 > \$appender_name\n") if DEBUG;
 >
 > \$appender->log( Index: lib/Log/Log4perl/Appender/DBI.pm
 > ===================================================================
 > RCS file:
 > /cvsroot/log4perl/Log-Log4perl/lib/Log/Log4perl/Appender/DBI.pm,v
 > retrieving revision 1.8 diff -a -u -r1.8 DBI.pm ---
 > lib/Log/Log4perl/Appender/DBI.pm	8 Jan 2003 17:21:58 -0000	1.8 +++
 > lib/Log/Log4perl/Appender/DBI.pm	14 Jan 2003 09:26:01 -0000 @@ -241,6
 > +241,16 @@ } }
 >
 > +################################################## +sub input_filter
 > { +################################################## +    # No
 > changes, just return the array ref passed in as the 1st +    #
 > argument back to the caller. We could have modified it's +    #
 > content if we wanted (e.g. collapse some elements) +    #use
 > Data::Dumper; +    #print "input_filter in: ",
 > Data::Dumper::Dumper($_[1]), "\n"; +    return $_[1]; +}
 >
 > 1;
 >
 > Index: lib/Log/Log4perl/Layout/PatternLayout.pm
 > ===================================================================
 > RCS file:
 > /cvsroot/log4perl/Log-Log4perl/lib/Log/Log4perl/Layout/PatternLayout.pm,v
 >  retrieving revision 1.33 diff -a -u -r1.33 PatternLayout.pm ---
 > lib/Log/Log4perl/Layout/PatternLayout.pm	8 Jan 2003 07:00:51 -0000
 > 1.33 +++ lib/Log/Log4perl/Layout/PatternLayout.pm	14 Jan 2003
 > 09:26:03 -0000 @@ -159,14 +159,6 @@
 > ################################################## my($self,
 > $message, $category, $priority, $caller_level) = @_;
 >
 > -    if (ref $message eq 'ARRAY' ) { -        if
 > ($self->{dontCollapseArrayRefs}) { -            return $message; -
 > }else{ -            $message =
 > join($Log::Log4perl::JOIN_ARRAYREFS_CHAR, @$message); -        } -
 > } - $caller_level = 0 unless defined  $caller_level;
 >
 > my %info    = (); Index: lib/Log/Log4perl/Layout/SimpleLayout.pm
 > ===================================================================
 > RCS file:
 > /cvsroot/log4perl/Log-Log4perl/lib/Log/Log4perl/Layout/SimpleLayout.pm,v
 >  retrieving revision 1.5 diff -a -u -r1.5 SimpleLayout.pm ---
 > lib/Log/Log4perl/Layout/SimpleLayout.pm	27 Dec 2002 00:02:29 -0000
 > 1.5 +++ lib/Log/Log4perl/Layout/SimpleLayout.pm	14 Jan 2003 09:26:03
 > -0000 @@ -35,14 +35,6 @@
 > ################################################## my($self,
 > $message, $category, $priority, $caller_level) = @_;
 >
 > -    if (ref $message eq 'ARRAY' ) { -        if
 > ($self->{dontCollapseArrayRefs}) { -            return $message; -
 > }else{ -            $message =
 > join($Log::Log4perl::JOIN_ARRAYREFS_CHAR, @$message); -        } -
 > } - return "$priority - $message\n"; }
 >
 > Index: t/034DBI.t
 > ===================================================================
 > RCS file: /cvsroot/log4perl/Log-Log4perl/t/034DBI.t,v retrieving
 > revision 1.3 diff -a -u -r1.3 034DBI.t --- t/034DBI.t	1 Jan 2003
 > 05:43:39 -0000	1.3 +++ t/034DBI.t	14 Jan 2003 09:26:03 -0000 @@ -95,9
 > +95,9 @@ my $logger = Log::Log4perl->get_logger("groceries.beer");
 >
 >
 > -$logger->fatal(['fatal message',1234,'foo','bar']);
 > -$logger->warn(['warning message',3456,'foo','bar']);
 > -$logger->debug(['debug message',99,'foo','bar']);
 > +$logger->fatal('fatal message',1234,'foo','bar');
 > +$logger->warn('warning message',3456,'foo','bar');
 > +$logger->debug('debug message',99,'foo','bar');
 >
 > my $sth = $dbh->prepare('select * from log4perltest'); $sth->execute;
 >  Index: t/035JDBCAppender.t
 > ===================================================================
 > RCS file: /cvsroot/log4perl/Log-Log4perl/t/035JDBCAppender.t,v
 > retrieving revision 1.1 diff -a -u -r1.1 035JDBCAppender.t ---
 > t/035JDBCAppender.t	27 Dec 2002 00:03:28 -0000	1.1 +++
 > t/035JDBCAppender.t	14 Jan 2003 09:26:03 -0000 @@ -94,9 +94,9 @@
 >
 > my $logger = Log::Log4perl->get_logger("groceries.beer");
 >
 > -$logger->fatal(['fatal message',1234,'foo','bar']);
 > -$logger->warn(['warning message',3456,'foo','bar']);
 > -$logger->debug(['debug message',99,'foo','bar']);
 > +$logger->fatal('fatal message',1234,'foo','bar');
 > +$logger->warn('warning message',3456,'foo','bar');
 > +$logger->debug('debug message',99,'foo','bar');
 >
 > my $sth = $dbh->prepare('select * from log4perltest'); $sth->execute;
 >
-- 
Happy Trails . . .

Kevin M. Goess
(and Anne and Frank)
904 Carmel Ave.
Albany, CA  94706
(510) 525-5217