#!/usr/bin/perl -w
use strict;
use File::Copy;
use Getopt::Std;

my $VERSION = '0.04.1';

my %o = (
    b => 0,    # backup touched files
    h => 0,    # usage help
    p => 0,    # zero padding
    r => 0,    # release section
    s => '.',  # user defined separator
    t => 0,    # trim off trailing zero revisions
);
getopts('bhp:r:s:t', \%o);

# Show the usage help (with the given file list, if there are any).
if ($o{h}) {
    my @f = @_ ? @_ : 'file1 [file2 .. fileN]';
    print "Usage: $0 [-h] [-b] [-p N] [-r N] [-s STRING] [-t N] @f\n";
}
else {
    # Handle each provided file.
    for my $f (@ARGV) {
        # Skip the argument, if we can't open it as a text file.
        unless (open PM, $f) {
            warn "Can't open $f: $!\n";
            next;
        }

        # Open the module file (with the proc id appeneded) for writing.
        open NEW, ">$f.$$" or die "Can't write $f.$$: $!\n";

        # Look for a version string.
        while (<PM>) {
            # Skip commented or CVS revision lines.
            if (!/^#/ && !/\$Revision:\s/ &&
                /VERSION\s*=\s*.*?([\d\w.\-]+)/
            ) {
                # Save the original version string.
                my $old = $1;
                # Grab the non-separator parts.
                my @version    = split /[._\-]/, $old;
                # Grab the separators.
                my @separators = grep {$_} split /[^._\-]+/, $old;

                # Initialize any needed version parts to zero and
                # separators to a dot.
                for (0 .. $o{r}) {
                    $version[$_] = 0 unless $version[$_];
                    $separators[$_] = $o{s}
                        unless $separators[$_] || $_ == $o{r};
                }

                # Strip off any non-numeric prefix (usually just 'v').
                my ($prefix, $version) =
                    $version[$o{r}] =~ /^([^\d.]*)(.+)$/;

                # Increment the version part specified by the
                # revision flag.
                $version[$o{r}] = sprintf '%s%0'.$o{p}.'s',
                    $prefix, ++$version;

                # "Zero out" succeeding version sections following
                # the incremented one.
                for ($o{r} + 1 .. @version - 1) {
                    $version[$_] = 0 x length $version[$_];
                }

                # Reconstitute our version string.  This algorithm is
                # like a join() with a dynamic separator expression
                # given that @version is always one element bigger
                # than @separators.
                my $new = '';
                for (0 .. @version - 1) {
                    $new .= $version[$_];
                    $new .= $separators[$_] if defined $separators[$_];
                }

                # Remove trailing zero revisions if asked to.
                $new =~ s/^(.+?)[0._\-]+$/$1/ if $o{t};

                # Replace the old version string with the new one.
                s/$old/$new/;

                # Feedback: It does a body good.
                print "$f: $old -> $new\n";
            }

            # Write the line out to the new file.
            print NEW $_;
        }

        close NEW or die "Can't close $f.$$: $!\n";
        close PM  or die "Can't close $f: $!\n";

        # Save the mode of the original file.
        my $mode = sprintf '%04o', (stat($f))[2] & 07777;

# XXX debugging
#unlink "$f.$$" or die "Can't unlink $f.$$\n";
        # Keep a backup, if asked to.
        if ($o{b}) {
            copy $f, "$f.bak" or die "Can't copy $f, $f.bak: $!\n";
        }
        # Move the new file over the original.
        move "$f.$$", $f or die "Can't move $f.$$, $f: $!\n";

        # Preserve the mode of the original file.
        chmod oct($mode), $f or die "Can't chmod $mode, $f: $!\n";
    }
}

exit;

__END__

=head1 NAME

increment_version - Increment a perl file version string

=head1 README

Increment version string variables based on flexible command line switches

=head1 DESCRIPTION

This program finds the version variable in each of a given list of 
files and increments it based on command line switches described in 
the C<OPTIONS> section.

This program does I<not> make use of C<v-string> objects.

