diff options
author | Father Chrysostomos <sprout@cpan.org> | 2013-09-11 12:51:44 -0700 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2014-01-04 05:10:03 -0800 |
commit | e1c774b63b5d338bcd31ca90bfd101f387e4fb43 (patch) | |
tree | 7596ec30217938c02ac9084b94f3f7249a177ef6 /vxs.inc | |
parent | 11e14f5aadedb74e66c75f3baa44e4eb93dcf1c1 (diff) | |
download | perl-e1c774b63b5d338bcd31ca90bfd101f387e4fb43.tar.gz |
vxs.inc: Integrate the CPAN version of version_new
No behaviour changes; just rearranged, and with a few extra #ifdefs.
Diffstat (limited to 'vxs.inc')
-rw-r--r-- | vxs.inc | 86 |
1 files changed, 48 insertions, 38 deletions
@@ -169,49 +169,59 @@ XS(XS_version_new) { dVAR; dXSARGS; - if (items > 3 || items < 1) - croak_xs_usage(cv, "class, version"); + PERL_UNUSED_VAR(cv); + SV *vs = items ? ST(1) : &PL_sv_undef; + SV *rv; + const char * classname = ""; + STRLEN len; + U32 flags = 0; SP -= items; - { - SV *vs = ST(1); - SV *rv; - STRLEN len; - const char *classname; - U32 flags; - - /* Just in case this is something like a tied hash */ - SvGETMAGIC(vs); - - if ( sv_isobject(ST(0)) ) { /* get the class if called as an object method */ - const HV * stash = SvSTASH(SvRV(ST(0))); - classname = HvNAME(stash); - len = HvNAMELEN(stash); - flags = HvNAMEUTF8(stash) ? SVf_UTF8 : 0; - } - else { - classname = SvPV(ST(0), len); - flags = SvUTF8(ST(0)); - } - if ( items == 1 || ! SvOK(vs) ) { /* no param or explicit undef */ - /* create empty object */ - vs = sv_newmortal(); - sv_setpvs(vs, "0"); - } - else if ( items == 3 ) { - vs = sv_newmortal(); - Perl_sv_setpvf(aTHX_ vs,"v%s",SvPV_nolen_const(ST(2))); - } + if (items > 3 || items == 0) + Perl_croak(aTHX_ "Usage: version::new(class, version)"); - rv = new_version(vs); - if ( len != 7 - || strnNE(classname,"version", len) ) /* inherited new() */ - sv_bless(rv, gv_stashpvn(classname, len, GV_ADD | flags)); + /* Just in case this is something like a tied hash */ + SvGETMAGIC(vs); - mPUSHs(rv); - PUTBACK; - return; + if ( items == 1 || ! SvOK(vs) ) { /* no param or explicit undef */ + /* create empty object */ + vs = sv_newmortal(); + sv_setpvs(vs,"undef"); + } + else if (items == 3 ) { + vs = sv_newmortal(); +#if PERL_VERSION == 5 + sv_setpvf(vs,"v%s",SvPV_nolen_const(ST(2))); +#else + Perl_sv_setpvf(aTHX_ vs,"v%s",SvPV_nolen_const(ST(2))); +#endif } + if ( sv_isobject(ST(0)) ) { + /* get the class if called as an object method */ + const HV * stash = SvSTASH(SvRV(ST(0))); + classname = HvNAME_get(stash); + len = HvNAMELEN_get(stash); +#ifdef HvNAMEUTF8 + flags = HvNAMEUTF8(stash) ? SVf_UTF8 : 0; +#endif + } + else { + classname = SvPV(ST(0), len); + flags = SvUTF8(ST(0)); + } + + rv = NEW_VERSION(vs); + if ( len != sizeof(VXS_CLASS)-1 + || strcmp(classname,VXS_CLASS) != 0 ) /* inherited new() */ +#if PERL_VERSION == 5 + sv_bless(rv, gv_stashpv((char *)classname, GV_ADD)); +#else + sv_bless(rv, gv_stashpvn(classname, len, GV_ADD | flags)); +#endif + + mPUSHs(rv); + PUTBACK; + return; } XS(XS_version_stringify) |