← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/modules/perl/modperl_perl_global.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_perl_global.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
static void modperl_perl_global_init(pTHX_ modperl_perl_globals_t *globals)
50
65
    return NULL;
51
66
}
52
67
 
 
68
/*
 
69
 * if (exists $PL_modglobal{$key}{$package}) {
 
70
 *      return $PL_modglobal{$key}{$package};
 
71
 * }
 
72
 * elsif ($autovivify) {
 
73
 *     return $PL_modglobal{$key}{$package} = [];
 
74
 * }
 
75
 * else {
 
76
 *     return $Nullav; # a null pointer in C of course :)
 
77
 * }
 
78
 */
53
79
static AV *modperl_perl_global_avcv_fetch(pTHX_ modperl_modglobal_key_t *gkey,
54
 
                                          const char *package, I32 packlen)
 
80
                                          const char *package, I32 packlen,
 
81
                                          I32 autovivify)
55
82
{
56
83
    HE *he = MP_MODGLOBAL_FETCH(gkey);
57
84
    HV *hv;
58
85
 
59
86
    if (!(he && (hv = (HV*)HeVAL(he)))) {
60
 
        return Nullav;
61
 
    }
62
 
 
63
 
    if (!(he = hv_fetch_he(hv, (char *)package, packlen, 0))) {
64
 
        return Nullav;
65
 
    }
66
 
 
67
 
    return (AV*)HeVAL(he);
68
 
}
69
 
 
 
87
        if (autovivify) {
 
88
            hv = MP_MODGLOBAL_STORE_HV(gkey);
 
89
        }
 
90
        else {
 
91
            return Nullav;
 
92
        }
 
93
    }
 
94
 
 
95
    if ((he = hv_fetch_he(hv, (char *)package, packlen, 0))) {
 
96
        return (AV*)HeVAL(he);
 
97
    }
 
98
    else {
 
99
        if (autovivify) {
 
100
            return (AV*)*hv_store(hv, package, packlen, (SV*)newAV(), 0);
 
101
        }
 
102
        else {
 
103
            return Nullav;
 
104
        }
 
105
    }
 
106
}
 
107
 
 
108
/* autovivify $PL_modglobal{$key}{$package} if it doesn't exist yet,
 
109
 * so that in modperl_perl_global_avcv_set we will know whether to
 
110
 * store blocks in it or keep them in the original list.
 
111
 *
 
112
 * For example in the case of END blocks, if
 
113
 * $PL_modglobal{END}{$package} exists, modperl_perl_global_avcv_set
 
114
 * will push newly encountered END blocks to it, otherwise it'll keep
 
115
 * them in PL_endav.
 
116
 */
 
117
void modperl_perl_global_avcv_register(pTHX_ modperl_modglobal_key_t *gkey,
 
118
                                       const char *package, I32 packlen)
 
119
{
 
120
    AV *av = modperl_perl_global_avcv_fetch(aTHX_ gkey,
 
121
                                            package, packlen, TRUE);
 
122
 
 
123
    MP_TRACE_g(MP_FUNC, "register PL_modglobal %s::%s (has %d entries)",
 
124
               package, (char*)gkey->name, av ? 1+av_len(av) : 0);
 
125
}
 
126
 
 
127
/* if (exists $PL_modglobal{$key}{$package}) {
 
128
 *     for my $cv (@{ $PL_modglobal{$key}{$package} }) {
 
129
 *         $cv->();
 
130
 *     }
 
131
 * }
 
132
 */
70
133
void modperl_perl_global_avcv_call(pTHX_ modperl_modglobal_key_t *gkey,
71
134
                                   const char *package, I32 packlen)