Why did I make this, you might ask?  One time, I accidentally 
uploaded a module as version '0.2', instead of '0.02'.  That is, I 
uploaded a typo, thereby losing visible touch with my development 
progression and precluding me from ever uploading a 0.2 version.  Now 
I am not sure how I accomplished that, but it happened.  Maybe you 
are a more fortunate person, who never commits typographical errors 
into production...  Anyway, now, I use this script (in conjunction 
with C<Module::Hubandry>) to do version incrementing for me.

=head1 OPTIONS

=over 4

=item -b NUMBER

Backup touched files.  Defaults to 0.

=item -h

Show the usage help.

=item -p NUMBER

Amount of left justified "zero padding" of the revision increment.

* Currently, this option does not force a revision section to have 
less places, only more.  That is, with a setting of -p3 -r1, the 
following is the case:

"1.2.3", "1.02.3", and "1.002.3" are all incremented to "1.003.3",
yet "1.0002.3" will be incremented to "1.0003.3".

This may change in a future release, after I think about it for a 
while.  : )

=item -r NUMBER

Revision section.  Defaults to 0.

In a version string like, "v1.2.003_04-a", the C<revision sections> 
are as follows:

"1" is section 0 (the default), "2" is section 1, "003" is section 2, 
"04" is section 3, "a" is section 4, and the initial "v" is optional.

=item -s STRING

The separator to use for I<new> revision sections.  Defaults to a 
period (.).

Common separators that are commonly used are the underscore character 
(_) and the hyphen (-).

=item -t NUMBER

Trim off trailing zero revisions.  Defaults to 0.

=back

=head1 USAGE

  inc_ver [-h] [-b] [-p N] [-r N] [-s STRING] [-t N] file1 [file2 .. fileN]

Examples:

  inc_ver lib/Foo/A.pm lib/Bar/B.pm lib/Baz/C.pm

  inc_ver Module.pm
  # 0    -> 1
  # 0.0  -> 1.0
  # 1.01 -> 2.00

  inc_ver -r1 Module.pm
  # 1      -> 1.1
  # 1.0    -> 1.1
  # 1.01   -> 1.02
  # 1.01.0 -> 1.02.0
  # 1.01.1 -> 1.02.0

  inc_ver -r2 Module.pm
  # 1        -> 1.0.1
  # 1.0      -> 1.0.1
  # 1.02     -> 1.02.1
  # 1.02.0   -> 1.02.1
  # 1.02.1   -> 1.02.2
  # 1.02.0.0 -> 1.02.1.0
  # 1.02.0.5 -> 1.02.1.0

  inc_ver -p1 -r1 Module.pm
  # 1     -> 1.01
  # 1.0   -> 1.01
  # 1.01  -> 1.02
  # 1.001 -> 1.002

  inc_ver -r1 -t Module.pm
  # 0.1.2   -> 0.2
  # 0.01.02 -> 0.02

  inc_ver -r2 -s_ Module.pm
  # 1   -> 1_0_1
  # 1.0 -> 1.0_1

=head1 PREREQUISITES

This script requires the C<strict> pragma, the C<File::Copy> and 
C<Getopt::Std> modules (which are all in the core perl distribution).

=head1 OSNAMES

Any

=head1 SCRIPT CATEGORIES

Module/Maintenance

=head1 CHANGES

  0.01  12 Jul 2003
    - Creation

  0.02  13 Jul 2003
    - Whoops!  Left in my debugging unlink and commented copy/more.
    - Added a CHANGES section to the POD.

  0.03  14 Jul 2003
    - Whoops again.  Forgot to add a hyphen to the char-class used
      when removing trailing zero revisions.
    - Fixed the script to retain the permissions of the original
      files that are touched.

  0.04  18 Jul 2003
    - Fixed and enhanced the documentation.

  0.04.1  18 Jul 2003
    - Oof.  Fixed the documentation again.

=head1 TO DO

Figure out how to split on a user defined separator as well as the
internal ones.

Get Barry Slaymaker to add this C<Module::Husbandry>.  : )
Either that or make a C<Module::Husbandry::VersionIncrement> module.

=head1 SEE ALSO

L<Module::Husbandry> just because it's so cool

L<Sort::Versions>

=head1 AUTHOR

Gene Boggs E<lt>gene@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2003 by Gene Boggs

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=cut