perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From do...@apache.org
Subject cvs commit: modperl-2.0/xs/maps apache_functions.map modperl_functions.map
Date Thu, 03 May 2001 06:21:00 GMT
dougm       01/05/02 23:21:00

  Modified:    xs/maps  apache_functions.map modperl_functions.map
  Added:       t/response/TestAPI aplog.pm
               xs/Apache/Log Apache__Log.h
  Log:
  add Apache::Log api and tests
  
  Revision  Changes    Path
  1.1                  modperl-2.0/t/response/TestAPI/aplog.pm
  
  Index: aplog.pm
  ===================================================================
  package TestAPI::aplog;
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Log ();
  use Apache::Test;
  
  my @LogLevels = qw(emerg alert crit error warn notice info debug);
  my $package = __PACKAGE__;
  
  sub handler {
      my $r = shift;
  
      plan $r, tests => (@LogLevels * 2) + 3;
  
      my $rlog = $r->log;
  
      ok $rlog->isa('Apache::Log::Request');
  
      my $slog = $r->server->log;
  
      ok $slog->isa('Apache::Log::Server');
  
      $rlog->info($package, " test in progress");
  
      for my $method (@LogLevels) {
          #wrap in sub {}, else Test.pm tries to run the return value of ->can
          ok sub { $rlog->can($method) };
          ok sub { $slog->can($method) };
      }
  
      $slog->info(sub { ok 1; "$package test done" });
  
      Apache::OK;
  }
  
  1;
  
  
  
  1.1                  modperl-2.0/xs/Apache/Log/Apache__Log.h
  
  Index: Apache__Log.h
  ===================================================================
  static void mpxs_Apache__Log_BOOT(pTHXo)
  {
      av_push(get_av("Apache::Log::Request::ISA",TRUE), 
  	    newSVpv("Apache::Log",11));
      av_push(get_av("Apache::Log::Server::ISA",TRUE), 
  	    newSVpv("Apache::Log",11));
  }
  
  #define croak_inval_obj() \
  Perl_croak(aTHX_ "Argument is not an Apache::RequestRec " \
                   "or Apache::Server object")
  
  static void mpxs_ap_log_error(pTHX_ int level, SV *sv, SV *msg)
  {
      char *file = NULL;
      int line = 0;
      char *str;
      SV *svstr = Nullsv;
      STRLEN n_a;
      int lmask = level & APLOG_LEVELMASK;
      server_rec *s;
      request_rec *r = NULL;
  
      if (SvROK(sv) && sv_isa(sv, "Apache::Log::Request")) {
  	r = (request_rec *)SvObjIV(sv);
  	s = r->server;
      }
      else if (SvROK(sv) && sv_isa(sv, "Apache::Log::Server")) {
  	s = (server_rec *)SvObjIV(sv);
      }
      else {
          croak_inval_obj();
      }
  
      if ((lmask == APLOG_DEBUG) && (s->loglevel >= APLOG_DEBUG)) {
          COP *cop = cxstack[1].blk_oldcop;
  	file = CopFILE(cop); /* (caller)[1] */
  	line = CopLINE(cop); /* (caller)[2] */
      }
  
      if ((s->loglevel >= lmask) && 
          SvROK(msg) && (SvTYPE(SvRV(msg)) == SVt_PVCV))
      {
  	dSP;
  	ENTER;SAVETMPS;
  	PUSHMARK(sp);
  	(void)call_sv(msg, G_SCALAR);
  	SPAGAIN;
  	svstr = POPs;
  	(void)SvREFCNT_inc(svstr);
  	PUTBACK;
  	FREETMPS;LEAVE;
  	str = SvPV(svstr,n_a);
      }
      else {
  	str = SvPV(msg,n_a);
      }
  
      if (r) {
  	ap_log_rerror(file, line, APLOG_NOERRNO|level, 0, r, "%s", str);
      }
      else {
  	ap_log_error(file, line, APLOG_NOERRNO|level, 0, s, "%s", str);
      }
  
      if (svstr) {
          SvREFCNT_dec(svstr);
      }
  }
  
  #define MP_LOG_REQUEST 1
  #define MP_LOG_SERVER  2
  
  static SV *mpxs_Apache__Log_log(pTHX_ SV *sv, int logtype)
  {
      SV *svretval;
      void *retval;
      char *pclass;
  
      if (!SvROK(sv)) {
          Perl_croak(aTHX_ "Argument is not a reference");
      }
  
      switch (logtype) {
        case MP_LOG_REQUEST:
          pclass = "Apache::Log::Request";
  	retval = (void *)modperl_sv2request_rec(aTHX_ sv);
          break;
        case MP_LOG_SERVER:
  	pclass = "Apache::Log::Server";
  	retval = (void *)SvObjIV(sv);
          break;
        default:
          croak_inval_obj();
      };
  
      svretval = newSV(0);
      sv_setref_pv(svretval, pclass, (void*)retval);
  
      return svretval;
  }
  
  #define mpxs_Apache__RequestRec_log(sv) \
  mpxs_Apache__Log_log(aTHX_ sv, MP_LOG_REQUEST)
  
  #define mpxs_Apache__Server_log(sv) \
  mpxs_Apache__Log_log(aTHX_ sv, MP_LOG_SERVER)
  
  static XS(MPXS_Apache__Log_dispatch)
  {
      dXSARGS;
      SV *msgsv;
      int level;
      char *name = GvNAME(CvGV(cv));
  
      if (items < 2) {
          Perl_croak(aTHX_ "usage: %s::%s(obj, ...)",
                     mpxs_cv_name());
      }
  
      if (items > 2) {
          msgsv = newSV(0);
          do_join(msgsv, &PL_sv_no, MARK+1, SP);
      }
      else {
          msgsv = ST(1);
          (void)SvREFCNT_inc(msgsv);
      }
  
      switch (*name) {
        case 'e':
          if (*(name + 1) == 'r') {
              level = APLOG_ERR;
              break;
          }
          level = APLOG_EMERG;
          break;
        case 'w':
          level = APLOG_WARNING;
          break;
        case 'n':
          level = APLOG_NOTICE;
          break;
        case 'i':
          level = APLOG_INFO;
          break;
        case 'd':
          level = APLOG_DEBUG;
          break;
        case 'a':
          level = APLOG_ALERT;
          break;
        case 'c':
          level = APLOG_CRIT;
          break;
        default:
          level = APLOG_ERR; /* should never get here */
          break;
      };
  
      mpxs_ap_log_error(aTHX_ level, ST(0), msgsv);
  
      SvREFCNT_dec(msgsv);
  
      XSRETURN_EMPTY;
  }
  
  
  
  1.17      +4 -4      modperl-2.0/xs/maps/apache_functions.map
  
  Index: apache_functions.map
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/xs/maps/apache_functions.map,v
  retrieving revision 1.16
  retrieving revision 1.17
  diff -u -r1.16 -r1.17
  --- apache_functions.map	2001/04/29 17:53:42	1.16
  +++ apache_functions.map	2001/05/03 06:20:59	1.17
  @@ -147,12 +147,12 @@
   >ap_update_vhost_given_ip
    ap_new_connection
   
  -!MODULE=Apache::Log   PACKAGE=guess
  - ap_log_assert
  +MODULE=Apache::Log   PACKAGE=guess
  +?ap_log_assert
    ap_log_error
  - ap_log_perror
  +-ap_log_perror
    ap_log_pid
  - ap_log_rerror
  +~ap_log_rerror
   >ap_open_stderr_log
   >ap_open_logs
   
  
  
  
  1.10      +18 -0     modperl-2.0/xs/maps/modperl_functions.map
  
  Index: modperl_functions.map
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/xs/maps/modperl_functions.map,v
  retrieving revision 1.9
  retrieving revision 1.10
  diff -u -r1.9 -r1.10
  --- modperl_functions.map	2001/04/30 04:39:29	1.9
  +++ modperl_functions.map	2001/05/03 06:20:59	1.10
  @@ -31,3 +31,21 @@
   
    SV *:DEFINE_TIEHANDLE | | SV *:stashsv, SV *:sv=Nullsv
    int:DEFINE_PRINT      | | ...
  +
  +MODULE=Apache::Log   PACKAGE=Apache::Log   BOOT=1
  +
  +DEFINE_error  | MPXS_Apache__Log_dispatch | ...
  +DEFINE_emerg  | MPXS_Apache__Log_dispatch | ...
  +DEFINE_alert  | MPXS_Apache__Log_dispatch | ...
  +DEFINE_warn   | MPXS_Apache__Log_dispatch | ...
  +DEFINE_notice | MPXS_Apache__Log_dispatch | ...
  +DEFINE_info   | MPXS_Apache__Log_dispatch | ...
  +DEFINE_debug  | MPXS_Apache__Log_dispatch | ...
  +DEFINE_crit   | MPXS_Apache__Log_dispatch | ...
  +
  +PACKAGE=Apache::RequestRec
  +SV *:DEFINE_log | | SV *:obj
  +
  +PACKAGE=Apache::Server
  +SV *:DEFINE_log | | SV *:obj
  +
  
  
  

Mime
View raw message