[Bps-public-commit] r15428 - in RT-RE: lib lib/RT lib/RT/RE lib/RT/RE/CLI
ruz at bestpractical.com
ruz at bestpractical.com
Mon Aug 25 14:52:41 EDT 2008
Author: ruz
Date: Mon Aug 25 14:52:40 2008
New Revision: 15428
Added:
RT-RE/bin/
RT-RE/bin/rtre (contents, props changed)
RT-RE/lib/
RT-RE/lib/RT/
RT-RE/lib/RT/RE/
RT-RE/lib/RT/RE.pm
RT-RE/lib/RT/RE/App.pm
RT-RE/lib/RT/RE/CLI/
RT-RE/lib/RT/RE/CLI.pm
RT-RE/lib/RT/RE/CLI/Pack.pm
RT-RE/lib/RT/RE/CLI/Release.pm
Log:
* initial import
Added: RT-RE/bin/rtre
==============================================================================
--- (empty file)
+++ RT-RE/bin/rtre Mon Aug 25 14:52:40 2008
@@ -0,0 +1,18 @@
+#!/usr/bin/perl
+
+
+unless (@ARGV) {
+ print STDERR <<END;
+
+Usage:
+$0 release -b //mirror/bps/rt/3.8 3.8.3rc3
+$0 pack //mirror/bps/rt/3.8/tags/3.8.1rc1
+END
+
+ exit 1;
+}
+
+require RT::RE::App;
+my $app = RT::RE::App->new;
+$app->dispatch;
+
Added: RT-RE/lib/RT/RE.pm
==============================================================================
--- (empty file)
+++ RT-RE/lib/RT/RE.pm Mon Aug 25 14:52:40 2008
@@ -0,0 +1,28 @@
+package RT::RE;
+
+use 5.008003;
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+=head1 NAME
+
+RT::RE - RT release engeniering
+
+=head1 DESCRIPTION
+
+Very simple and stupid RT releasing tool.
+
+=head1 AUTHOR
+
+Ruslan Zakirov E<lt>ruz at bestpractical.comE<gt>
+
+=head1 LICENSE
+
+Under the same terms as perl itself.
+
+=cut
+
+
+1;
Added: RT-RE/lib/RT/RE/App.pm
==============================================================================
--- (empty file)
+++ RT-RE/lib/RT/RE/App.pm Mon Aug 25 14:52:40 2008
@@ -0,0 +1,9 @@
+package RT::RE::App;
+
+use strict;
+use warnings;
+use base qw(App::CLI);
+
+sub command_class { return 'RT::RE::CLI' }
+
+1;
Added: RT-RE/lib/RT/RE/CLI.pm
==============================================================================
--- (empty file)
+++ RT-RE/lib/RT/RE/CLI.pm Mon Aug 25 14:52:40 2008
@@ -0,0 +1,31 @@
+package RT::RE::CLI;
+
+use base qw(App::CLI::Command);
+
+sub ask_Yn {
+ print "[y] ";
+ my $a = <STDIN>;
+ chomp $a;
+ return 1 if $a =~ /^(y(es)?)?$/i;
+ return 0;
+}
+
+sub ask_Ny {
+ print "[n] ";
+ my $a = <STDIN>;
+ chomp $a;
+ return 1 if $a =~ /^y(es)?$/i;
+ return 0;
+}
+
+sub parse_version {
+ my $self = shift;
+ my $v = shift;
+
+ die "Incorrect version - $v"
+ unless $v =~ /^([1-9]\.[1-9]?[0-9]\.[1-9]?[0-9])(rc([1-9][0-9]?))?$/;
+ my ($main, $rc) = ($1, $3);
+ return ($main, $rc);
+}
+
+1;
Added: RT-RE/lib/RT/RE/CLI/Pack.pm
==============================================================================
--- (empty file)
+++ RT-RE/lib/RT/RE/CLI/Pack.pm Mon Aug 25 14:52:40 2008
@@ -0,0 +1,48 @@
+package RT::RE::CLI::Pack;
+
+use strict;
+use warnings;
+use base qw(RT::RE::CLI);
+
+use RT::RE::CLI::Pack;
+
+use File::Temp qw(tempdir);
+use Cwd qw(getcwd);
+
+sub run {
+ my $self = shift;
+ my $path = shift;
+
+ my $as = shift;
+ unless ( $as ) {
+ ($as) = ($path =~ /([^\\\/]+)$/);
+ }
+
+ my $cwd = getcwd();
+
+ my $tmp_dir = tempdir( CLEANUP => 1 );
+
+ my $copath = "$tmp_dir/$as";
+ defined `svk co --export $path $copath`
+ or !$? or die "couldn't export '$path'";
+
+ chdir $copath;
+ defined `autoconf` or !$? or die "autoconf failed in '$copath'";
+
+ {
+ local $ENV{'INSTALL'} = 'install-sh';
+ local $ENV{'PERL'} = '/usr/bin/perl';
+ `./configure --with-db-type=SQLite --enable-layout=relative --with-web-handler=standalone`
+ or die "couldn't configure";
+ }
+ #XXX: cleanup
+
+ chdir '..';
+ `tar -czvf $cwd/$as.tar.gz $as` or !$? or die "couldn't create tarball";
+
+ chdir $cwd;
+
+ `gpg --detach-sign $as.tar.gz` or !$? or die "couldn't sign tarball";
+}
+
+1;
Added: RT-RE/lib/RT/RE/CLI/Release.pm
==============================================================================
--- (empty file)
+++ RT-RE/lib/RT/RE/CLI/Release.pm Mon Aug 25 14:52:40 2008
@@ -0,0 +1,109 @@
+package RT::RE::CLI::Release;
+
+use strict;
+use warnings;
+use base qw(RT::RE::CLI);
+
+use RT::RE::CLI::Pack;
+
+use File::Temp qw(tempdir);
+
+sub options {
+ return ('base|b=s' => 'base');
+}
+
+sub run {
+ my $self = shift;
+ my @args = @_;
+ my $base = $self->{'base'} or die "no base";
+
+ my $version = shift @args or die "no version to release provided";
+ my ($vmain, $rc) = $self->parse_version( $version );
+
+ if ( defined `svk info $base/tags/$version` && !$? ) {
+ die "$version already exists(tagged). Want `$0 pack` instead?";
+ }
+ if ( $rc && defined `svk ls $base/tags/$vmain` && !$? ) {
+ die "$vmain already exists(tagged). Couldn't release an RC of existing release.";
+ }
+ my $releng_branch = $self->releng_branch( $vmain );
+ $self->munge_version( $releng_branch, $version );
+ my $tag = $self->release( $releng_branch, $version );
+ $self->pack( $tag, $version );
+
+ return 1;
+}
+
+sub munge_version {
+ my $self = shift;
+ my $path = shift;
+ my $v = shift;
+
+ my $tmp_dir = tempdir();
+
+ print "Checkout into $tmp_dir\n";
+ defined `svk co $path $tmp_dir/munge_version`
+ or !$? or die "couldn't checkout '$path'";
+
+ defined `perl -i -wpe 's/(AC_INIT\\(RT,\\s*)[^,]+/\${1}\Q$v\E/' $tmp_dir/munge_version/configure.ac`
+ or !$? or die "couldn't replace version in configure.ac";
+
+ print "Munged version:\n";
+ print `svk di $tmp_dir/munge_version/configure.ac`;
+
+ my $out;
+ defined ($out = `svk ci -m '* update version' $tmp_dir/munge_version/configure.ac`)
+ or !$? or die "couldn't commit version change";
+
+ print $out;
+
+ return;
+}
+
+sub release {
+ my $self = shift;
+ my $path = shift;
+ my $v = shift;
+ my $base = $self->{'base'};
+
+ print "Tagging...\n";
+
+ my $tag_path = "$base/tags/$v";
+
+ my $out;
+ defined ($out = `svk cp -m '* release $v' $path $tag_path`)
+ or !$? or die "couldn't release '$v'";
+ print $out;
+
+ return $tag_path;
+}
+
+sub pack {
+ my $self = shift;
+ my $cmd = new RT::RE::CLI::Pack;
+ return $cmd->run( @_ );
+}
+
+sub releng_branch {
+ my $self = shift;
+ my $v = shift;
+ my $base = $self->{'base'};
+
+ my $releng_branch = "$base/branches/$v-releng";
+ if ( !defined `svk info $releng_branch` || $? ) {
+ print "No releng branch '$releng_branch'.\nWant to create? ";
+ exit 0 unless $self->ask_Yn;
+
+ print `svk cp -m '* releng branch for $v' $base/trunk $releng_branch`
+ or !$? or die "couldn't create releng branch";
+ } else {
+ print "Releng branch '$releng_branch' already exists.\nWant to merge from trunk? ";
+ return $releng_branch unless $self->ask_Ny;
+
+ print `svk sm -lm '* merge changes from trunk' $base/trunk $releng_branch`
+ or !$? or die "couldn't merge changes from trunk";
+ }
+ return $releng_branch;
+}
+
+1;
More information about the Bps-public-commit
mailing list