view release on metacpan or  search on metacpan

XS.xs  view on Meta::CPAN

  };

  for (civ = const_iv + sizeof (const_iv) / sizeof (const_iv [0]); civ > const_iv; civ--)
    newCONSTSUB (stash, (char *)civ[-1].name, newSViv (civ[-1].iv));
}

void
ber_decode (SV *ber, SV *profile = &PL_sv_undef)
	ALIAS:
        ber_decode_prefix = 1
	PPCODE:
{
        cur_profile = SvPROFILE (profile);
	STRLEN len;
        buf = (U8 *)SvPVbyte (ber, len);
        cur = buf;
        end = buf + len;

        PUTBACK;
        SV *tuple = decode_ber ();
        SPAGAIN;

XS.xs  view on Meta::CPAN

        PUSHs (sv_2mortal (tuple));

        if (ix)
          PUSHs (sv_2mortal (newSViv (cur - buf)));
        else if (cur != end)
          error ("trailing garbage after BER value");
}

void
ber_is (SV *tuple, SV *klass = &PL_sv_undef, SV *tag = &PL_sv_undef, SV *flags = &PL_sv_undef, SV *data = &PL_sv_undef)
	PPCODE:
{
	if (!SvOK (tuple))
          XSRETURN_NO;

        if (!SvROK (tuple) || SvTYPE (SvRV (tuple)) != SVt_PVAV)
          croak ("ber_is: tuple must be BER tuple (array-ref)");

        AV *av = (AV *)SvRV (tuple);

        XPUSHs (
             (!SvOK (klass) || SvIV  (AvARRAY (av)[BER_CLASS]) == SvIV (klass))
          && (!SvOK (tag)   || SvIV  (AvARRAY (av)[BER_TAG  ]) == SvIV (tag))
          && (!SvOK (flags) || !SvIV (AvARRAY (av)[BER_FLAGS]) == !SvIV (flags))
          && (!SvOK (data)  || sv_eq (AvARRAY (av)[BER_DATA ], data))
          ? &PL_sv_yes : &PL_sv_undef);
}

void
ber_is_seq (SV *tuple)
	PPCODE:
{
	if (!SvOK (tuple))
          XSRETURN_UNDEF;

        AV *av = ber_tuple (tuple);

        XPUSHs (
             SvIV (AvARRAY (av)[BER_CLASS]) == ASN_UNIVERSAL
          && SvIV (AvARRAY (av)[BER_TAG  ]) == ASN_SEQUENCE
          && SvIV (AvARRAY (av)[BER_FLAGS])
          ? AvARRAY (av)[BER_DATA] : &PL_sv_undef);
}

void
ber_is_int (SV *tuple, SV *value = &PL_sv_undef)
	PPCODE:
{
	if (!SvOK (tuple))
          XSRETURN_NO;

        AV *av = ber_tuple (tuple);

        UV data = SvUV (AvARRAY (av)[BER_DATA]);

        XPUSHs (
               SvIV (AvARRAY (av)[BER_CLASS]) == ASN_UNIVERSAL
          &&   SvIV (AvARRAY (av)[BER_TAG  ]) == ASN_INTEGER
          &&  !SvIV (AvARRAY (av)[BER_FLAGS])
          &&  (!SvOK (value) || data == SvUV (value))
          ? sv_2mortal (data ? newSVsv (AvARRAY (av)[BER_DATA]) : newSVpv ("0 but true", 0))
          : &PL_sv_undef);
}

void
ber_is_oid (SV *tuple, SV *oid = &PL_sv_undef)
	PPCODE:
{
	if (!SvOK (tuple))
          XSRETURN_NO;

        AV *av = ber_tuple (tuple);

        XPUSHs (
              SvIV (AvARRAY (av)[BER_CLASS]) == ASN_UNIVERSAL
          &&  SvIV (AvARRAY (av)[BER_TAG  ]) == ASN_OBJECT_IDENTIFIER
          && !SvIV (AvARRAY (av)[BER_FLAGS])
          && (!SvOK (oid) || sv_eq (AvARRAY (av)[BER_DATA], oid))
          ? newSVsv (AvARRAY (av)[BER_DATA]) : &PL_sv_undef);
}

#############################################################################

void
ber_encode (SV *tuple, SV *profile = &PL_sv_undef)
	PPCODE:
{
        cur_profile = SvPROFILE (profile);
	buf_sv = sv_2mortal (NEWSV (0, 256));
        SvPOK_only (buf_sv);
        set_buf (buf_sv);

        PUTBACK;
        encode_ber (tuple);
        SPAGAIN;