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
+
