← Back to branch summary

~ubuntu-branches/ubuntu/edgy/libapache2-mod-perl2/edgy

« back to all changes in this revision

Viewing changes to src/modules/perl/modperl_handler.c

  • Committer: Bazaar Package Importer
  • Author(s): Adam Conrad
  • Date: 2004-08-19 06:23:48 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20040819062348-jxl4koqbtvgm8v2t
Tags: 1.99.14-4
Remove the LFS CFLAGS, and build-dep against apache2-*-dev (>= 2.0.50-10)
as we're backing out of the apache2/apr ABI transition.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/modules/perl/modperl_handler.c
 
1
/* Copyright 2001-2004 The Apache Software Foundation
 
2
 *
 
3
 * Licensed under the Apache License, Version 2.0 (the "License");
 
4
 * you may not use this file except in compliance with the License.
 
5
 * You may obtain a copy of the License at
 
6
 *
 
7
 *     http://www.apache.org/licenses/LICENSE-2.0
 
8
 *
 
9
 * Unless required by applicable law or agreed to in writing, software
 
10
 * distributed under the License is distributed on an "AS IS" BASIS,
 
11
 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 
12
 * See the License for the specific language governing permissions and
 
13
 * limitations under the License.
 
14
 */
 
15
 
1
16
#include "mod_perl.h"
2
17
 
3
18
modperl_handler_t *modperl_handler_new(apr_pool_t *p, const char *name)
14
29
        ++name;
15
30
        /* XXX: currently a noop; should disable autoload of given handler
16
31
         * if PerlOptions +AutoLoad is configured
 
32
         * see: modperl_hash_handlers in modperl_mgv.c
17
33
         */
18
34
        MpHandlerAUTOLOAD_Off(handler);
19
35
        break;
20
36
    }
21
37
 
 
38
    handler->cv = NULL;
22
39
    handler->name = name;
23
40
    MP_TRACE_h(MP_FUNC, "[%s] new handler %s\n",
24
41
               modperl_pid_tid(p), handler->name);
26
43
    return handler;
27
44
}
28
45
 
 
46
 
 
47
static
 
48
modperl_handler_t *modperl_handler_new_anon(pTHX_ apr_pool_t *p, CV *cv)
 
49
{
 
50
    modperl_handler_t *handler = 
 
51
        (modperl_handler_t *)apr_pcalloc(p, sizeof(*handler));
 
52
    MpHandlerPARSED_On(handler);
 
53
    MpHandlerANON_On(handler);
 
54
 
 
55
#ifdef USE_ITHREADS
 
56
    /* XXX: perhaps we can optimize this further. At the moment when
 
57
     * perl w/ ithreads is used, we always deparse the anon subs
 
58
     * before storing them and then eval them each time they are
 
59
     * used. This is because we don't know whether the same perl that
 
60
     * compiled the anonymous sub is used to run it.
 
61
     *
 
62
     * A possible optimization is to cache the CV and use that cached
 
63
     * value w/ or w/o deparsing at all if:
 
64
     *
 
65
     * - the mpm is non-threaded mpm and no +Clone/+Parent is used
 
66
     *   (i.e. no perl pools) (no deparsing is needed at all)
 
67
     * 
 
68
     * - the interpreter that has supplied the anon cv is the same
 
69
     *   interpreter that is executing that cv (requires storing aTHX
 
70
     *   in the handler's struct) (need to deparse in case the
 
71
     *   interpreter gets switched)
 
72
     *
 
73
     * - other cases?
 
74
     */
 
75
    handler->cv = NULL;
 
76
    handler->name = modperl_coderef2text(aTHX_ p, cv);
 
77
    MP_TRACE_h(MP_FUNC, "[%s] new deparsed anon handler:\n%s\n",
 
78
               modperl_pid_tid(p), handler->name);
 
79
#else
 
80
    /* it's safe to cache and later use the cv, since the same perl
 
81
     * interpeter is always used */
 
82
    handler->cv = cv;
 
83
    handler->name = NULL;
 
84
    MP_TRACE_h(MP_FUNC, "[%s] new cached cv anon handler\n",
 
85
               modperl_pid_tid(p));
 
86
#endif
 
87
 
 
88
    return handler;
 
89
}
 
90
 
 
91
MP_INLINE
 
92
const char *modperl_handler_name(modperl_handler_t *handler)
 
93
{
 
94
    /* a handler containing an anonymous sub doesn't have a normal sub
 
95
     * name */
 
96
    return handler->name ? handler->name : "anonymous sub";
 
97
}
 
98
 
 
99
 
29
100
int modperl_handler_resolve(pTHX_ modperl_handler_t **handp,
30
101
                            apr_pool_t *p, server_rec *s)
31
102
{
319
390
                                           action, NULL);
320
391
}
321
392
 
 
393
modperl_handler_t *modperl_handler_new_from_sv(pTHX_ apr_pool_t *p, SV *sv)
 
394
{
 
395
    char *name = NULL;
 
396
    GV *gv;
 
397
 
 
398
    if (SvROK(sv)) {
 
399
        sv = SvRV(sv);
 
400
    }
 
401
 
 
402
    switch (SvTYPE(sv)) {
 
403
      case SVt_PV:
 
404
        name = SvPVX(sv);
 
405
        return modperl_handler_new(p, apr_pstrdup(p, name));
 
406
        break;
 
407
      case SVt_PVCV:
 
408
        if (CvANON((CV*)sv)) {
 
409
            return modperl_handler_new_anon(aTHX_ p, (CV*)sv);
 
410
        }
 
411
        if (!(gv = CvGV((CV*)sv))) {
 
412
            Perl_croak(aTHX_ "can't resolve the code reference");
 
413
        }
 
414
        name = apr_pstrcat(p, HvNAME(GvSTASH(gv)), "::", GvNAME(gv), NULL);
 
415
        return modperl_handler_new(p, apr_pstrdup(p, name));
 
416
        break;
 
417
    };
 
418
 
 
419
    return NULL;
 
420
}
 
421
 
322
422
int modperl_handler_push_handlers(pTHX_ apr_pool_t *p,
323
423
                                  MpAV *handlers, SV *sv)
324
424
{
325
 
    char *handler_name;
 
425
    modperl_handler_t *handler = modperl_handler_new_from_sv(aTHX_ p, sv);
326
426
 
327
 
    if ((handler_name = modperl_mgv_name_from_sv(aTHX_ p, sv))) {
328
 
        modperl_handler_t *handler =
329
 
            modperl_handler_new(p, apr_pstrdup(p, handler_name));
 
427
    if (handler) {
330
428
        modperl_handler_array_push(handlers, handler);
331
429
        return TRUE;
332
430
    }