| /* Licensed to the Apache Software Foundation (ASF) under one or more |
| * contributor license agreements. See the NOTICE file distributed with |
| * this work for additional information regarding copyright ownership. |
| * The ASF licenses this file to You under the Apache License, Version 2.0 |
| * (the "License"); you may not use this file except in compliance with |
| * the License. You may obtain a copy of the License at |
| * |
| * http://www.apache.org/licenses/LICENSE-2.0 |
| * |
| * Unless required by applicable law or agreed to in writing, software |
| * distributed under the License is distributed on an "AS IS" BASIS, |
| * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. |
| * See the License for the specific language governing permissions and |
| * limitations under the License. |
| */ |
| |
| #include "mod_perl.h" |
| |
| /* |
| * modperl_bucket_sv code derived from mod_snake's ModSnakePyBucket |
| * by Jon Travis |
| */ |
| |
| typedef struct { |
| apr_bucket_refcount refcount; |
| SV *sv; |
| PerlInterpreter *perl; |
| } modperl_bucket_sv_t; |
| |
| static apr_status_t |
| modperl_bucket_sv_read(apr_bucket *bucket, const char **str, |
| apr_size_t *len, apr_read_type_e block) |
| { |
| modperl_bucket_sv_t *svbucket = bucket->data; |
| dTHXa(svbucket->perl); |
| STRLEN svlen; |
| char *pv = SvPV(svbucket->sv, svlen); |
| |
| *str = pv + bucket->start; |
| *len = bucket->length; |
| |
| if (svlen < bucket->start + bucket->length) { |
| /* XXX log error? */ |
| return APR_EGENERAL; |
| } |
| |
| return APR_SUCCESS; |
| } |
| |
| static void modperl_bucket_sv_destroy(void *data) |
| { |
| modperl_bucket_sv_t *svbucket = data; |
| dTHXa(svbucket->perl); |
| |
| if (!apr_bucket_shared_destroy(svbucket)) { |
| MP_TRACE_f(MP_FUNC, "bucket refcnt=%d", |
| ((apr_bucket_refcount *)svbucket)->refcount); |
| return; |
| } |
| |
| MP_TRACE_f(MP_FUNC, "sv=0x%lx, refcnt=%d", |
| (unsigned long)svbucket->sv, SvREFCNT(svbucket->sv)); |
| |
| SvREFCNT_dec(svbucket->sv); |
| |
| apr_bucket_free(svbucket); |
| } |
| |
| static |
| apr_status_t modperl_bucket_sv_setaside(apr_bucket *bucket, apr_pool_t *pool) |
| { |
| modperl_bucket_sv_t *svbucket = bucket->data; |
| dTHXa(svbucket->perl); |
| STRLEN svlen; |
| char *pv = SvPV(svbucket->sv, svlen); |
| |
| if (svlen < bucket->start + bucket->length) { |
| /* XXX log error? */ |
| return APR_EGENERAL; |
| } |
| |
| pv = apr_pstrmemdup(pool, pv + bucket->start, bucket->length); |
| if (pv == NULL) { |
| return APR_ENOMEM; |
| } |
| |
| /* changes bucket guts by reference */ |
| if (apr_bucket_pool_make(bucket, pv, bucket->length, pool) == NULL) { |
| return APR_ENOMEM; |
| } |
| |
| modperl_bucket_sv_destroy(svbucket); |
| return APR_SUCCESS; |
| } |
| |
| static const apr_bucket_type_t modperl_bucket_sv_type = { |
| "mod_perl SV bucket", 4, |
| #if MODULE_MAGIC_NUMBER >= 20020602 |
| APR_BUCKET_DATA, |
| #endif |
| modperl_bucket_sv_destroy, |
| modperl_bucket_sv_read, |
| modperl_bucket_sv_setaside, |
| apr_bucket_shared_split, |
| apr_bucket_shared_copy, |
| }; |
| |
| static apr_bucket *modperl_bucket_sv_make(pTHX_ |
| apr_bucket *bucket, |
| SV *sv, |
| apr_off_t offset, |
| apr_size_t len) |
| { |
| modperl_bucket_sv_t *svbucket; |
| |
| svbucket = apr_bucket_alloc(sizeof(*svbucket), bucket->list); |
| |
| bucket = apr_bucket_shared_make(bucket, svbucket, offset, len); |
| if (!bucket) { |
| apr_bucket_free(svbucket); |
| return NULL; |
| } |
| |
| #ifdef USE_ITHREADS |
| svbucket->perl = aTHX; |
| #endif |
| |
| /* PADTMP SVs belong to perl and can't be stored away, since perl |
| * is going to reuse them, so we have no choice but to copy the |
| * data away, before storing sv */ |
| if (SvPADTMP(sv)) { |
| STRLEN len; |
| char *pv = SvPV(sv, len); |
| svbucket->sv = newSVpvn(pv, len); |
| } |
| else { |
| svbucket->sv = sv; |
| (void)SvREFCNT_inc(svbucket->sv); |
| } |
| |
| MP_TRACE_f(MP_FUNC, "sv=0x%lx, refcnt=%d", |
| (unsigned long)svbucket->sv, SvREFCNT(svbucket->sv)); |
| |
| bucket->type = &modperl_bucket_sv_type; |
| return bucket; |
| } |
| |
| apr_bucket *modperl_bucket_sv_create(pTHX_ apr_bucket_alloc_t *list, SV *sv, |
| apr_off_t offset, apr_size_t len) |
| { |
| apr_bucket *bucket; |
| |
| bucket = apr_bucket_alloc(sizeof(*bucket), list); |
| APR_BUCKET_INIT(bucket); |
| bucket->list = list; |
| bucket->free = apr_bucket_free; |
| return modperl_bucket_sv_make(aTHX_ bucket, sv, offset, len); |
| } |
| |
| /* |
| * Local Variables: |
| * c-basic-offset: 4 |
| * indent-tabs-mode: nil |
| * End: |
| */ |