1 /* Licensed to the Apache Software Foundation (ASF) under one or more
2 * contributor license agreements. See the NOTICE file distributed with
3 * this work for additional information regarding copyright ownership.
4 * The ASF licenses this file to You under the Apache License, Version 2.0
5 * (the "License"); you may not use this file except in compliance with
6 * the License. You may obtain a copy of the License at
7 *
8 * http://www.apache.org/licenses/LICENSE-2.0
9 *
10 * Unless required by applicable law or agreed to in writing, software
11 * distributed under the License is distributed on an "AS IS" BASIS,
12 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13 * See the License for the specific language governing permissions and
14 * limitations under the License.
15 */
16
mpxs_Apache2__Log_BOOT(pTHX)17 static void mpxs_Apache2__Log_BOOT(pTHX)
18 {
19 av_push(get_av("Apache2::Log::Request::ISA", TRUE),
20 newSVpv("Apache2::Log", 12));
21 av_push(get_av("Apache2::Log::Server::ISA", TRUE),
22 newSVpv("Apache2::Log", 12));
23 }
24
25 #define croak_inval_obj() \
26 Perl_croak(aTHX_ "Argument is not an Apache2::RequestRec " \
27 "or Apache2::ServerRec object")
28
mpxs_ap_log_error(pTHX_ int level,SV * sv,SV * msg)29 static void mpxs_ap_log_error(pTHX_ int level, SV *sv, SV *msg)
30 {
31 char *file = NULL;
32 int line = 0;
33 char *str;
34 SV *svstr = (SV *)NULL;
35 STRLEN n_a;
36 int lmask = level & APLOG_LEVELMASK;
37 server_rec *s;
38 request_rec *r = NULL;
39
40 if (SvROK(sv) && sv_isa(sv, "Apache2::Log::Request")) {
41 r = INT2PTR(request_rec *, SvObjIV(sv));
42 s = r->server;
43 }
44 else if (SvROK(sv) && sv_isa(sv, "Apache2::Log::Server")) {
45 s = INT2PTR(server_rec *, SvObjIV(sv));
46 }
47 else {
48 s = modperl_global_get_server_rec();
49 }
50
51 if ((lmask >= APLOG_DEBUG) && (mp_loglevel(s) >= APLOG_DEBUG)) {
52 COP *cop = PL_curcop;
53 file = CopFILE(cop); /* (caller)[1] */
54 line = CopLINE(cop); /* (caller)[2] */
55 }
56
57 if ((mp_loglevel(s) >= lmask) &&
58 SvROK(msg) && (SvTYPE(SvRV(msg)) == SVt_PVCV)) {
59 dSP;
60 ENTER;SAVETMPS;
61 PUSHMARK(sp);
62 (void)call_sv(msg, G_SCALAR);
63 SPAGAIN;
64 svstr = POPs;
65 (void)SvREFCNT_inc(svstr);
66 PUTBACK;
67 FREETMPS;LEAVE;
68 str = SvPV(svstr,n_a);
69 }
70 else {
71 str = SvPV(msg,n_a);
72 }
73
74 if (r) {
75 ap_log_rerror(file, line, mp_module_index_ level, 0, r,
76 "%s", str);
77 }
78 else {
79 ap_log_error(file, line, mp_module_index_ level, 0, s,
80 "%s", str);
81 }
82
83 if (svstr) {
84 SvREFCNT_dec(svstr);
85 }
86 }
87
88 #define MP_LOG_REQUEST 1
89 #define MP_LOG_SERVER 2
90
mpxs_Apache2__Log_log(pTHX_ SV * sv,int logtype)91 static SV *mpxs_Apache2__Log_log(pTHX_ SV *sv, int logtype)
92 {
93 SV *svretval;
94 void *retval;
95 char *pclass;
96
97 switch (logtype) {
98 case MP_LOG_REQUEST:
99 pclass = "Apache2::Log::Request";
100 retval = (void *)modperl_sv2request_rec(aTHX_ sv);
101 break;
102 case MP_LOG_SERVER:
103 pclass = "Apache2::Log::Server";
104 retval = (void *)modperl_sv2server_rec(aTHX_ sv);
105 break;
106 default:
107 croak_inval_obj();
108 };
109
110 svretval = newSV(0);
111 sv_setref_pv(svretval, pclass, (void*)retval);
112
113 return svretval;
114 }
115
116 #define mpxs_Apache2__RequestRec_log(sv) \
117 mpxs_Apache2__Log_log(aTHX_ sv, MP_LOG_REQUEST)
118
119 #define mpxs_Apache2__ServerRec_log(sv) \
120 mpxs_Apache2__Log_log(aTHX_ sv, MP_LOG_SERVER)
121
modperl_perl_do_join(pTHX_ SV ** mark,SV ** sp)122 static MP_INLINE SV *modperl_perl_do_join(pTHX_ SV **mark, SV **sp)
123 {
124 SV *sv = newSV(0);
125 SV *delim;
126 #ifdef WIN32
127 /* XXX: using PL_sv_no crashes on win32 with 5.6.1 */
128 delim = newSVpv("", 0);
129 #else
130 delim = SvREFCNT_inc(&PL_sv_no);
131 #endif
132
133 do_join(sv, delim, mark, sp);
134
135 SvREFCNT_dec(delim);
136
137 return sv;
138 }
139
140 #define my_do_join(m, s) \
141 modperl_perl_do_join(aTHX_ (m), (s))
142
XS(MPXS_Apache2__Log_dispatch)143 MP_STATIC XS(MPXS_Apache2__Log_dispatch)
144 {
145 dXSARGS;
146 SV *msgsv;
147 int level;
148 char *name = GvNAME(CvGV(cv));
149
150 if (items < 2) {
151 Perl_croak(aTHX_ "usage: %s::%s(obj, ...)",
152 mpxs_cv_name());
153 }
154
155 if (items > 2) {
156 msgsv = my_do_join(MARK+1, SP);
157 }
158 else {
159 msgsv = ST(1);
160 (void)SvREFCNT_inc(msgsv);
161 }
162
163 switch (*name) {
164 case 'e':
165 if (*(name + 1) == 'r') {
166 level = APLOG_ERR;
167 break;
168 }
169 level = APLOG_EMERG;
170 break;
171 case 'w':
172 level = APLOG_WARNING;
173 break;
174 case 'n':
175 level = APLOG_NOTICE;
176 break;
177 case 'i':
178 level = APLOG_INFO;
179 break;
180 case 'd':
181 level = APLOG_DEBUG;
182 break;
183 case 'a':
184 level = APLOG_ALERT;
185 break;
186 case 'c':
187 level = APLOG_CRIT;
188 break;
189 default:
190 level = APLOG_ERR; /* should never get here */
191 break;
192 };
193
194 mpxs_ap_log_error(aTHX_ level, ST(0), msgsv);
195
196 SvREFCNT_dec(msgsv);
197
198 XSRETURN_EMPTY;
199 }
200
XS(MPXS_Apache2__Log_LOG_MARK)201 MP_STATIC XS(MPXS_Apache2__Log_LOG_MARK)
202 {
203 dXSARGS;
204 ax = ax; /* -Wall */;
205
206 mpxs_PPCODE({
207 COP *cop = PL_curcop;
208
209 if (items) {
210 Perl_croak(aTHX_ "usage %s::%s()", mpxs_cv_name());
211 }
212
213 EXTEND(SP, 2);
214 PUSHs_mortal_pv(CopFILE(cop));
215 PUSHs_mortal_iv(CopLINE(cop));
216 });
217 }
218
XS(MPXS_Apache2__Log_log_xerror)219 MP_STATIC XS(MPXS_Apache2__Log_log_xerror)
220 {
221 dXSARGS;
222 SV *msgsv = (SV *)NULL;
223 STRLEN n_a;
224 request_rec *r = NULL;
225 server_rec *s = NULL;
226 char *msgstr;
227 const char *file;
228 int line, level;
229 apr_status_t status;
230
231 if (items < 6) {
232 Perl_croak(aTHX_ "usage %s::%s(file, line, level, status, ...)",
233 mpxs_cv_name());
234 }
235
236 switch (*(GvNAME(CvGV(cv)) + 4)) { /* 4 == log_ */
237 case 'r':
238 r = modperl_xs_sv2request_rec(aTHX_ ST(0), NULL, cv);
239 break;
240 case 's':
241 s = modperl_sv2server_rec(aTHX_ ST(0));
242 break;
243 default:
244 croak_inval_obj();
245 };
246
247 file = (const char *)SvPV(ST(1), n_a);
248 line = (int)SvIV(ST(2));
249 level = (int)SvIV(ST(3));
250 status = (apr_status_t)SvIV(ST(4));
251
252 if (items > 6) {
253 msgsv = my_do_join(MARK+5, SP);
254 }
255 else {
256 msgsv = ST(5);
257 (void)SvREFCNT_inc(msgsv);
258 }
259
260 msgstr = SvPV(msgsv, n_a);
261
262 if (r) {
263 ap_log_rerror(file, line, mp_module_index_ level, status, r,
264 "%s", msgstr);
265 }
266 else {
267 ap_log_error(file, line, mp_module_index_ level, status, s,
268 "%s", msgstr);
269 }
270
271 SvREFCNT_dec(msgsv);
272
273 XSRETURN_EMPTY;
274 }
275
276 /*
277 * this function handles:
278 * $r->log_error
279 * $s->log_error
280 * $r->warn
281 * $s->warn
282 * Apache2::ServerRec::warn
283 */
XS(MPXS_Apache2__Log_log_error)284 MP_STATIC XS(MPXS_Apache2__Log_log_error)
285 {
286 dXSARGS;
287 request_rec *r = NULL;
288 server_rec *s = NULL;
289 int i = 0;
290 char *errstr = NULL;
291 SV *sv = (SV *)NULL;
292 STRLEN n_a;
293
294 if (items > 1) {
295 if (sv_isa(ST(0), "Apache2::ServerRec")) {
296 s = INT2PTR(server_rec *, SvObjIV(ST(0)));
297 }
298 else if ((r = modperl_xs_sv2request_rec(aTHX_ ST(0),
299 "Apache2::RequestRec", cv))) {
300 s = r->server;
301 }
302 }
303
304 if (s) {
305 i = 1;
306 }
307 else {
308 request_rec *r = NULL;
309 (void)modperl_tls_get_request_rec(&r);
310 if (r) {
311 s = r->server;
312 }
313 else {
314 s = modperl_global_get_server_rec();
315 }
316 }
317
318 if (items > 1+i) {
319 sv = my_do_join(MARK+i, SP); /* $sv = join '', @_[1..$#_] */
320 errstr = SvPV(sv,n_a);
321 }
322 else {
323 errstr = SvPV(ST(i),n_a);
324 }
325
326 switch (*GvNAME(CvGV(cv))) {
327 case 'w':
328 modperl_log_warn(s, errstr);
329 break;
330 default:
331 modperl_log_error(s, errstr);
332 break;
333 }
334
335 if (sv) {
336 SvREFCNT_dec(sv);
337 }
338
339 XSRETURN_EMPTY;
340 }
341
342 /*
343 * Local Variables:
344 * c-basic-offset: 4
345 * indent-tabs-mode: nil
346 * End:
347 */
348