I am now using brian d foy's release script, with my own modifications. Here's a patch, for anyone who cares. The changes are basically:
- Determine dist name from make dist output
- Die if $config data not set
- Set processor type and file type in config file
- Allow to continue if CVS check turns up only unknown files
- Add support for my own journal-posting script
- Include Changes and README in SF.net posting
- Clean up a bit, including changing some constant strings to $config values
The only pudge-specific things in the script now are my own personal preference for release name on SF.net ($ver instead of $module-$ver), the addition of the journal stuff, and the inclusion of README (probably OK for most people) and Changes (which fits a specific format, specifically, everything from the first line to the next line that has non-whitespace in the first column) in SF.net.
Also, if anyone cares, the script requires two modules not listed in its Makefile.PL, ConfigReader::Simple and Test::File, both of which fail tests.
Thanks to brian d foy for the script, it is going to save me a lot of pain.
[pudge@bourque src]$ diff -u release-0.10/release release-0.10.mod/release
--- release-0.10/release Wed Dec 11 17:38:20 2002
+++ release-0.10.mod/release Sun Mar 2 14:50:10 2003
@@ -2,8 +2,6 @@
# $Id: release,v 1.20 2002/12/11 22:38:20 comdog Exp $
use strict;
-use lib qw(/usr/local/src/cpan/build/Crypt-SSLeay-0.45/lib);
-
use CGI qw(-oldstyle_urls);
use ConfigReader::Simple;
use LWP::UserAgent;
@@ -14,6 +12,9 @@
my $Conf = '.releaserc';
my $Debug = $ENV{RELEASE_DEBUG} || 0;
+my $local = $ARGV[0];
+my $remote = $ARGV[1] || $ARGV[0];
+
=head1 NAME
release - upload files to CPAN and SourceForge
@@ -151,6 +152,9 @@
# read the configuration
my $config = ConfigReader::Simple->new( $Conf );
die "Could not get configuration data\n" unless ref $config;
+for (qw( cpan_user sf_user sf_group_id sf_package_id )) {
+ die "Missing configuration data: $_\n" unless length $config->$_;
+}
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# set up the globals
@@ -225,6 +229,13 @@
my $messages = `make tardist 2>&1`;
+if (!$local)
+ {
+ ($local) = $messages =~ /^gzip.+?\b(\S+\.tar)$/m;
+ $local .= '.gz';
+ $remote = $local;
+ }
+
print "done\n";
}
@@ -254,17 +265,19 @@
print "Checking state of CVS... ";
-my @cvs_update = `cvs update 2>&1`;
+# i don't want cvs update to happen automatically, so added -n -- pudge
+my @cvs_update = `cvs -n update 2>&1`;
chomp( @cvs_update );
-my @cvs_states = qw( C M U A ? );
+my @cvs_states = qw( C M U P A ? );
my %cvs_state;
my %message = (
- C => 'These files have conflicts',
- M => 'These files have not been checked in',
- U => 'These files were missing and have been updated',
- A => 'These files were added but not checked in',
- '?' => q|I don't know about these files|,
+ C => 'These files have conflicts',
+ M => 'These files have not been checked in',
+ U => 'These files need to be updated',
+ P => 'These files need to be patched',
+ A => 'These files were added but not checked in',
+ '?' => q|I don't know about these files|,
);
foreach my $state ( @cvs_states )
@@ -279,20 +292,27 @@
local $" = "\n\t";
my $rule = "-" x 50;
-my $count;
+my($count, $question_count);
foreach my $key ( sort keys %cvs_state )
{
my $list = $cvs_state{$key};
next unless @$list;
- $count += @$list;
+ $count += @$list unless $key eq '?';
+ $question_count += @$list if $key eq '?';
- print "\t$message{$key}\n\t$rule\n\t@$list\n\n";
+ print "\n\t$message{$key}\n\t$rule\n\t@$list\n";
}
-die "\nERROR: CVS is not up-to-date: Can't release files\n"
+die "\nERROR: CVS is not up-to-date ($count files): Can't release files\n"
if $count;
+if ($question_count) {
+ print "\nWARNING: CVS is not up-to-date ($question_count files unknown); ",
+ "continue anwyay? [Ny] " ;
+ die "Exiting\n" unless <> =~ /^[yY]/;
+}
+
print "CVS up-to-date\n";
}
@@ -303,9 +323,9 @@
my @Sites = qw(pause.perl.org upload.sourceforge.net);
-my $local = $ARGV[0];
-my $remote = $ARGV[1] || $ARGV[0];
my( $release ) = $remote =~ m/^(.*?)(?:\.tar\.gz)?$/g;
+# i want just the version -- pudge
+$release =~ s/^.+-([\d.]+)$/$1/;
print "Release name is $release\n";
foreach my $site ( @Sites )
@@ -411,7 +431,8 @@
print $content if $Debug;
-if( $content =~ m/welcomes.*comdog/i )
+my $sf_user = $config->sf_user;
+if( $content =~ m/welcomes.*$sf_user/i )
{
print "Logged in!\n";
}
@@ -427,7 +448,7 @@
# visit the Quick Release System form
{
my $request = HTTP::Request->new( GET =>
- 'https://sourceforge.net/project/admin/qrs.php?package_id=&group_id=36221'
+ 'https://sourceforge.net/project/admin/qrs.php?package_id=&group_id=' . $config->sf_group_id
);
$cookies->add_cookie_header( $request );
print $request->as_string, "-" x 73, "\n" if $Debug;
@@ -439,6 +460,9 @@
########################################################################
# release the file
{
+my @time = localtime();
+my $date = sprintf "%04d-%02d-%02d", $time[5] + 1900, $time[4] + 1, $time[3];
+
print "Connecting to SourceForge QRS... ";
my $cgi = CGI->new();
my $request = HTTP::Request->new( POST =>
@@ -448,13 +472,13 @@
$cgi->param( 'MAX_FILE_SIZE', 1000000 );
$cgi->param( 'package_id', $config->sf_package_id );
$cgi->param( 'release_name', $release );
-$cgi->param( 'release_date', '2002-10-08' );
+$cgi->param( 'release_date', $date );
$cgi->param( 'status_id', 1 );
$cgi->param( 'file_name', $remote );
-$cgi->param( 'type_id', 5002 );
-$cgi->param( 'processor_id', 8000 );
-$cgi->param( 'release_notes', '' );
-$cgi->param( 'release_changes', '' );
+$cgi->param( 'type_id', $config->sf_type_id || 5002 );
+$cgi->param( 'processor_id', $config->sf_processor_id || 8000 );
+$cgi->param( 'release_notes', get_readme() );
+$cgi->param( 'release_changes', get_changes() );
$cgi->param( 'group_id', $config->sf_group_id );
$cgi->param( 'preformatted', 1 );
$cgi->param( 'submit', 'Release File' );
@@ -463,7 +487,7 @@
$request->content( $cgi->query_string );
$request->header( "Referer",
- "https://sourceforge.net/project/admin/qrs.php?package_id=&group_id=36221"
+ "https://sourceforge.net/project/admin/qrs.php?package_id=&group_id=" . $config->sf_group_id
);
print $request->as_string, "\n", "-" x 73, "\n" if $Debug;
@@ -479,4 +503,68 @@
print "File Released\n";
}
+JOURNAL: {
+print "Submitting to journal... ";
+my $url = submit_useperl_soap();
+if ($url)
+ {
+ print "submitted: $url\n";
+ }
+else
+ {
+ print "unknown error.\n";
+ }
+}
+
print "Done.\n";
+
+
+sub get_readme {
+ open my $fh, ';
+ };
+ return $data;
+}
+
+sub get_changes {
+ open my $fh, '; # get first line
+ while (<$fh>) {
+ if (/^\S/) { # next line beginning with non-whitespace is end
+ last;
+ }
+ $data .= $_;
+ }
+ return $data;
+}
+
+sub submit_useperl_soap {
+ use File::Temp 'tempfile';
+ my $script = quotemeta(
+ '/Users/pudge/Applications/BBEdit 7.0/BBEdit Support' .
+ '/Unix Support/Unix Filters/use perl submit'
+ );
+
+ my($name) = $remote =~ m/^(.*?)(?:\.tar\.gz)?$/g;
+ my $cpan_url = 'http://www.cpan.org/authors/id/' . $config->cpan_user;
+ my $sf_url = 'http://sourceforge.net/project/showfiles.php?group_id=' . $config->sf_group_id;
+ my $changes = get_changes();
+
+ my($fh, $filename) = tempfile();
+ print $fh <the CPAN or SF.net.
+
+(Note: it may take time for the release to propogate to the various download mirrors.)
+
+Changes:
+$changes
+EOT
+
+ chomp(my $output = (`cat $filename | $script 2>&1`)[-1]);
+ return $output;
+}
+
+__END__
