###########################################
package ModDevUtils;
###########################################

use File::Find;
use File::Basename;
use Pod::Usage;
use Pod::Text;
use ExtUtils::MakeMaker;
use ExtUtils::Manifest;
use Cwd;
use strict;

our $CVSVERSION   = '$Revision: 1.22 $';
our ($VERSION)    = ($CVSVERSION =~ /(\d+\.\d+)/);

    # parse_version_from_file only works once, store it here.
our %DETECTED_VERSION = ();

our $MAKEMAKER_MIN_VERSION = 6.50;
die "Got MakeMaker version $ExtUtils::MakeMaker::VERSION but need >=" .
    "$MAKEMAKER_MIN_VERSION" 
       if $ExtUtils::MakeMaker::VERSION < $MAKEMAKER_MIN_VERSION;

###########################################
sub check_changes {
###########################################
    open FILE, "<Changes" or die $!;
    my $data = join '', <FILE>;
    close FILE;

    if( $data =~ /^[\d.]+\s+\((.*?)\)/m ) {
        if( $1 !~ m#^\d+\/\d\d/\d+$# ) {
            return 0;
        }
        return 1;
    }

    print "No (yyyy/mm/dd) found, trying CPAN::Changes\n";

    require CPAN::Changes;
    my $changes = CPAN::Changes->load( 'Changes' );

    my @last_release = $changes->releases();
    if( $last_release[-1]->{ date } ) {
        return 1;
    }

    return 0;
}

###########################################
sub parse_version_from_file {
###########################################
    my($source_file) = @_;

        # This doesn't work if called twice,
        # but we've got a cached version
    if(exists $DETECTED_VERSION{$source_file}) {
        return @{$DETECTED_VERSION{$source_file}};
    }

        # Get all previously defined packages
    my %before = map { $_ => 1 } _all_packages();

    my($package, $version) = raw_parse($source_file);

    return ($package, $version);

    ###########################################
    # DELETED
    ###########################################

        # Pull in the new module
    eval { require $source_file; };

    if($@) {
        my($package, $version) = raw_parse($source_file);
        return undef unless defined $version;
    }

    die "require $source_file failed: $@" if $@;

        # Check which packages have been added
    my @addtl = grep { not exists $before{$_} } 
                     _all_packages();

        # Check if one matches the filename
    (my $package = $source_file) =~ s/\.pm$//;
    $package = basename($package);
    for (@addtl) {
        if(/::${package}::$/) {
            s/^::|::$//g;
            my $v = eval "\$${_}::VERSION";
            $DETECTED_VERSION{$source_file} = [${_}, $v];
            return (${_}, $v);
        }
    }

    warn "No package matches $package\n";
    return undef;
}

