view release on metacpan or  search on metacpan

XSHeaders.xs  view on Meta::CPAN

    /* create the initial list */
    for (j = 1; j <= argc; ) {
      pkey = ST(j++);

      /* did we reach the end by any chance? */
      if (j > argc) {
        break;
      }

      pval = ST(j++);
      ckey = SvPV_nolen(pkey);
      GLOG(("=X= Will set [%s] to [%s]", ckey, SvPV_nolen(pval)));
      set_value(aTHX_ hl, ckey, pval);
    }
    XSRETURN(1);


void
clone(HList* hl)
  PREINIT:
    HList* clone;
    int    j;
    int    k;
  CODE:
    GLOG(("=X= @@@ clone(%p|%d)", hl, hlist_size(hl)));

    if (!(clone = hlist_clone(hl)))
      croak("Could not clone HList object");

    ST(0) = newSV_HList(clone, SvSTASH(SvRV(ST(0))));

    /* Clone the SVs into new ones */
    for (j = 0; j < clone->ulen; ++j) {
      HNode* hnode = &clone->data[j];
      PList* plist = hnode->values;
      for (k = 0; k < plist->ulen; ++k) {
        PNode* pnode = &plist->data[k];
        pnode->ptr = newSVsv( (SV*)pnode->ptr );
      }
    }

    XSRETURN(1);


#
# Clear object, leaving it as freshly created.
#
void
clear(HList* hl, ...)
  CODE:
    GLOG(("=X= @@@ clear(%p|%d)", hl, hlist_size(hl)));
    hlist_clear(hl);


#
# Get all the keys in an existing HList.
#
void
header_field_names(HList* hl)
  PPCODE:
    GLOG(("=X= @@@ header_field_names(%p|%d), want %d",
          hl, hlist_size(hl), GIMME_V));
    hlist_sort(hl);
    PUTBACK;
    return_hlist(aTHX_ hl, "header_field_names", GIMME_V);
    SPAGAIN;


#
# init_header
#
void
init_header(HList* hl, ...)
  PREINIT:
    int    argc = 0;
    SV*    pkey;
    SV*    pval;
    STRLEN len;
    char*  ckey;

  CODE:
    GLOG(("=X= @@@ init_header(%p|%d), %d params, want %d",
          hl, hlist_size(hl), argc, GIMME_V));
    argc = items - 1;
    if (argc != 2) {
      croak("init_header needs two arguments");
    }

    /* TODO: apply this check everywhere! */
    pkey = ST(1);
    if (!SvOK(pkey) || !SvPOK(pkey)) {
      croak("init_header not called with a first string argument");
    }
    ckey = SvPV(pkey, len);
    pval = ST(2);

    if (!hlist_get(hl, ckey)) {
      set_value(aTHX_ hl, ckey, pval);
    }

#
# push_header
#
void
push_header(HList* hl, ...)
  PREINIT:
    int    argc = 0;
    int    j;
    SV*    pkey;
    SV*    pval;
    STRLEN len;
    char*  ckey;

  CODE:
    GLOG(("=X= @@@ push_header(%p|%d), %d params, want %d",
          hl, hlist_size(hl), argc, GIMME_V));

    argc = items - 1;
    if (argc % 2 != 0) {
      croak("push_header needs an even number of arguments");
    }

    for (j = 1; j <= argc; ) {
        if (j > argc) {
          break;
        }
        pkey = ST(j++);

        if (j > argc) {
          break;
        }
        pval = ST(j++);

        ckey = SvPV(pkey, len);
        set_value(aTHX_ hl, ckey, pval);
    }


