XS(XS_version_new);
XS(XS_version_stringify);
XS(XS_version_numify);
+XS(XS_version_normal);
XS(XS_version_vcmp);
XS(XS_version_boolean);
#ifdef HASATTRIBUTE_NORETURN
newXS("version::stringify", XS_version_stringify, file);
newXS("version::(0+", XS_version_numify, file);
newXS("version::numify", XS_version_numify, file);
+ newXS("version::normal", XS_version_normal, file);
newXS("version::(cmp", XS_version_vcmp, file);
newXS("version::(<=>", XS_version_vcmp, file);
newXS("version::vcmp", XS_version_vcmp, file);
dXSARGS;
SV *sv;
const char *name;
- STRLEN n_a;
if (items != 2)
Perl_croak(aTHX_ "Usage: UNIVERSAL::isa(reference, kind)");
|| (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv))))
XSRETURN_UNDEF;
- name = SvPV_const(ST(1),n_a);
+ name = SvPV_nolen_const(ST(1));
ST(0) = boolSV(sv_derived_from(sv, name));
XSRETURN(1);
const char *name;
SV *rv;
HV *pkg = NULL;
- STRLEN n_a;
if (items != 2)
Perl_croak(aTHX_ "Usage: UNIVERSAL::can(object-ref, method)");
|| (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv))))
XSRETURN_UNDEF;
- name = SvPV_const(ST(1),n_a);
+ name = SvPV_nolen_const(ST(1));
rv = &PL_sv_undef;
if (SvROK(sv)) {
"%s does not define $%s::VERSION--version check failed",
name, name);
} else {
- STRLEN n_a;
Perl_croak(aTHX_
"%s defines neither package nor VERSION--version check failed",
- SvPVx(ST(0),n_a) );
+ SvPVx_nolen_const(ST(0)) );
}
}
Perl_croak(aTHX_ "Usage: version::new(class, version)");
SP -= items;
{
- const char *classname = SvPV_nolen(ST(0));
SV *vs = ST(1);
SV *rv;
- if (items == 3 )
- {
- vs = sv_newmortal();
- Perl_sv_setpvf(aTHX_ vs,"v%s",SvPV_nolen(ST(2)));
+ const char *classname;
+
+ /* get the class if called as an object method */
+ if ( sv_isobject(ST(0)) ) {
+ classname = HvNAME(SvSTASH(SvRV(ST(0))));
+ }
+ else {
+ classname = (char *)SvPV_nolen(ST(0));
+ }
+
+ if ( items == 1 ) {
+ /* no parameter provided */
+ if ( sv_isobject(ST(0)) ) {
+ /* copy existing object */
+ vs = ST(0);
+ }
+ else {
+ /* create empty object */
+ vs = sv_newmortal();
+ sv_setpv(vs,"");
+ }
+ }
+ else if ( items == 3 ) {
+ vs = sv_newmortal();
+ Perl_sv_setpvf(aTHX_ vs,"v%s",SvPV_nolen_const(ST(2)));
}
rv = new_version(vs);
SV * lobj = Nullsv;
if (sv_derived_from(ST(0), "version")) {
- SV *tmp = SvRV(ST(0));
- lobj = tmp;
+ lobj = SvRV(ST(0));
}
else
Perl_croak(aTHX_ "lobj is not of type version");
SV * lobj = Nullsv;
if (sv_derived_from(ST(0), "version")) {
- SV *tmp = SvRV(ST(0));
- lobj = tmp;
+ lobj = SvRV(ST(0));
}
else
Perl_croak(aTHX_ "lobj is not of type version");
}
}
+XS(XS_version_normal)
+{
+ dXSARGS;
+ if (items < 1)
+ Perl_croak(aTHX_ "Usage: version::normal(lobj, ...)");
+ SP -= items;
+ {
+ SV * lobj = Nullsv;
+
+ if (sv_derived_from(ST(0), "version")) {
+ lobj = SvRV(ST(0));
+ }
+ else
+ Perl_croak(aTHX_ "lobj is not of type version");
+
+ PUSHs(sv_2mortal(vnormal(lobj)));
+
+ PUTBACK;
+ return;
+ }
+}
+
XS(XS_version_vcmp)
{
dXSARGS;
SV * lobj = Nullsv;
if (sv_derived_from(ST(0), "version")) {
- SV *tmp = SvRV(ST(0));
- lobj = tmp;
+ lobj = SvRV(ST(0));
}
else
Perl_croak(aTHX_ "lobj is not of type version");
SV * lobj = Nullsv;
if (sv_derived_from(ST(0), "version")) {
- /* XXX If tmp serves a purpose, explain it. */
- SV *tmp = SvRV(ST(0));
- lobj = tmp;
+ lobj = SvRV(ST(0));
}
else
Perl_croak(aTHX_ "lobj is not of type version");
{
SV * lobj = Nullsv;
- if (sv_derived_from(ST(0), "version")) {
- /* XXX If tmp serves a purpose, explain it. */
- SV *tmp = SvRV(ST(0));
- lobj = tmp;
- }
+ if (sv_derived_from(ST(0), "version"))
+ lobj = ST(0);
else
Perl_croak(aTHX_ "lobj is not of type version");
{
- const I32 len = av_len((AV *)lobj);
- const I32 digit = SvIVX(*av_fetch((AV *)lobj, len, 0));
- if ( digit < 0 )
+ if ( hv_exists((HV*)SvRV(lobj), "alpha", 5 ) )
XSRETURN_YES;
else
XSRETURN_NO;