? genini.cvs.diff
Index: genini
===================================================================
RCS file: /cvs/cygwin-apps/genini/genini,v
retrieving revision 1.16
diff -u -p -r1.16 genini
--- genini	23 Jun 2015 17:50:00 -0000	1.16
+++ genini	18 Aug 2015 18:25:03 -0000
@@ -9,7 +9,7 @@ use File::Basename;
 use Digest::MD5;
 use Digest::SHA;
 use Getopt::Long;
-
+use version 0.77 qw( is_lax );
 use strict;
 
 sub mywarn(@);
@@ -23,6 +23,8 @@ my $arch = 'x86';
 my $digest = 'sha512';
 my $release;
 my @cmp_fmts = qw(xz bz2 lzma gz);
+my $cmp_fmts_grep = join('|', @cmp_fmts);
+my $cmp_fmts_glob = join(',', @cmp_fmts);
 
 GetOptions('okmissing=s'=>\@okmissing,
 	   'output=s'=>\$outfile,
@@ -33,6 +35,81 @@ GetOptions('okmissing=s'=>\@okmissing,
 	   'recursive'=>\$recursive) or usage;
 $help and usage;
 
+my %vercmp;
+%vercmp = (
+    naturally => sub { # mostly from Sort::Naturally
+	my @A = (parsever($a) =~ /([-.]|\d+|[^-.\d]+)/g);
+	my @B = (parsever($b) =~ /([-.]|\d+|[^-.\d]+)/g);
+	my ($A, $B);
+	my ($Adash, $Bdash, $Adot, $Bdot);
+	while (@A and @B) {
+	    $A = shift @A; $B = shift @B;
+	    ($Adash, $Bdash, $Adot, $Bdot) =
+		($A eq '-', $B eq '-', $A eq '.', $B eq '.');
+	    if ($Adash and $Bdash) {
+		next;
+	    } elsif ( $Adash ) {
+		return -1;
+	    } elsif ( $Bdash) {
+		return 1;
+	    } elsif ($Adot and $Bdot) {
+		next;
+	    } elsif ( $Adot ) {
+		return -1;
+	    } elsif ( $Bdot ) {
+		return 1;
+	    } elsif ($A =~ /\A\d+\Z/ and $B =~ /\A\d+\Z/) {
+		my $ab;
+		if ($A =~ /^0/ || $B =~ /^0/) {
+		    $ab = $A cmp $B;
+		} else {
+		    $ab = $A <=> $B;
+		}
+		return $ab if $ab;
+	    } else {
+		$A = uc $A;
+		$B = uc $B;
+		my $ab = $A cmp $B;
+		return $ab if $ab;
+	    }
+	}
+	# all components have compared equal so far, the array with
+	# the larger number of entries wins (at least one is empty)
+	my $ab = @A <=> @B;
+	# however, if it was a pre-release version of some sort, then
+	# it should order before the final
+	$A = ($ab > 0 ) ? shift @A : shift @B;
+	my $Adashdot = ( $A =~ m/-./ );
+	$A = ($ab > 0 ) ? shift @A : shift @B if $Adashdot;
+	my $Arc = ( $A =~ m/\A(pre|rc|alpha|beta|b\d+)/i );
+	return $Arc ? -$ab : $ab;
+    },
+    natural => sub {
+	my (undef, $av, $ar) = parsever($a);
+	my (undef, $bv, $br) = parsever($b);
+	map {
+	    # ISO date most likely
+	    s/g(?:it)?((?:19|20)[0-9]{2}(?:0[1-9]|1[012])(?:0[1-9]|[12][0-9]|3[01]))/\1/ig;
+	    # SHA1 not orderable
+	    s/g(?:it)?[0-9a-f]+/git/ig;
+	    s/[+~_]+/./g;
+	} ( \$av, \$bv );
+	return $vercmp{naturally}($av, $bv) ||
+	    $vercmp{naturally}($ar, $br);
+    },
+    perl => sub {
+	my (undef, $av, $ar) = parsever($a);
+	my (undef, $bv, $br) = parsever($b);
+	return (is_lax($av) && is_lax($bv)
+		? (version->parse($av) <=> version->parse($bv))
+		: $vercmp{natural}($av, $bv)) ||
+	    $vercmp{natural}($ar, $br);
+    },
+    lexical => sub {
+	$a cmp $b;
+    },
+    );
+
 @main::okmissing{@okmissing} = @okmissing;
 
 sub arch_handler (@) {
@@ -81,7 +158,8 @@ for my $p (sort keys %pkg) {
     print "\n@ $p\n";
     for my $key ('sdesc', 'ldesc', 'category', 'requires', 'message') {
 	my $val = $pkg{$p}{''}{$key};
-	if (!defined($val) && $pkg{$p}{''}{'install'} !~ /_obsolete/o) {
+	my $pobsolete = ( $pkg{$p}{''}{'install'} =~ m:/_obsolete/:o );
+	if (!defined($val) && !$pobsolete) {
 	    mywarn "package $p is missing a $key field"
 	      unless defined $main::okmissing{$key};
 	} else {
@@ -128,7 +206,7 @@ sub get {
 	    s/(\S)\s+$/$1/;
 	    $val .= "\n" . $_;
 	}
-    } 
+    }
     $val =~ s/(.)"(.)/$1'$2/mog;
     return $val;
 }
@@ -206,26 +284,30 @@ sub parsedir {
     return unless -e $setup_hint;
     parse("$setup_hint", $pname);
     next unless exists $pkg{$pname};
+    my $pobsolete = ( $d =~ m:/_obsolete/:o );
     my $explicit = 0;
     for my $what ('', "[prev]\n", "[test]\n") {
 	my $x = $pkg{$pname}{$what};
+	$x->{'obsolete'} = $pobsolete;
 	next unless $x->{'version'};
 	$explicit = 1;
 	addfiles($pname, $x, $d);
     }
-
     return if $explicit;
-    my $cmp_fmts_grep = join('|', @cmp_fmts);
-    my $cmp_fmts_glob = join(',', @cmp_fmts);
-    my @files = sort grep{!/-src\.tar\.($cmp_fmts_grep)/} glob("$d/*.tar.{$cmp_fmts_glob}");
+    $pkg{$pname}{''}{'version-order'} //= ($pname =~ m(\Aperl(?:[_-].+)?\Z)) ? "perl" : "natural";
+    my $vercmp = $vercmp{$pkg{$pname}{''}{'version-order'}} //
+	( myerror("unknown version ordering requested by package '$pname'"), $vercmp{'natural'} );
+    my @files = sort $vercmp grep{!/-src\.tar\.($cmp_fmts_grep)/} glob("$d/*.tar.{$cmp_fmts_glob}");
     if (!@files) {
-	myerror "not enough package files in $d";
+	@files = glob("$d/*-src.tar.{$cmp_fmts_glob}"); # source-only package?
+	myerror "not enough package files in $d" unless @files;
 	return;
     }
     for my $what ('', "[prev]\n") {
 	my $f = pop @files or last;
 	$pkg{$pname}{$what}{-unused} = 1;
 	my $x = $pkg{$pname}{$what};
+	$x->{'obsolete'} = $pobsolete;
 	my $p;
 	($p, $x->{'version'}) = getver($f);
 	addfiles($p, $x, $d);
@@ -244,14 +326,20 @@ sub addfiles {
 	$d = finddir($d, $pname) or return;
     }
 
-    my $source  = tarball($d, $pname, $x->{'version'}, 'src');
+    my $source = tarball($d, $pname, $x->{'version'}, 'src');
     filer($x, 'source', $source);
 }
 
 sub getver {
-    my $f = basename($_[0]);
-    my @a = ($f =~ /^(.*?)-(\d.*)\.tar/);
-    return wantarray ? @a : $a[1];
+    my $fn = basename shift;
+    my ($pn, $vr) = ($fn =~ m|\A(.*?)-(\d.*)\.tar\.($cmp_fmts_grep)\Z|);
+    return wantarray ? ($pn, $vr) : $vr;
+}
+
+sub parsever {
+    my ($pn, $vr) = getver(shift);
+    my ($v, $r) = ($vr =~ m|\A(\d.*?)-(\d.*)\Z|);
+    return wantarray ? ($pn, $v//$vr, $r//0) : $vr;
 }
 
 sub filer {
@@ -259,7 +347,8 @@ sub filer {
     my $what = shift;
     my $f = shift;
     open(*F, '<', $f) or do {
-	myerror "can't open $f - $!" unless $main::okmissing{$what};
+	myerror "can't open $f - $!"
+	    unless $main::okmissing{$what} or $x->{'obsolete'};
 	return undef;
     };
     my ( $chk, $sum );
@@ -280,15 +369,9 @@ sub filer {
 
 sub tarball {
     my $d = shift;
-    my $b = join('-', @_) . '.tar.';
-    for my $e (@cmp_fmts) {
-      my $f = "$d/" . "$b" . "$e";
-      if (-e "$f") {
-        return "$f";
-      }
-    }
-    # default to .nf (because we know it is missing)
-    return "$d/" . "$b" . "nf";
+    my $fg = "$d/" . join('-', @_) . ".tar.{$cmp_fmts_glob}";
+    my ($f, undef) = grep {-e} glob($fg);
+    return $f // $fg;
 }
 
 sub fnln {
@@ -306,7 +389,7 @@ sub myerror(@) {
 sub finddir {
     my $d = $_[0];
     my $pname = $_[1];
-    while (($d = dirname($d)) ne '.' && length($d)) {
+    while (($d = dirname($d)) && (length($d) > 1)) {
 	return "$d/$pname" if -d "$d/$pname";
     }
     myerror "couldn't find package directory for external-source '$pname'";