add warning for over-long dotted decimal
[p5sagit/Distar.git] / helpers / bump-version
index 464680c..d9ae2ae 100755 (executable)
@@ -10,12 +10,16 @@ GetOptions(
   "git"     => \my $git,
   "force"   => \my $force,
   'n|dry-run' => \my $dry_run,
+  'stable'  => \my $stable,
+  'alpha'   => \my $alpha,
 ) or die("Error in command line arguments\n");
 
 my $old_version = shift
   or die "no old version provided!\n";
 my $bump = shift;
 my ($new_decimal, $new_vstring) = bump_version($old_version, $bump);
+die "--stable and --alpha are incompatible!\n"
+  if $stable and $alpha;
 
 warn "Bumping $old_version -> $new_decimal" . ($new_decimal ne $new_vstring ? " ($new_vstring)" : '') . "\n";
 
@@ -146,11 +150,16 @@ sub version_parts {
   my $version = shift;
   my $dotted = $version =~ s/^v//;
   my @parts = split /\./, $version;
-  if (!$dotted && @parts == 2) {
-    my $dec = pop @parts;
-    $dec =~ s/_//g;
-    $dec .= "0" x ((- length $dec) % 3);
-    push @parts, $dec =~ /(\d{1,3})/g;
+  if (!$dotted && @parts <= 2) {
+    tr/_//d for @parts;
+    if (@parts == 2) {
+      my $dec = pop @parts;
+      $dec .= "0" x ((- length $dec) % 3);
+      push @parts, $dec =~ /(\d{1,3})/g;
+    }
+  }
+  elsif ($version =~ tr/_//) {
+    die "don't know how to handle underscores in dotted-decimal versions!\n";
   }
   $_ += 0 for @parts;
   return @parts;
@@ -168,6 +177,9 @@ sub bump_version {
   if (defined $bump_this) {
     if ($version =~ /^v/ || ($version =~ tr/.//) > 1) {
       my $v = $version =~ /^(v)/ ? $1 : '';
+      if ($version =~ tr/_//d && !$stable || $alpha) {
+        die "can't bump dotted decimal versions with alpha components!\n";
+      }
       my @parts = version_parts($version);
       $bump_this += @parts
         if $bump_this < 0;
@@ -176,21 +188,45 @@ sub bump_version {
       $parts[$bump_this]++;
       $_ += 0
         for @parts;
+      if (grep $_ > 999, @parts[1 .. $#parts]) {
+        warn "$new_decimal has a version component greater than 999.  It will be incompatible with some uses in perl.\n";
+      }
       $new_decimal = $new_vstring = $v . join '.', @parts;
     }
     else {
-      my $alpha_pos = index($version, '_');
-      $version =~ s/_//g;
-      $version =~ s/^(\d+)\.//;
-      my @parts = $1;
-      push @parts, $version =~ /(\d{1,3})/g;
-      my $format = '%i.'.join '', map { '%0'.length($_).'i' } @parts[1 .. $#parts];
-      $parts[$bump_this]++;
-      $parts[$_] = 0 for (($bump_this < 0 ? @parts : 0)+$bump_this+1 .. $#parts);
-      $new_decimal = sprintf $format, @parts;
-      substr $new_decimal, $alpha_pos, 0, '_'
-        if $alpha_pos != -1;
-      $new_vstring = join '.', version_parts($new_decimal);
+      my $alpha_pos;
+      if (!$stable) {
+        $alpha_pos = index($version, '_');
+        if ($alpha_pos == -1) {
+          undef $alpha_pos;
+        }
+        else {
+          my $dot_pos = index($version, '.');
+          $alpha_pos = $dot_pos == -1 ? -$alpha_pos : $alpha_pos - $dot_pos;
+        }
+      }
+      $new_decimal = $version;
+      $new_decimal =~ tr/_//d;
+      my $dec_len = $new_decimal =~ /(\.\d+)/ ? length($1) - 1 : 0;
+      if ($bump_this != -1) {
+        my $cut_len = $bump_this * 3;
+        $dec_len = $cut_len
+          if $dec_len < $cut_len;
+        $new_decimal =~ s/(\..{1,$cut_len}).*/$1/;
+      }
+      $new_decimal += 10 ** -($bump_this == -1 ? $dec_len : ($bump_this * 3));
+      $new_decimal = sprintf "%.${dec_len}f", $new_decimal;
+      if ($alpha) {
+        $alpha_pos ||= $dec_len >= 2 ? int($dec_len / 2) + 1 :
+          die "don't know how to make $new_decimal into an alpha version";
+      }
+      if (defined $alpha_pos) {
+        my $dot_pos = index($new_decimal, '.');
+        $dot_pos = length $new_decimal
+          if $dot_pos == -1;
+        substr $new_decimal, $dot_pos + $alpha_pos, 0, '_';
+      }
+      $new_vstring = 'v' . join '.', version_parts($new_decimal);
     }
   }
   elsif ($new =~ /^v?[0-9]+(?:[._][0-9]+)*$/) {