########################################### 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, "; 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 '', ; 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 = ; 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 '', ; 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 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 derives the value of VERSION and the package name by brute-force scanning the module, similary to C. =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 for stuff you don't want to be included. =item all_checked_in() Verifies that C or C (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 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 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