view release on metacpan or  search on metacpan

XS.xs  view on Meta::CPAN

    const_iv (ASN_UTF8_STRING)
    const_iv (ASN_RELATIVE_OID)
    const_iv (ASN_SET)
    const_iv (ASN_NUMERIC_STRING)
    const_iv (ASN_PRINTABLE_STRING)
    const_iv (ASN_TELETEX_STRING)
    const_iv (ASN_T61_STRING)
    const_iv (ASN_VIDEOTEX_STRING)
    const_iv (ASN_IA5_STRING)
    const_iv (ASN_ASCII_STRING)
    const_iv (ASN_UTC_TIME)
    const_iv (ASN_GENERALIZED_TIME)
    const_iv (ASN_GRAPHIC_STRING)
    const_iv (ASN_VISIBLE_STRING)
    const_iv (ASN_ISO646_STRING)
    const_iv (ASN_GENERAL_STRING)
    const_iv (ASN_UNIVERSAL_STRING)
    const_iv (ASN_CHARACTER_STRING)
    const_iv (ASN_BMP_STRING)

    const_iv (ASN_UNIVERSAL)
    const_iv (ASN_APPLICATION)
    const_iv (ASN_CONTEXT)
    const_iv (ASN_PRIVATE)

    const_iv (BER_CLASS)
    const_iv (BER_TAG)
    const_iv (BER_FLAGS)
    const_iv (BER_DATA)

    const_iv (BER_TYPE_BYTES)
    const_iv (BER_TYPE_UTF8)
    const_iv (BER_TYPE_UCS2)
    const_iv (BER_TYPE_UCS4)
    const_iv (BER_TYPE_INT)
    const_iv (BER_TYPE_OID)
    const_iv (BER_TYPE_RELOID)
    const_iv (BER_TYPE_NULL)
    const_iv (BER_TYPE_BOOL)
    const_iv (BER_TYPE_REAL)
    const_iv (BER_TYPE_IPADDRESS)
    const_iv (BER_TYPE_CROAK)

    const_iv (SNMP_IPADDRESS)
    const_iv (SNMP_COUNTER32)
    const_iv (SNMP_GAUGE32)
    const_iv (SNMP_UNSIGNED32)
    const_iv (SNMP_TIMETICKS)
    const_iv (SNMP_OPAQUE)
    const_iv (SNMP_COUNTER64)
  };

  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;

        EXTEND (SP, 2);
        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;

        SvCUR_set (buf_sv, cur - buf);
        XPUSHs (buf_sv);
}

SV *
ber_int (SV *sv)
	CODE:
{
	AV *av = newAV ();
        av_fill (av, BER_ARRAYSIZE - 1);
        AvARRAY (av)[BER_CLASS] = newSVcacheint (ASN_UNIVERSAL);
        AvARRAY (av)[BER_TAG  ] = newSVcacheint (ASN_INTEGER);
        AvARRAY (av)[BER_FLAGS] = newSVcacheint (0);
        AvARRAY (av)[BER_DATA ] = newSVsv (sv);
        RETVAL = newRV_noinc ((SV *)av);
}
	OUTPUT: RETVAL

# TODO: not arrayref, but elements?
SV *
ber_seq (SV *arrayref)
	CODE:
{
	AV *av = newAV ();
        av_fill (av, BER_ARRAYSIZE - 1);
        AvARRAY (av)[BER_CLASS] = newSVcacheint (ASN_UNIVERSAL);
        AvARRAY (av)[BER_TAG  ] = newSVcacheint (ASN_SEQUENCE);
        AvARRAY (av)[BER_FLAGS] = newSVcacheint (1);
        AvARRAY (av)[BER_DATA ] = newSVsv (arrayref);
        RETVAL = newRV_noinc ((SV *)av);
}
	OUTPUT: RETVAL

MODULE = Convert::BER::XS		PACKAGE = Convert::BER::XS::Profile

SV *
new (SV *klass)
	CODE:
        RETVAL = profile_new ();
        OUTPUT: RETVAL

void
set (SV *profile, int klass, int tag, int type)
	CODE:
        profile_set (SvPROFILE (profile), klass, tag, type);

IV
get (SV *profile, int klass, int tag)
	CODE:
        RETVAL = profile_lookup (SvPROFILE (profile), klass, tag);