/* 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.
 */

#define mp_xs_sv2_modperl_filter(sv)                                    \
    ((SvROK(sv) && (SvTYPE(SvRV(sv)) == SVt_PVMG))                      \
     || (Perl_croak(aTHX_ "argument is not a blessed reference"),0) ?   \
     modperl_filter_mg_get(aTHX_ sv) : NULL)

#define mpxs_Apache2__Filter_TIEHANDLE(stashsv, sv)      \
    modperl_newSVsv_obj(aTHX_ stashsv, sv)

#define mpxs_Apache2__Filter_PRINT mpxs_Apache2__Filter_print

static MP_INLINE apr_size_t mpxs_Apache2__Filter_print(pTHX_ I32 items,
                                                      SV **MARK, SV **SP)
{
    modperl_filter_t *modperl_filter;
    apr_size_t bytes = 0;

    mpxs_usage_va_1(modperl_filter, "$filter->print(...)");

    MP_TRACE_f(MP_FUNC, "from %s",
               ((modperl_filter_ctx_t *)modperl_filter->f->ctx)->handler->name);
    if (modperl_filter->mode == MP_OUTPUT_FILTER_MODE) {
        mpxs_write_loop(modperl_output_filter_write,
                        modperl_filter, "Apache2::Filter::print");
    }
    else {
        mpxs_write_loop(modperl_input_filter_write,
                        modperl_filter, "Apache2::Filter::print");
    }

    /* XXX: ap_rflush if $| */

    return bytes;
}

static MP_INLINE apr_size_t mpxs_Apache2__Filter_read(pTHX_ I32 items,
                                                     SV **MARK, SV **SP)
{
    modperl_filter_t *modperl_filter;
    apr_size_t wanted, len=0;
    SV *buffer;

    mpxs_usage_va_2(modperl_filter, buffer, "$filter->read(buf, [len])");

    MP_TRACE_f(MP_FUNC, "from %s",
               ((modperl_filter_ctx_t *)modperl_filter->f->ctx)->handler->name);

    if (items > 2) {
        wanted = SvIV(*MARK);
    }
    else {
        wanted = MP_IOBUFSIZE;
    }

    if (modperl_filter->mode == MP_INPUT_FILTER_MODE) {
        /* XXX: if we ever will have a need to change the read
         * discipline: (input_mode, block, readbytes) from the filter
         * we can provide an accessor method to modify the values
         * supplied by the filter chain */
        len = modperl_input_filter_read(aTHX_ modperl_filter, buffer, wanted);
    }
    else {
        len = modperl_output_filter_read(aTHX_ modperl_filter, buffer, wanted);
    }

    /* must run any set magic */
    SvSETMAGIC(buffer);

    SvTAINTED_on(buffer);

    return len;
}

static MP_INLINE U16 *modperl_filter_attributes(pTHX_ SV *package, SV *cvrv)
{
    return modperl_code_attrs(aTHX_ (CV*)SvRV(cvrv));
}

#ifdef MP_TRACE
#define trace_attr()                                                       \
    MP_TRACE_f(MP_FUNC, "applied %s attribute to %s handler", attribute, \
               HvNAME(stash))
#else
#define trace_attr()
#endif

/* we can't eval at this stage, since the package is not compiled yet,
 * we are still parsing the source.
 */
#define MODPERL_FILTER_ATTACH_ATTR_CODE(cv, string, len)        \
    {                                                           \
        char *str;                                              \
        len -= 2;           /* s/ \( | \) //x       */          \
        string++;           /* skip the opening '(' */          \
        New(0, str, len+1, char);                               \
        Copy(string, str, len+1, char);                         \
        str[len] = '\0';    /* remove the closing ')' */        \
        sv_magic(cv, Nullsv, '~', NULL, -1);                    \
        SvMAGIC(cv)->mg_ptr = str;                              \
    }