#
# header
#
void
header(HList* hl, ...)
  PREINIT:
    int    argc = 0;
    int    j;
    SV*    pkey = 0;
    SV*    pval = 0;
    STRLEN len;
    char*  ckey = 0;
    HNode* n = 0;
    HList* seen = 0; /* TODO: make this more efficient; use Perl hash? */

  PPCODE:
    GLOG(("=X= @@@ header(%p|%d), %d params, want %d",
          hl, hlist_size(hl), argc, GIMME_V));

    argc = items - 1;
    do {
      if (argc == 0) {
        croak("header called with no arguments");
      }

      if (argc == 1) {
        pkey = ST(1);
        ckey = SvPV(pkey, len);
        n = hlist_get(hl, ckey);
        if (n && plist_size(n->values) > 0) {
          PUTBACK;
          return_plist(aTHX_ n->values, "header1", GIMME_V);
          SPAGAIN;
        }
        break;
      }

      if (argc % 2 != 0) {
        croak("init_header needs one or an even number of arguments");
      }

      seen = hlist_create();
      for (j = 1; j <= argc; ) {
          if (j > argc) {
            break;
          }
          pkey = ST(j++);

          if (j > argc) {
            break;
          }
          pval = ST(j++);

          ckey = SvPV(pkey, len);
          int clear = 0;
          if (! hlist_get(seen, ckey)) {
            clear = 1;
            hlist_add(seen, ckey, 0);
          }

          n = hlist_get(hl, ckey);
          if (n) {
            if (j > argc && plist_size(n->values) > 0) {
              /* Last value, return its current contents */
              PUTBACK;
              return_plist(aTHX_ n->values, "header2", GIMME_V);
              SPAGAIN;
            }
            if (clear) {
              plist_clear(n->values);
            }
          }

          set_value(aTHX_ hl, ckey, pval);
      }
      hlist_destroy(seen);
      break;
    } while (0);


#
# _header
#
# Yes, this is an internal function, but it is used by some modules!
# So far, I am aware of HTTP::Cookies as one of the culprits.
# Luckily, they only use it with a single arg, which will be the
# ONLY usecase supported, at least for now.
#
void
_header(HList* hl, ...)
  PREINIT:
    int    argc = 0;
    SV*    pkey = 0;
    STRLEN len;
    char*  ckey = 0;
    HNode* n = 0;

  PPCODE:
    GLOG(("=X= @@@ header(%p|%d), %d params, want %d",
          hl, hlist_size(hl), argc, GIMME_V));

    argc = items - 1;
    if (argc != 1) {
      croak("_header not called with one argument");
    }

    pkey = ST(1);
    if (!SvOK(pkey) || !SvPOK(pkey)) {
      croak("_header not called with one string argument");
    }
    ckey = SvPV(pkey, len);
    n = hlist_get(hl, ckey);
    if (n && plist_size(n->values) > 0) {
      PUTBACK;
      return_plist(aTHX_ n->values, "_header", GIMME_V);
      SPAGAIN;
    }


#
# remove_header
#
void
remove_header(HList* hl, ...)
  PREINIT:
    int    argc = 0;
    int    j;
    SV*    pkey;
    STRLEN len;
    char*  ckey;
    int    size = 0;
    int    total = 0;

  PPCODE:
    GLOG(("=X= @@@ remove_header(%p|%d), %d params, want %d",
          hl, hlist_size(hl), argc, GIMME_V));

    argc = items - 1;
    for (j = 1; j <= argc; ++j) {
      pkey = ST(j);
      ckey = SvPV(pkey, len);

      HNode* n = hlist_get(hl, ckey);
      if (!n) {
        continue;
      }

      size = plist_size(n->values);
      if (size > 0) {
        total += size;
        if (GIMME_V == G_ARRAY) {
          PUTBACK;
          return_plist(aTHX_ n->values, "remove_header", G_ARRAY);
          SPAGAIN;
        }
      }

      hlist_del(hl, ckey);
      GLOG(("=X= remove_header: deleted key [%s]", ckey));
    }

    if (GIMME_V == G_SCALAR) {
      GLOG(("=X= remove_header: returning count %d", total));
      EXTEND(SP, 1);
      PUSHs(sv_2mortal(newSViv(total)));
    }


#
# remove_content_headers
#
void
remove_content_headers(HList* hl, ...)
  PREINIT:
    HList* to = 0;
    HNode* n = 0;
    int    j;

  CODE:
    GLOG(("=X= @@@ remove_content_headers(%p|%d)",
          hl, hlist_size(hl)));

    if (!(to = hlist_create()))
      croak("Could not create new HList object");

    ST(0) = newSV_HList(to, SvSTASH(SvRV(ST(0))));

    for (j = 0; j < hl->ulen; ) {
      n = &hl->data[j];
      if (! header_is_entity(n->header)) {
        ++j;
        continue;
      }
      hlist_transfer_header(hl, j, to);