summaryrefslogtreecommitdiff
path: root/vxs.inc
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2013-09-11 12:51:44 -0700
committerFather Chrysostomos <sprout@cpan.org>2014-01-04 05:10:03 -0800
commite1c774b63b5d338bcd31ca90bfd101f387e4fb43 (patch)
tree7596ec30217938c02ac9084b94f3f7249a177ef6 /vxs.inc
parent11e14f5aadedb74e66c75f3baa44e4eb93dcf1c1 (diff)
downloadperl-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.inc86
1 files changed, 48 insertions, 38 deletions
diff --git a/vxs.inc b/vxs.inc
index 3217670252..56b8902287 100644
--- a/vxs.inc
+++ b/vxs.inc
@@ -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)