###########################################
sub raw_parse {
###########################################
    my($source_file) = @_;

    open FILE, "<$source_file" or die "Cannot open $source_file";
    my $data = join '', <FILE>;
    close FILE;

    if($data =~ /VERSION\s*=\s*['"](.*?)['"]/) {
        my $version = $1;
        if($data =~ /package\s+(.*?)\s*;/) {
            # warn "Returning $1-$version\n";
            return ($1, $version);
        } else {
            warn "Parsing $source_file failed, " .
                 "\$VERSION found but no package\n";
            return undef;
        }
    }

    warn "Parsing $source_file failed, no \$VERSION found\n";
    return undef;
}

###########################################
sub main_pm_file {
###########################################
    my($start_dir) = @_;

    $start_dir = "." unless defined $start_dir;

    my $main_pm_file;

        # Find just the main pm file
    find( sub {

        if($_ eq 'blib') {
                # We don't want temporarily installed files
            $File::Find::prune = 1;
            return;
        }

        return unless -f;
        return unless /\.pm$/;

        $File::Find::prune = 1;
        return if defined $main_pm_file;
        $main_pm_file = $File::Find::name;
    }, "." );

    return $main_pm_file;
}

###########################################
sub _all_packages {
###########################################
    my($prefix) = @_;

    no strict 'refs'; # We're using soft references

    $prefix = "::" unless defined $prefix;

    my @all = ();

    for (keys %$prefix) {
        #print "Found $prefix$_\n";
        next unless /::$/;
        next if /^main::/;
        #print "Recursing $prefix$_\n";
        push @all, "$prefix$_", _all_packages("$prefix$_");
    }

    return @all;
}

###########################################
sub update_readme {
###########################################

    my $main_pm_file = main_pm_file();
    die("Cannot find pm file") unless defined $main_pm_file;

    my ($package, $version) = parse_version_from_file($main_pm_file);
    die("Cannot find version in $main_pm_file") unless defined $version;

    open PM, "<$main_pm_file" or die "Cannot open $main_pm_file";
    open README, ">README" or die "Cannot open README";
    print README
          ("#" x 70), "\n",
          "    $package $version\n",
          ("#" x 70), "\n\n";

    my $p = Pod::Text->new();
    $p->parse_from_filehandle(\*PM, \*README);
    
    close PM;
    close README;
}

###########################################
sub update_manifest {
###########################################
    my($params) = @_;

    if(!defined $params) {
        $params = "";
    }

    my $string = "perl Makefile.PL $params 2>&1 >/dev/null; make manifest 2>&1 >/dev/null";
    print "$string ...\n";
    system($string);

      # The call above doesn't update the MANIFEST correctly if there's files
      # listed that aren't present in the file system. Run a separate check.
    my @missing = ExtUtils::Manifest::manicheck();

    if(@missing) {
        die "Manifest check failed, missing files: @missing";
    }
}

###########################################
sub make_tarball {
###########################################
    my($params) = @_;

    if(!defined $params) {
        $params = "";
    }

    my $string = "perl Makefile.PL $params 2>&1 >/dev/null; make tardist 2>&1 >/dev/null";
    print "$string ...\n";
    system($string);
}

###########################################
sub tarball_name {
###########################################
    my($package, $version) = @_;

    my $file = tarname();
    my ($package, $version) = ModDevUtils::parse_version_from_file($file);

    my @comps = split /::/, $package;

    return join('-', @comps) . "-$version.tar.gz";
}

###########################################
sub tarname {
###########################################
    return main_pm_file();
}

###########################################
sub all_checked_in {
###########################################
    if(is_git()) {
        all_checked_in_git();
    } else {
        all_checked_in_cvs();
    }
}

###########################################
sub is_git {
###########################################

    if(-d ".git") {
        return 1;
    }

    return 0;
}

###########################################
sub all_checked_in_cvs {
###########################################

    #warn "Skipping CVS check\n";
    #return 1;

    open PIPE, "cvs -q up |";
    my @stuff = <PIPE>;
    close PIPE;
    print "Check-in check: @stuff\n";
    return ! scalar @stuff;
}

###########################################
sub all_checked_in_git {
###########################################

    #warn "Skipping CVS check\n";
    #return 1;

    open PIPE, "git status -s |";
    my $stuff = join '', <PIPE>;
    close PIPE;
    print "Check-in check: $stuff\n";
    return $stuff =~ /working directory clean/;
}

###########################################
sub tag {
###########################################

    my $file = main_pm_file();
    my ($package, $version) = parse_version_from_file($file);
 
    my $proj = basename(getcwd());
    $version =~ s/\.//g;
    $version = "rel_$version";

    if(is_git()) {
        git_tag($version, $proj);
    } else {
        cvs_rtag($version, $proj);
    }
}

###########################################
sub cvs_rtag {
###########################################
    my($version, $proj) = @_;

    my $cmd = "cvs -q rtag $version $proj";
    print "$cmd\n";
    system($cmd);
}

###########################################
sub git_tag {
###########################################
    my($version, $proj) = @_;

    my $cmd = "git tag $version";
    print "$cmd\n";
    system($cmd);
}

###########################################
sub release {
###########################################
    my($sloppy_cvs, $params) = @_;

    if(!defined $params) {
        $params = "";
    }

    my $tarball = ModDevUtils::tarball_name();
    unlink($tarball);

    check_changes() or die "*** Changes not up to date";

    my $file = main_pm_file();
    my ($package, $version) = ModDevUtils::parse_version_from_file($file);
    print "Releasing $package $version ...\n";

    print "Updating README ...\n";
    ModDevUtils::update_readme($params);

    print "Updating MANIFEST ...\n";
    ModDevUtils::update_manifest($params);

    if($sloppy_cvs) {
        print "Sloppy Mode - *not* checking if everything's checked in ...\n";
    } else {
        print "Check if everything's checked in ...\n";
        if(!ModDevUtils::all_checked_in()) {
            print "Sorry, some files are not checked in. Run 'cvs update'.\n";
            return;
        }
    }

    print "Creating tarball ...\n";
    ModDevUtils::make_tarball($params);

    print "Tagging rel_$version...\n";
    ModDevUtils::tag();

    return 1;
}

1;

__END__

=cut

=head1 NAME

    ModDevUtils - Development Utilities for Perl Modules

=head1 DOWNLOAD

_SRC_HERE_

=head1 SYNOPSIS

    use ModDevUtils;
    
        # Get the path of the main *.pm file in the tree
    my $file = ModDevUtils::main_pm_file();

        # Parse the setting of the $VERSION variable in a file
    ModDevUtils::parse_version_from_file($file);

=head1 DESCRIPTION

=over 4

=item main_pm_file()

Descends down the current directory, trying to find the first *.pm file
on its way, omitting the C<blib> directory. Returns path/name of the
first file if it finds one.

=item parse_version_from_file($file)

Read a *.pm file and parse the setting of C<$VERSION> in it.

C<parse_version_from_file($file)> 
derives the value of VERSION and the package name by 
brute-force scanning the module, similary to C<ExtUtils::MakeMaker>.

=back

=item update_readme()

Searches for the main *.pm file, grabs its C<$VERSION>, formats its
POD as text and creates README, containing a header like

    ###########################################
    # Foo::Bar vX.XX
    ###########################################

and its POD in plain text format.

=item update_manifest()

Just calls 

    perl Makefile.PL
    make manifest

Use C<MANIFEST.SKIP> for stuff you don't want to be included.

=item all_checked_in()

Verifies that C<git> or C<cvs> (depending on which SCM you're using)
don't print anything which isn't checked in.
Use C<.cvsignore> or C<.gitignore> for stuff you don't want to be reported.
Returns a true value if everything is checked in.

=item tarball_name()

Determines the name of the module's tarball.

=item tag($version, $project)

Marks the release as rel_VERSION via cvs rtag.

=item release([$sloppy_scm], [$mpl_params])

Call pretty much every function in this module. If C<$sloppy_scm> is
set to a true value, the function will I<not> enforce that everything
is checked in. C<$sloppy_scm> defaults to false if omitted, therefore
enforcing that everything is checked in before the module is released.
C<$mpl_params> specifies any parameters that have to be given to a
C<perl Makefile.PL> call in your distribution.

=back

=head1 LEGALESE

Copyright 2002-2009 by Mike Schilli, all rights reserved.
This program is free software, you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 AUTHOR

2009, Mike Schilli <m@perlmeister.com>