view release on metacpan or  search on metacpan

xsubs/pack.xs  view on Meta::CPAN

      }

      if(max > len)
        Zero(buffer+len, max+1-len, char);
    }

    pack = pk_create(THIS, ST(0));
    pk_set_type(pack, type);
    pk_set_buffer(pack, rv ? rv : string, buffer, mi.size);

    SvGETMAGIC(data);

    XCPT_TRY_START
    {
      pk_pack(aTHX_ pack, &mi.type, mi.pDecl, mi.level, data);
    }
    XCPT_TRY_END

    pk_delete(pack);

    XCPT_CATCH
    {
      if (rv)
        SvREFCNT_dec(rv);

      XCPT_RETHROW;
    }

    /* this makes substr() as third argument work */
    if (string)
      SvSETMAGIC(string);

    if (rv == NULL)
      XSRETURN_EMPTY;

    ST(0) = sv_2mortal(rv);
    XSRETURN(1);


################################################################################
#
#   METHOD: unpack
#
#   WRITTEN BY: Marcus Holland-Moritz             ON: Jan 2002
#   CHANGED BY:                                   ON:
#
################################################################################

void
CBC::unpack(type, string)
  const char *type
  SV *string

  PREINIT:
    CBC_METHOD(unpack);
    char *buf;
    STRLEN len;
    MemberInfo mi;
    unsigned long count;

  PPCODE:
    CT_DEBUG_METHOD1("'%s'", type);

    CHECK_VOID_CONTEXT;

    SvGETMAGIC(string);

    if ((SvFLAGS(string) & (SVf_POK|SVp_POK)) == 0)
      Perl_croak(aTHX_ "Type of arg 2 to unpack must be string");

    NEED_PARSE_DATA;

    if (!get_member_info(aTHX_ THIS, type, &mi, 0))
      Perl_croak(aTHX_ "Cannot find '%s'", type);

    if (mi.flags)
      WARN_FLAGS(type, mi.flags);

    buf = SvPV(string, len);

    if (GIMME_V == G_SCALAR)
    {
      if (mi.size > len)
        WARN((aTHX_ "Data too short"));

      count = 1;
    }
    else
      count = mi.size == 0 ? 1 : len / mi.size;

    if (count > 0)
    {
      dXCPT;
      unsigned long i;
      PackHandle pack;
      SV **sva;

      /* newHV_indexed() messes with the stack, so we cannot
       * store the return values on the stack immediately...
       */

      Newz(0, sva, count, SV *);

      pack = pk_create(THIS, ST(0));
      pk_set_buffer(pack, NULL, buf, len);

      XCPT_TRY_START
      {
        for (i = 0; i < count; i++)
        {
          pk_set_buffer_pos(pack, i*mi.size);
          sva[i] = pk_unpack(aTHX_ pack, &mi.type, mi.pDecl, mi.level);
        }

      }
      XCPT_TRY_END

      pk_delete(pack);
	      
      XCPT_CATCH
      {