#!/usr/bin/perl -s use strict; use warnings; use Cwd; use File::Copy; use Data::Dumper; our ($version,$minor,$major); # The command is ran in the root dir for the distro we want to release # Get current directory, it can be useful. my $cwd = getcwd(); say("Current directory is $cwd"); # Get the distribution type, and which file should be edited my ($type,$file_with_version) = gettype(); say("Distribution of type: $type"); say("Version should be in $file_with_version"); # Get current version my $cversion = getcver($type, $file_with_version); say("Last distribution was: $cversion"); # Increment the version number my $nversion; if ($version) { $nversion = $version } else { $nversion = incver($type, $cversion) } say("Next distribution should be: $nversion"); # Change the version in the file if (ask_yes_no("Should I change $cversion to $nversion in $file_with_version?","no")) { say("OK! You asked for it ;-) -- editing $file_with_version"); change_version($type, $file_with_version, $cversion, $nversion); say("Done"); } else { say("OK! I hope you have edited it before running this!") } ## ==================================== sub change_version { my ($type, $file, $cversion, $nversion) = @_; # Create a backup, we never know! copy($file, "$file.bak"); if ($type eq "PerlModule") { open S, "$file.bak" or die "Cannot open $file.bak: $!\n"; open T, ">$file" or die "Cannot create file $file: $!\n"; while() { s/$cversion/$nversion/g if m!\$VERSION!; print T; } close T; close S; } elsif ($type eq "Automake") { open S, "$file.bak" or die "Cannot open $file.bak: $!\n"; open T, ">$file" or die "Cannot create file $file: $!\n"; while() { s/$cversion/$nversion/g if m!AM_INIT_AUTOMAKE!; print T; } close T; close S; } elsif ($type eq "Makefile") { # code equal to PerlModule, but we can need to change it later open S, "$file.bak" or die "Cannot open $file.bak: $!\n"; open T, ">$file" or die "Cannot create file $file: $!\n"; while() { s/$cversion/$nversion/g if m!VERSION!; print T; } close T; close S; } else { say("Type unknown!"); } } sub ask_yes_no { my $question = shift; my $default = shift; my $other = 'yes'; $other = 'no' if $default eq 'yes'; print STDERR "\n$question"," [$default] "; chomp(my $ans = ); if ($ans =~ m!$other!) { return $other eq 'yes' } else { return $default eq 'yes' } } sub incver { my ($type, $cv) = @_; my $nversion; $nversion = $cv + .01 if $type eq "PerlModule"; if ($type eq "Automake" || $type eq "Makefile") { my @version = split /\./, $cv; if ($major) { $version[0]++; $version[$_]=0 for (1..$#version); } elsif ($minor) { $version[1]++; $version[$_]=0 for (2..$#version); } else { $version[-1]++ } $nversion = join(".",@version); } return $nversion; } sub getcver { my $type = shift; my $file = shift; my $version = '0.0.1'; if ($type eq "PerlModule") { $version = '0.01'; # this is the correct default for perl modules open PM, $file or die "Cannot open $file: $!\n"; while () { if (m!\$VERSION\s*=\s*(['"])([^'"]+)\1!) { $version = $2; last; } } close PM; } if ($type eq "Automake") { open CONFIGURE, $file or die "Cannot open $file: $!\n"; while () { if (m!AM_INIT_AUTOMAKE\s*\(\s*\w+\s*,\s*(\d+(\.\d+)+)\)!) { $version = $1; last; } } close CONFIGURE } if ($type eq "Makefile") { open MAKEFILE, $file or die "Cannot open $file: $!\n"; while () { if (m!VERSION\s*=\s*(\d+(\.\d+)+)!) { $version = $1; last; } } close MAKEFILE } return $version; } sub say { my $message = shift; print STDERR "$message\n" } sub gettype { my $type; my $file; # Check if this is a perl module if (-f 'Makefile.PL') { $type = 'PerlModule'; open MPL, "Makefile.PL" or die "Cannot open Makefile.PL for reading: $!\n"; my @mpl = ; close MPL; my ($version_from) = grep /VERSION_FROM/, @mpl; $version_from =~ m!VERSION_FROM['"]?\s*=>\s*(['"])([^'"]+)\1!; $file = $2; } elsif (-f 'configure.in' || -f 'configure.ac') { # Check if this is an autoconf/automake distro $type = 'Automake'; $file = 'configure.in'; $file = 'configure.ac' if -f 'configure.ac'; } elsif (-f 'Makefile' || -f 'makefile') { $type = 'Makefile'; $file = 'makefile'; $file = 'Makefile' if -f 'Makefile'; } else { die "This directory is not a known distribution root directory\n" } return ($type,$file) }