MP_STATIC XS(MPXS_modperl_filter_attributes)
{
    dXSARGS;
    U16 *attrs = modperl_filter_attributes(aTHX_ ST(0), ST(1));
    I32 i;
#ifdef MP_TRACE
    HV *stash = gv_stashsv(ST(0), TRUE);
#endif

    for (i=2; i < items; i++) {
        STRLEN len;
        char *pv = SvPV(ST(i), len);
        char *attribute = pv;

        if (strnEQ(pv, "Filter", 6)) {
            pv += 6;
        }

        switch (*pv) {
          case 'C':
            if (strEQ(pv, "ConnectionHandler")) {
                *attrs |= MP_FILTER_CONNECTION_HANDLER;
                trace_attr();
                continue;
            }
          case 'I':
            if (strEQ(pv, "InitHandler")) {
                *attrs |= MP_FILTER_INIT_HANDLER;
                trace_attr();
                continue;
            }
          case 'H':
            if (strnEQ(pv, "HasInitHandler", 14)) {
                STRLEN code_len;
                pv += 14; /* skip over the attr name */
                code_len = len - (pv - attribute);
                MODPERL_FILTER_ATTACH_ATTR_CODE(SvRV(ST(1)), pv, code_len);
                *attrs |= MP_FILTER_HAS_INIT_HANDLER;
                trace_attr();
                continue;
            }
          case 'R':
            if (strEQ(pv, "RequestHandler")) {
                *attrs |= MP_FILTER_REQUEST_HANDLER;
                trace_attr();
                continue;
            }
          default:
            /* XXX: there could be more than one attr to pass through */
            XPUSHs_mortal_pv(attribute);
            XSRETURN(1);
        }
    }

    XSRETURN_EMPTY;
}

static MP_INLINE SV *mpxs_Apache2__Filter_ctx(pTHX_
                                             ap_filter_t *filter,
                                             SV *data)
{
    modperl_filter_ctx_t *ctx = (modperl_filter_ctx_t *)(filter->ctx);

    /* XXX: is it possible that the same filter, during a single
     * request or connection cycle, will be invoked by different perl
     * interpreters? if that happens we are in trouble, if we need to
     * return an SV living in a different interpreter. may be there is
     * a way to use one of the perl internal functions to clone an SV
     * (and it can contain any references)
     */

    if (data != Nullsv) {
        if (ctx->data) {
            if (SvOK(ctx->data) && SvREFCNT(ctx->data)) {
                /* release the previously stored SV so we don't leak
                 * an SV */
                SvREFCNT_dec(ctx->data);
            }
        }

#ifdef USE_ITHREADS
        if (!ctx->perl) {
            ctx->perl = aTHX;
        }
#endif
        ctx->data = SvREFCNT_inc(data);
    }

    return ctx->data ? SvREFCNT_inc(ctx->data) : &PL_sv_undef;
}

static MP_INLINE SV *mpxs_Apache2__Filter_seen_eos(pTHX_ I32 items,
                                                  SV **MARK, SV **SP)
{
    modperl_filter_t *modperl_filter;

    if ((items < 1) || (items > 2) || !(mpxs_sv2_obj(modperl_filter, *MARK))) {
        Perl_croak(aTHX_ "usage: $filter->seen_eos([$set])");
    }
    MARK++;

    if (items == 2) {
        modperl_filter->seen_eos = SvTRUE(*MARK) ? 1 : 0;
    }

    return modperl_filter->seen_eos ? &PL_sv_yes : &PL_sv_no;
}

static MP_INLINE
void mpxs_Apache2__RequestRec_add_input_filter(pTHX_ request_rec *r,
                                              SV *callback)
{

    modperl_filter_runtime_add(aTHX_ r,
                               r->connection,
                               MP_FILTER_REQUEST_INPUT_NAME,
                               MP_INPUT_FILTER_MODE,
                               ap_add_input_filter,
                               callback,
                               "InputFilter");
}

static MP_INLINE
void mpxs_Apache2__RequestRec_add_output_filter(pTHX_ request_rec *r,
                                               SV *callback)
{

    modperl_filter_runtime_add(aTHX_ r,
                               r->connection,
                               MP_FILTER_REQUEST_OUTPUT_NAME,
                               MP_OUTPUT_FILTER_MODE,
                               ap_add_output_filter,
                               callback,
                               "OutputFilter");
}

