#!/usr/bin/perl -w
use strict;
use Getopt::Std;
use File::Copy;
use File::Find;
use Text::Glob qw(match_glob);

my $VERSION = '0.06';

my %o = (
    a => 0,    # use the current date for the new revision
    b => 0,    # backup touched files
    d => 0,    # turn on verbose mode for debugging
    p => 0,    # zero padding
    r => 0,    # descend into subdirectories
    s => '.',  # user defined separator
    t => 0,    # use the current time for the new revision
    v => 0,    # version string section
    z => 0,    # trim off trailing zero revisions
);
getopts('abdp:r:s:tv:z', \%o);

# Increment the given files.
if (@ARGV) {
    if ($o{r} && -d $o{r}) {
        debug("Recurse into $o{r}");
        find(\&wanted, $o{r});
    }
    else {
        debug("Increment @ARGV");
        increment_version($_) for @ARGV;
    }
}
# Show the usage help (with the given file list, if there is one).
else {
    print "Usage: $0 [-abdtz] [-p N] [-r PATH] [-s STRING] [-v N] file1 [file2 .. fileN]\n";
}

exit;

sub debug {
    print @_, "\n" if $o{d};
}

# increment_version if we are looking at a text file that matches the
# (possibly globbed) argument list of file names.
sub wanted {
    my $f = $_;
    debug("wanted: $f = $File::Find::name");
    debug('is text: '. (-f $f) . ", match_glob: " . (grep { match_glob($_, $f) } @ARGV) . "in @ARGV");
    increment_version($f) if -f $f && grep { match_glob($_, $f) } @ARGV;
}

sub increment_version {  # {{{
    my $f = shift;

    # Skip the argument, if we can't open it as a text file.
    return unless -f $f;
    if (open PM, $f) {
        print "Looking in $f...\n";
    }
    else {
        warn "Can't open $f: $!\n";
        next;
    }

    # Set our separators to use as a character class.
    my $separators = '[_.\-'. $o{s} .']';

    # Set the name of the new file.
    my $new_f = "$f.$$";

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

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

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

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

            # Set the new version string revision section to a
            # timestamp, if asked to, otherwise just increment the
            # current one.
            if ($o{a} || $o{t}) {
                $version = '';
                $version .= sprintf '%04d%02d%02d',
                    (localtime)[5] + 1900, (localtime)[4] + 1, (localtime)[3]
                    if $o{a};
                $version .= $o{s} if $o{a} && $o{t};
                $version .= sprintf '%02d%02d%02d', (localtime)[2,1,0]
                    if $o{t};
            }
            else {
                $version++;
            }

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

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

            # 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/^(.+?)(?:[\Q$separators\E]+0+)+$/$1/ if $o{z};

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

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

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

    close NEW or die "Can't close $new_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 "$new_f" or die "Can't unlink $new_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 "$new_f", $f or die "Can't move $new_f, $f: $!\n";

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

__END__

=head1 NAME

increment_version - Increment a perl file version string

=head1 README

Increment the version string variable in files, based on flexible command line switches.

=head1 DESCRIPTION

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

If the program is invoked with no arguments, a friendly usage line is 
output.

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.  I am not sure how I accomplished this, but it 
happened.  Anyway, now, I use this script to do version incrementing 
for me.

=head1 OPTIONS

=over 4

=item -a

Use the current date in C<YYYMMDD> format for the revision section to
increment.  Defaults to 0.

=item -b NUMBER

Backup touched files.  Defaults to 0.

=item -d

Turn on verbose output mode for debugging purposes.  Defaults to 0.

=item -p NUMBER

Amount of left justified "zero padding" of the revision increment.
Defaults to 0.

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".

=item -r PATH

Descend into the subdirectories of the specified path, looking for 
files to increment.  Defaults to 0.

=item -s STRING

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

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

=item -t

Use the current time in C<HHMMSS> format for the revision section to
increment.  Defaults to 0.

=item -v 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 -z

Trim off trailing zero revisions.  Defaults to 0.

=back

=head1 USAGE

  incver [-hbdt] [-p N] [-r PATH] [-s STRING] [-v N] file1 [file2 .. fileN]

Examples:

  # Increment the default version string section in the given files.
  incver Foo/A.pm Bar/B.pm Baz/C.pm

  # Recursively increment all *.pm files under lib/foo.
  incver -v1 -rlib/foo \*.pm

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

  incver -v1 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

  incver -v2 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

  incver -p1 -v1 Module.pm
  # 1     -> 1.01
  # 1.0   -> 1.01
  # 1.01  -> 1.02
  # 1.001 -> 1.002

  incver -v1 -z Module.pm
  # 0.1.2   -> 0.2
  # 0.01.02 -> 0.02

  incver -v2 -s_ Module.pm
  # 1   -> 1_0_1
  # 1.0 -> 1.0_1

  incver -a Module.pm
  # 1 -> 20030720

  incver -v1 -a Module.pm
  # 0.01 -> 0.20030720  # 20 July 2003

  incver -t Module.pm
  # 1 -> 204629  # 8:46 pm and 29 seconds

  incver -v1 -at -s_ Module.pm
  # 0.01 -> 0.20030720_204629

=head1 PREREQUISITES

This program requires the C<strict> pragma, the C<File::Copy>, 
C<File::Find>, and C<Getopt::Std> modules (which are all in the core 
perl distribution).  Also, it requires the C<File::Glob> module.

=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.

  0.05  20 Sun Jul 2003
    - Added the ability to recursively descend into subdirectories
      (via C<File::Find>).
    - Added the ability to handle file globs when recursively 
      descending.
    - Added a command line switch and accompanying function for
      verbose (debugging) mode.
    - Changed the option flags around.  Hope this doesn't throw any
      of the vast users of incver...
    - Added a command line switch to use a timestamp for a version
      string revision.

  0.05.1  21 Mon Jul 2003
    - Tweezed documentation.

  0.06  21 Mon Jul 2003
    - Made the separator a variable for use in the RE character class
      and added the user defined one to it.

=head1 SEE ALSO

L<Text::Glob>

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

L<Sort::Versions> because it's a relative (but not a dependent).

=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