use 5.010_001;
use strict;
$| = 1;
my $msgfile = $ARGV[0] || '';
die("Missing message file\n") unless -f $msgfile;
my $msgfile2 = "$msgfile.tmp.$$";
my $toplevel = qx(git rev-parse --show-toplevel 2>&1);
die("Failed to get toplevel:\n$toplevel") if $?;
chomp($toplevel);
chdir($toplevel) or die("Failed to chdir to $toplevel: $!\n");
my %files =
(
'README.md' => 1,
'lib/App/Pods2Site/SiteBuilder/AbstractBasicFrames.pm' => 6,
'lib/App/Pods2Site/SiteBuilder/BasicFramesSimpleTOC.pm' => 6,
'lib/App/Pods2Site/SiteBuilder/BasicFramesTreeTOC.pm' => 6,
'lib/App/Pods2Site/SiteBuilder/None.pm' => 6,
'lib/App/Pods2Site/_Args.pod' => 9,
'lib/App/Pods2Site/AbstractSiteBuilder.pm' => 6,
'lib/App/Pods2Site/Args.pm' => 10,
'lib/App/Pods2Site/Args.pod' => 9,
'lib/App/Pods2Site/Pod2HTML.pm' => 6,
'lib/App/Pods2Site/PodCopier.pm' => 6,
'lib/App/Pods2Site/PodFinder.pm' => 6,
'lib/App/Pods2Site/SiteBuilderFactory.pm' => 6,
'lib/App/Pods2Site/Util.pm' => 6,
'lib/App/Pods2Site.pm' => 8,
'lib/App/Pods2Site.pod' => 10,
'script/pods2site' => 6
);
foreach my $fn (keys(%files))
{
die("Failed to find '$fn' in '$toplevel'\n") unless -f "$toplevel/$fn";
}
# verify we're clean
#
my @status = qx(git status --porcelain --ignored 2>&1);
@status = grep(!m#^!! tmp/$#, @status);
die("Tree not clean:\n@status") if (@status || $?);
# find the current branch:
#
my @br = qx(git symbolic-ref --short HEAD 2>&1);
die("Failed symbref:\n@br") if $?;
chomp(@br);
die("No current branch found") unless @br;
die("Invalid branch: '$br[0]'") unless $br[0] =~ /^(\d+)\.(?:(\d\d\d)_)?xxx$/;
my $mj = $1;
my $min = $2;
my $isdev = defined($min) ? 1 : 0;
system("git fetch --all -q 2>&1");
die("Failed fetch") if $?;
my @tags = qx(git tag -l 2>&1);
die("Failed tags:\n@tags") if $?;
chomp(@tags);
my $tagfilter = $isdev ? qr/^v(${mj}\.${min}_(\d\d\d))$/ : qr/^v(${mj}\.(\d\d\d))$/;
@tags = sort(grep(/$tagfilter/, @tags));
my $lastTag = $tags[-1];
die("???") unless $lastTag =~ /$tagfilter/;
my $currentVersion = sprintf("${mj}.%s%03d", ($isdev ? "${min}_" : ''), $2);
my $currentVersionRE = qr(\Q$currentVersion\E);
my $nextVersion = sprintf("${mj}.%s%03d", ($isdev ? "${min}_" : ''), $2 + 1);
my $nextTag = "v$nextVersion";
print "Next version is '$nextVersion'\n";
foreach my $fn (keys(%files))
{
my $line = $files{$fn};
print "Changing 'version' in $fn...\n";
$fn = "$toplevel/$fn";
my $idx = $line - 1;
my @contents = readAll($fn);
die("The file '$fn' does not have the current version '$currentVersion' in line $line\n") unless $contents[$idx] =~ /$currentVersionRE/;
$contents[$idx] =~ s/$currentVersionRE/$nextVersion/;
writeAll($fn, @contents);
}
my @msg = readAll($msgfile);
my $subj = "Release $nextVersion";
writeAll($msgfile2, $subj, "", @msg);
my @tm = localtime();
my $today = sprintf("%d-%02d-%02d\n", $tm[5] += 1900, $tm[4] + 1, $tm[3]);
my @changes = readAll('Changes');
foreach (@msg)
{
$_ = "\t$_" if $_;
}
splice(@changes, 2, 0, "$nextVersion\t$today", @msg, "");
writeAll('Changes', @changes);
my @mk = qx(perl Makefile.PL 2>&1);
die("Failed creating makefile:\n@mk") if $?;
my $mkcfg = qx(perl -V:make 2>&1);
die("Failed finding make config:\n$mkcfg") if $?;
die("Unexpected mkcfg: '$mkcfg'\n") unless $mkcfg =~ /^make='([^']+)'/; #'
my $mkcmd = $1;
my $expectedDist = "App-Pods2Site-$nextVersion.tar.gz";
system("$mkcmd dist 2>&1");
die("Failed making dist '$expectedDist'\n") if ($? || !-f $expectedDist);
print "The current branch is '$br[0]' with next version = '$nextVersion'\n";
print "Ready to commit => tag => push => upload? ";
my $a = <STDIN>;
chomp($a);
if (lc($a) eq 'yes')
{
print "Committing, tagging, pushing and uploading...\n";
system("git commit -a -F $msgfile2 2>&1");
die("Failed commit") if $?;
system("git tag $nextTag 2>&1");
die("Failed tag\n") if $?;
system("git push origin $br[0] $nextTag 2>&1");
die("Failed push\n") if $?;
system("cpan-upload -v --user knth $expectedDist");
die("Failed upload\n") if $?;
}
else
{
my @realclean = qx($mkcmd realclean 2>&1);
die("Failed making realclean:\n@realclean") if $?;
print "Reverting!\n";
my @reset = qx(git reset --hard 2>&1);
die("Failed reset:\n@reset") if $?;
}
unlink($msgfile2);
print "END\n";
sub readAll
{
my $fn = shift;
open(my $fh, '<', $fn) or die("Failed to open '$fn': $!\n");
binmode($fh);
local $\ = undef;
my @c = <$fh>;
close($fh);
chomp(@c);
return @c;
}
sub writeAll
{
my $fn = shift;
my @c = @_;
open(my $fh, '>', $fn) or die("Failed to open '$fn': $!\n");
binmode($fh);
print $fh "$_\n" foreach (@c);
close($fh);
}