72
135
{
73
 
    AV *av = modperl_perl_global_avcv_fetch(aTHX_ gkey, package, packlen);
74
 
 
75
 
    if (!av) {
76
 
        return;
 
136
    AV *av = modperl_perl_global_avcv_fetch(aTHX_ gkey, package, packlen,
 
137
                                            FALSE);
 
138
 
 
139
    MP_TRACE_g(MP_FUNC, "run PL_modglobal %s::%s (has %d entries)",
 
140
               package, (char*)gkey->name, av ? 1+av_len(av) : 0);
 
141
 
 
142
    if (av) {
 
143
        modperl_perl_call_list(aTHX_ av, gkey->name);
77
144
    }
78
 
 
79
 
    modperl_perl_call_list(aTHX_ av, gkey->name);
80
145
}
81
146
 
 
147
 
 
148
/* if (exists $PL_modglobal{$key}{$package}) {
 
149
 *     @{ $PL_modglobal{$key}{$package} } = ();
 
150
 * }
 
151
 */
82
152
void modperl_perl_global_avcv_clear(pTHX_ modperl_modglobal_key_t *gkey,
83
153
                                    const char *package, I32 packlen)
84
154
{
85
 
    AV *av = modperl_perl_global_avcv_fetch(aTHX_ gkey, package, packlen);
 
155
    AV *av = modperl_perl_global_avcv_fetch(aTHX_ gkey,
 
156
                                            package, packlen, FALSE);
86
157
 
87
 
    if (!av) {
88
 
        return;
 
158
    MP_TRACE_g(MP_FUNC, "clear PL_modglobal %s::%s (has %d entries)",
 
159
               package, (char*)gkey->name, av ? 1+av_len(av) : 0);
 
160
    
 
161
    if (av) {
 
162
        av_clear(av);
89
163
    }
90
 
 
91
 
    av_clear(av);
92
164
}
93
165
 
94
166
static int modperl_perl_global_avcv_set(pTHX_ SV *sv, MAGIC *mg)
95
167
{
96
 
    HE *he;
97
 
    HV *hv;
98
168
    AV *mav, *av = (AV*)sv;
99
169
    const char *package = HvNAME(PL_curstash);
100
170
    I32 packlen = strlen(package);
101
171
    modperl_modglobal_key_t *gkey =
102
172
        (modperl_modglobal_key_t *)mg->mg_ptr;
103
173
 
104
 
    if ((he = MP_MODGLOBAL_FETCH(gkey))) {
105
 
        hv = (HV*)HeVAL(he);
106
 
    }
107
 
    else {
108
 
        hv = MP_MODGLOBAL_STORE_HV(gkey);
109
 
    }
110
 
 
111
 
    if ((he = hv_fetch_he(hv, (char *)package, packlen, 0))) {
112
 
        mav = (AV*)HeVAL(he);
113
 
    }
114
 
    else {
115
 
        mav = (AV*)*hv_store(hv, package, packlen, (SV*)newAV(), 0);
116
 
    }
117
 
 
118
 
    /* $cv = pop @av */
119
 
    sv = AvARRAY(av)[AvFILLp(av)];
120
 
    AvARRAY(av)[AvFILLp(av)--] = &PL_sv_undef;
121
 
 
 
174
    /* the argument sv, is the original list perl was operating on.
 
175
     * (e.g. PL_endav). So now if we find that we have package/cv name
 
176
     * (e.g. Foo/END) registered for set-aside, we remove the cv that
 
177
     * was just unshifted in and push it into
 
178
     * $PL_modglobal{$key}{$package}. Otherwise we do nothing, which
 
179
     * keeps the unshifted cv (e.g. END block) in its original av
 
180
     * (e.g. PL_endav)
 
181
     */
 
182
     
 
183
    mav = modperl_perl_global_avcv_fetch(aTHX_ gkey, package, packlen, FALSE);
 
184
    
 
185
    if (!mav) {
 
186
        MP_TRACE_g(MP_FUNC, "%s::%s is not going to PL_modglobal",
 
187
                   package, (char*)gkey->name);
 
188
        /* keep it in the tied list (e.g. PL_endav) */
 
189
        return 1;
 
190
    }
 
191
 
 
192
    MP_TRACE_g(MP_FUNC, "%s::%s is going into PL_modglobal",
 
193
               package, (char*)gkey->name);
 
194
        
 
195
    sv = av_shift(av);
 
196
    
122
197
    /* push @{ $PL_modglobal{$key}{$package} }, $cv */
123
 
    av_store(mav, AvFILLp(av)+1, sv);
 
198
    av_store(mav, AvFILLp(mav)+1, sv);
124
199
 
 
200
    /* print scalar @{ $PL_modglobal{$key}{$package} } */
 
201
    MP_TRACE_g(MP_FUNC, "%s::%s av now has %d entries\n",
 
202
               package, (char*)gkey->name, 1+av_len(mav));
 
203
    
125
204
    return 1;
126
205
}
127
206
 
131
210
    0, 0, 0,
132
211
};
133
212
 
134
 
/* XXX: Apache::RegistryLoader type things need access to this
135
 
 * for compiling scripts at startup
136
 
 */
137
213
static void modperl_perl_global_avcv_tie(pTHX_ modperl_modglobal_key_e key,
138
214
                                         AV *av)
139
215
{
157
233
static void
158
234
modperl_perl_global_avcv_save(pTHX_ modperl_perl_global_avcv_t *avcv)
159
235
{
160
 
    avcv->origav = *avcv->av;
161
 
    *avcv->av = newAV(); /* XXX: only need 1 of these AVs per-interpreter */
 
236
    if (!*avcv->av) {
 
237
        *avcv->av = newAV();
 
238
    }
 
239
 
162
240
    modperl_perl_global_avcv_tie(aTHX_ avcv->key, *avcv->av);
163
241
}
164
242
 
166
244
modperl_perl_global_avcv_restore(pTHX_ modperl_perl_global_avcv_t *avcv)
167
245
{
168
246
    modperl_perl_global_avcv_untie(aTHX_ *avcv->av);
169
 
    SvREFCNT_dec(*avcv->av); /* XXX: see XXX above */
170
 
    *avcv->av = avcv->origav;
171
247
}
172
248
 
173
249
/*