cvs commit: modperl/t/net/perl log.pl

[do...@hyperreal.org]

dougm       98/08/28 13:36:34

  Modified:    .        Changes
               src/modules/perl Log.xs
               t/net/perl log.pl
  Log:
  Apache::Log optimizations:
    ${r,s}->log->$method() will now accept a CODE ref as it's first
    argument, which is only called when $method >= LogLevel
    caller() file/line info determined only if LogLevel >= debug
    avoid copy of message SV
  
  Revision  Changes    Path
  1.119     +6 -0      modperl/Changes
  
  Index: Changes
  ===================================================================
  RCS file: /export/home/cvs/modperl/Changes,v
  retrieving revision 1.118
  retrieving revision 1.119
  diff -u -r1.118 -r1.119
  --- Changes	1998/08/28 18:35:05	1.118
  +++ Changes	1998/08/28 20:36:30	1.119
  @@ -8,6 +8,12 @@
   
   =item 1.15_01-dev
   
  +Apache::Log optimizations:
  +  ${r,s}->log->$method() will now accept a CODE ref as it's first
  +  argument, which is only called when $method >= LogLevel
  +  caller() file/line info determined only if LogLevel >= debug
  +  avoid copy of message SV 
  +
   tweak Apache->module so it can test for configured .c modules
   
   pushing out experimental stuff:
  
  
  
  1.2       +27 -4     modperl/src/modules/perl/Log.xs
  
  Index: Log.xs
  ===================================================================
  RCS file: /export/home/cvs/modperl/src/modules/perl/Log.xs,v
  retrieving revision 1.1
  retrieving revision 1.2
  diff -u -r1.1 -r1.2
  --- Log.xs	1998/07/12 21:21:37	1.1
  +++ Log.xs	1998/08/28 20:36:31	1.2
  @@ -8,14 +8,36 @@
   {
       char *file = NULL;
       int line   = 0;
  -    if(level == APLOG_DEBUG) {
  +    char *str;
  +    SV *svstr = Nullsv;
  +    int lmask = level & APLOG_LEVELMASK;
  +
  +    if((lmask == APLOG_DEBUG) && (s->loglevel >= APLOG_DEBUG)) {
   	SV *caller = perl_eval_pv("[ (caller)[1,2] ]", TRUE);
   	file = SvPV(*av_fetch((AV *)SvRV(caller), 0, FALSE),na);
   	line = (int)SvIV(*av_fetch((AV *)SvRV(caller), 1, FALSE));
  +    }
  +
  +    if((s->loglevel >= lmask) && 
  +       SvROK(msg) && (SvTYPE(SvRV(msg)) == SVt_PVCV)) {
  +	dSP;
  +	ENTER;SAVETMPS;
  +	PUSHMARK(sp);
  +	(void)perl_call_sv(msg, G_SCALAR);
  +	SPAGAIN;
  +	svstr = POPs;
  +	++SvREFCNT(svstr);
  +	PUTBACK;
  +	FREETMPS;LEAVE;
  +	str = SvPV(svstr,na);
       }
  -    ap_log_error(file, line, APLOG_NOERRNO|level, 
  -		 s, SvPV(msg,na));
  +    else
  +	str = SvPV(msg,na);
  +
  +    ap_log_error(file, line, APLOG_NOERRNO|level, s, str);
  +
       SvREFCNT_dec(msg);
  +    if(svstr) SvREFCNT_dec(svstr);
   }
   
   #define join_stack_msg \
  @@ -25,7 +47,8 @@
       do_join(msgstr, &sv_no, MARK+1, SP); \
   } \
   else { \
  -    msgstr = newSVsv(ST(1)); \
  +    msgstr = ST(1); \
  +    ++SvREFCNT(msgstr); \
   } 
   
   #define MP_AP_LOG(l,s) \
  
  
  
  1.4       +9 -0      modperl/t/net/perl/log.pl
  
  Index: log.pl
  ===================================================================
  RCS file: /export/home/cvs/modperl/t/net/perl/log.pl,v
  retrieving revision 1.3
  retrieving revision 1.4
  diff -u -r1.3 -r1.4
  --- log.pl	1998/07/23 13:16:27	1.3
  +++ log.pl	1998/08/28 20:36:32	1.4
  @@ -26,6 +26,8 @@
   debug
   };
   my $tests = @methods * 2;
  +$tests += 2;
  +
   print "1..$tests\n";
   for my $method (@methods)
   {
  @@ -38,3 +40,10 @@
       test ++$i, $slog->can($method);
   }
   
  +my $x = 0;
  +$r->log->warn(sub { ++$x; "log __ANON__ OK" });
  +test ++$i, $x;
  +
  +my $zero = 0;
  +$r->log->debug(sub { ++$zero; "NOT OK" }); #LogLevel not set this high w/ 'make test'
  +test ++$i, $zero == 0;