static MP_INLINE
void mpxs_Apache2__Connection_add_input_filter(pTHX_ conn_rec *c,
                                              SV *callback)
{

    modperl_filter_runtime_add(aTHX_ NULL,
                               c,
                               MP_FILTER_CONNECTION_INPUT_NAME,
                               MP_INPUT_FILTER_MODE,
                               ap_add_input_filter,
                               callback,
                               "InputFilter");
}

static MP_INLINE
void mpxs_Apache2__Connection_add_output_filter(pTHX_ conn_rec *c,
                                               SV *callback)
{

    modperl_filter_runtime_add(aTHX_ NULL,
                               c,
                               MP_FILTER_CONNECTION_OUTPUT_NAME,
                               MP_OUTPUT_FILTER_MODE,
                               ap_add_output_filter,
                               callback,
                               "OutputFilter");
}

static MP_INLINE
void mpxs_Apache2__Filter_remove(pTHX_ I32 items, SV **MARK, SV **SP)
{
    modperl_filter_t *modperl_filter;
    ap_filter_t *f;

    if (items < 1) {
        Perl_croak(aTHX_ "usage: $filter->remove()");
    }

    modperl_filter = mp_xs_sv2_modperl_filter(*MARK);

    /* native filter */
    if (!modperl_filter) {
        f = INT2PTR(ap_filter_t *, SvIV(SvRV(*MARK)));
        MP_TRACE_f(MP_FUNC,
                   "   %s\n\n\t non-modperl filter removes itself",
                   f->frec->name);

        /* the filter can reside in only one chain. hence we try to
         * remove it from both, the input and output chains, since
         * unfortunately we can't tell what kind of filter is that and
         * whether the first call was successful
         */
        ap_remove_input_filter(f);
        ap_remove_output_filter(f);
        return;
    }

    f = modperl_filter->f;

    MP_TRACE_f(MP_FUNC, "   %s\n\n\tfilter removes itself",
               ((modperl_filter_ctx_t *)f->ctx)->handler->name);

    if (modperl_filter->mode == MP_INPUT_FILTER_MODE) {
        ap_remove_input_filter(f);
    }
    else {
        ap_remove_output_filter(f);
    }
}

static MP_INLINE
apr_status_t mpxs_Apache2__Filter_fflush(pTHX_ ap_filter_t *filter,
                                        apr_bucket_brigade *brigade)
{
    apr_status_t rc = ap_fflush(filter, brigade);
    /* if users don't bother to check the success, do it on their
     * behalf */
    if (GIMME_V == G_VOID && rc != APR_SUCCESS) {
        modperl_croak(aTHX_ rc, "Apache2::Filter::fflush");
    }

    return rc;
}

static MP_INLINE
apr_status_t mpxs_Apache2__Filter_get_brigade(pTHX_
                                             ap_filter_t *f,
                                             apr_bucket_brigade *bb,
                                             ap_input_mode_t mode,
                                             apr_read_type_e block,
                                             apr_off_t readbytes)
{
    apr_status_t rc = ap_get_brigade(f, bb, mode, block, readbytes);
    /* if users don't bother to check the success, do it on their
     * behalf */
    if (GIMME_V == G_VOID && rc != APR_SUCCESS) {
        modperl_croak(aTHX_ rc, "Apache2::Filter::get_brigade");
    }

    return rc;
}

static MP_INLINE
apr_status_t mpxs_Apache2__Filter_pass_brigade(pTHX_ ap_filter_t *f,
                                              apr_bucket_brigade *bb)
{
    apr_status_t rc = ap_pass_brigade(f, bb);
    /* if users don't bother to check the success, do it on their
     * behalf */
    if (GIMME_V == G_VOID && rc != APR_SUCCESS) {
        modperl_croak(aTHX_ rc, "Apache2::Filter::pass_brigade");
    }

    return rc;
}