Add from_tuple method

Author: Leont

CHANGES

@@ -5,7 +5,7 @@ This is not a complete list of changes.  See repository for full details:
     https://github.com/Perl/version.pm
 
   * Add to_decimal and to_dotted_decimal methods
-  * Add tuple method
+  * Add tuple and from_tuple methods
 
 0.9931
   * Fix definitions of LIKELY and UNLIKELY on older perls

lib/version.pm

@@ -31,6 +31,7 @@ our (@ISA, $STRICT, $LAX);
 	*version::to_decimal = \&version::vpp::to_decimal;
 	*version::to_dotted_decimal = \&version::vpp::to_dotted_decimal;
 	*version::tuple = \&version::vpp::tuple;
+	*version::from_tuple = \&version::vpp::from_tuple;
 	if ($] >= 5.009000) {
 	    no strict 'refs';
 	    *version::stringify = \&version::vpp::stringify;
@@ -53,6 +54,7 @@ our (@ISA, $STRICT, $LAX);
 	*version::to_decimal = \&version::vxs::to_decimal;
 	*version::to_dotted_decimal = \&version::vxs::to_dotted_decimal;
 	*version::tuple = \&version::vxs::tuple;
+	*version::from_tuple = \&version::vxs::from_tuple;
 	if ($] >= 5.009000) {
 	    no strict 'refs';
 	    *version::stringify = \&version::vxs::stringify;

lib/version.pod

@@ -289,6 +289,12 @@ This turns the components of the version into a list. E.g.
 
  version->parse('1.2.3')->tuple; # (1, 2, 3)
 
+=head2 from_tuple(...)
+
+This takes a list of components and creates a dotted decimal version out of it. E.g.
+
+ version->from_tuple(1, 2, 3) # v1.2.3
+
 =head2 stringify()
 
 Returns a string that is as close to the original representation as possible.

t/coretests.pm

@@ -51,6 +51,7 @@ sub BaseTests {
 
     my $version = $CLASS->$method("v1.2.3.4");
     is_deeply ([ $version->tuple ], [1, 2, 3, 4], 'Tuple seems to work');
+    is_deeply ($version, $CLASS->from_tuple(1, 2, 3, 4), 'Equals from_tuple');
 
     # test illegal formats
     eval {my $version = $CLASS->$method("1.2_3_4")};

vperl/vpp.pm

@@ -880,6 +880,19 @@ sub tuple {
     return @{ $self->{version} };
 }
 
+sub from_tuple {
+    my ($proto, @args) = @_;
+    my $class = ref($proto) || $proto;
+
+    my @version = map 0+$_, @args;
+    die if @args < 1;
+    return bless {
+	version => \@version,
+	qv => !!1,
+	'v' . join('.', @version),
+    }, $class;
+}
+
 sub _verify {
     my ($self) = @_;
     if ( ref($self)

vutil/vxs.inc

@@ -73,6 +73,7 @@
     {VXS_CLASS "::declare", VXSp(version_qv), VXSXSDP(NULL)},
     {VXS_CLASS "::is_qv", VXSp(version_is_qv), VXSXSDP(NULL)},
     {VXS_CLASS "::tuple", VXSp(version_tuple), VXSXSDP(NULL)},
+    {VXS_CLASS "::from_tuple", VXSp(version_from_tuple), VXSXSDP(NULL)},
 #else
 
 #ifndef dVAR
@@ -509,4 +510,38 @@ VXS(version_tuple)
      }
 }
 
+VXS(version_from_tuple)
+{
+    dXSARGS;
+    SV *lobj;
+    int i;
+    if (items < 2)
+	croak_xs_usage(cv, "lobj, ...");
+    lobj = ST(0);
+    SP -= items;
+
+    AV* versions = newAV();
+    SV* original = newSVpvs("v");
+
+    for (i = 1; i < items; ++i) {
+	if (SvIV(ST(i)) < 0)
+	    Perl_croak(aTHX_ "Value %d in version is negative", SvIV(ST(i)));
+	UV value = SvUV(ST(i));
+	av_push(versions, newSVuv(value));
+	if (i != 1)
+	    sv_catpvs(original, ".");
+	sv_catpvf(original, "%" UVuf, value);
+    }
+
+    HV* hash = newHV();
+    (void)hv_stores(hash, "version", newRV_noinc(MUTABLE_SV(versions)));
+    (void)hv_stores(hash, "original", original);
+    (void)hv_stores(hash, "qv", newSVsv(&PL_sv_yes));
+
+    HV* stash = SvROK(lobj) ? SvSTASH(lobj) : gv_stashsv(lobj, GV_ADD);
+    SV* result = sv_bless(newRV_noinc(MUTABLE_SV(hash)), stash);
+    XPUSHs(result);
+    PUTBACK;
+}
+
 #endif