maint/release.pm

   1 #!/usr/bin/perl
   2 # A simple system for making software releases
   3 # (c) 2003 Martin Mares <mj@ucw.cz>
   4
   5 package UCW::Release;
   6 use strict;
   7 use warnings;
   8 use Getopt::Long;
   9
  10 our $verbose = 0;
  11
  12 sub new($$) {
  13         my ($class,$basename) = @_;
  14         my $s = {
  15                 "PACKAGE" => $basename,
  16                 "rules" => [
  17                         # p=preprocess, s=subst, -=discard
  18                         '(^|/)(CVS|\.arch-ids|{arch}|tmp)/' => '-',
  19                         '\.(lsm|spec)$' => 'ps',
  20                         '(^|/)README$' => 's'
  21                         ],
  22                 "conditions" => {
  23                         },
  24                 "DATE" => `date '+%Y-%m-%d' | tr -d '\n'`,
  25                 "LSMDATE" => `date '+%y%m%d' | tr -d '\n'`,
  26                 "distfiles" => [
  27                         ],
  28                 "archivedir" => "/home/mj/tmp/archives/$basename",
  29                 "uploads" => [
  30                         ],
  31                 # Options
  32                 "do_test" => 1,
  33                 "do_patch" => 1,
  34                 "diff_against" => "",
  35                 "do_upload" => 1
  36         };
  37         bless $s;
  38         return $s;
  39 }
  40
  41 sub GetVersionFromFile($) {
  42         my ($s,$file,$rx) = @_;
  43         open F, $file or die "Unable to open $file for version autodetection";
  44         while (<F>) {
  45                 chomp;
  46                 if (/$rx/) {
  47                         $s->{"VERSION"} = $1;
  48                         print "Detected version $1 from $file\n" if $verbose;
  49                         last;
  50                 }
  51         }
  52         close F;
  53         if (!defined $s->{"VERSION"}) { die "Failed to auto-detect version"; }
  54         return $s->{"VERSION"};
  55 }
  56
  57 sub GetVersionsFromChangelog($) {
  58         my ($s,$file,$rx) = @_;
  59         open F, $file or die "Unable to open $file for version autodetection";
  60         while (<F>) {
  61                 chomp;
  62                 if (/$rx/) {
  63                         if (!defined $s->{"VERSION"}) {
  64                                 $s->{"VERSION"} = $1;
  65                                 print "Detected version $1 from $file\n" if $verbose;
  66                         } elsif ($s->{"VERSION"} eq $1) {
  67                                 # do nothing
  68                         } else {
  69                                 $s->{"OLDVERSION"} = $1;
  70                                 print "Detected previous version $1 from $file\n" if $verbose;
  71                                 last;
  72                         }
  73                 }
  74         }
  75         close F;
  76         if (!defined $s->{"VERSION"}) { die "Failed to auto-detect version"; }
  77         return $s->{"VERSION"};
  78 }
  79
  80 sub InitDist($) {
  81         my ($s,$dd) = @_;
  82         $s->{"DISTDIR"} = $dd;
  83         print "Initializing dist directory $dd\n" if $verbose;
  84         `rm -rf $dd`; die if $?;
  85         `mkdir -p $dd`; die if $?;
  86 }
  87
  88 sub ExpandVar($$) {
  89         my ($s,$v) = @_;
  90         if (defined $s->{$v}) {
  91                 return $s->{$v};
  92         } else {
  93                 die "Reference to unknown variable $v";
  94         }
  95 }
  96
  97 sub CopyFile($$$$) {
  98         my ($s,$f,$dir,$action) = @_;
  99
 100         (my $d = $f) =~ s@(^|/)[^/]*$@@;
 101         $d = "$dir/$d";
 102         -d $d || `mkdir -p $d`; die if $?;
 103
 104         my $preprocess = ($action =~ /p/);
 105         my $subst = ($action =~ /s/);
 106         if ($preprocess || $subst) {
 107                 open I, "$f" or die "open($f): $?";
 108                 open O, ">$dir/$f" or die "open($dir/$f): $!";
 109                 my @ifs = ();   # stack of conditions, 1=satisfied
 110                 my $empty = 0;  # last line was empty
 111                 my $is_makefile = ($f =~ /(Makefile|.mk)$/);
 112                 while (<I>) {
 113                         if ($subst) {
 114                                 s/@([0-9A-Za-z_]+)@/$s->ExpandVar($1)/ge;
 115                         }
 116                         if ($preprocess) {
 117                                 if (/^#/ || $is_makefile) {
 118                                         if (/^#?ifdef\s+(\w+)/) {
 119                                                 if (defined ${$s->{"conditions"}}{$1}) {
 120                                                         push @ifs, ${$s->{"conditions"}}{$1};
 121                                                         next;
 122                                                 }
 123                                                 push @ifs, 0;
 124                                         } elsif (/^#ifndef\s+(\w+)/) {
 125                                                 if (defined ${$s->{"conditions"}}{$1}) {
 126                                                         push @ifs, -${$s->{"conditions"}}{$1};
 127                                                         next;
 128                                                 }
 129                                                 push @ifs, 0;
 130                                         } elsif (/^#if\s+/) {
 131                                                 push @ifs, 0;
 132                                         } elsif (/^#?endif/) {
 133                                                 my $x = pop @ifs;
 134                                                 defined $x or die "Improper nesting of conditionals";
 135                                                 $x && next;
 136                                         } elsif (/^#?else/) {
 137                                                 my $x = pop @ifs;
 138                                                 defined $x or die "Improper nesting of conditionals";
 139                                                 push @ifs, -$x;
 140                                                 $x && next;
 141                                         }
 142                                 }
 143                                 @ifs && $ifs[$#ifs] < 0 && next;
 144                                 if (/^$/) {
 145                                         $empty && next;
 146                                         $empty = 1;
 147                                 } else { $empty = 0; }
 148                         }
 149                         print O;
 150                 }
 151                 close O;
 152                 close I;
 153                 ! -x $f or chmod(0755, "$dir/$f") or die "chmod($dir/$f): $!";
 154         } else {
 155                 `cp -a $f $dir/$f`; die if $?;
 156         }
 157 }
 158
 159 sub GenPackage($) {
 160         my ($s) = @_;
 161         $s->{"PKG"} = $s->{"PACKAGE"} . "-" . $s->{"VERSION"};
 162         my $dir = $s->{"DISTDIR"} . "/" . $s->{"PKG"};
 163         print "Generating $dir\n";
 164
 165         FILES: foreach my $f (`find . -type f`) {
 166                 chomp $f;
 167                 $f =~ s/^\.\///;
 168                 my $action = "";
 169                 my @rules = @{$s->{"rules"}};
 170                 while (@rules) {
 171                         my $rule = shift @rules;
 172                         my $act = shift @rules;
 173                         if ($f =~ $rule) {
 174                                 $action = $act;
 175                                 last;
 176                         }
 177                 }
 178                 ($action =~ /-/) && next FILES;
 179                 print "$f ($action)\n" if $verbose;
 180                 $s->CopyFile($f, $dir, $action);
 181         }
 182
 183         if (-f "$dir/Makefile") {
 184                 print "Cleaning up\n";
 185                 `cd $dir && make distclean >&2`; die if $?;
 186         }
 187
 188         my $arch = "$dir.tar.gz";
 189         print "Creating $arch\n";
 190         my $tarvv = $verbose ? "vv" : "";
 191         `tar cz${tarvv}f $arch $dir >&2`; die if $?;
 192         push @{$s->{"distfiles"}}, $arch;
 193
 194         my $adir = $s->{"archivedir"};
 195         my $afile = $adir . "/" . $s->{"PKG"} . ".tar.gz";
 196         print "Archiving $arch in $afile\n";
 197         -d $adir or `mkdir -p $adir`;
 198         `cp $arch $afile`; die if $?;
 199
 200         return $dir;
 201 }
 202
 203 sub GenFile($$) {
 204         my ($s,$f) = @_;
 205         my $sf = $s->{"DISTDIR"} . "/" . $s->{"PKG"} . "/$f";
 206         my $df = $s->{"DISTDIR"} . "/$f";
 207         print "Generating $df\n";
 208         `cp $sf $df`; die if $?;
 209         push @{$s->{"distfiles"}}, $df;
 210 }
 211
 212 sub ParseOptions($) {
 213         my ($s) = @_;
 214         GetOptions(
 215                 "verbose!" => \$verbose,
 216                 "test!" => \$s->{"do_test"},
 217                 "patch!" => \$s->{"do_patch"},
 218                 "diff-against=s" => \$s->{"diff_against"},
 219                 "upload!" => \$s->{"do_upload"}
 220         ) || die "Syntax: release [--verbose] [--test] [--nopatch] [--diff-against=<version>] [--noupload]";
 221 }
 222
 223 sub Test($) {
 224         my ($s) = @_;
 225         my $dd = $s->{"DISTDIR"};
 226         my $pkg = $s->{"PKG"};
 227         my $log = "$dd/$pkg.log";
 228         print "Doing a test compilation\n";
 229         `( cd $dd/$pkg && make ) >$log 2>&1`;
 230         die "There were errors. Please inspect $log" if $?;
 231         `grep -q [Ww]arning $log`;
 232         $? or print "There were warnings! Please inspect $log.\n";
 233         print "Cleaning up\n";
 234         `cd $dd/$pkg && make distclean`; die if $?;
 235 }
 236
 237 sub MakePatch($) {
 238         my ($s) = @_;
 239         my $dd = $s->{"DISTDIR"};
 240         my $pkg1 = $s->{"PKG"};
 241         my $oldver;
 242         if ($s->{"diff_against"} ne "") {
 243                 $oldver = $s->{"diff_against"};
 244         } elsif (defined $s->{"OLDVERSION"}) {
 245                 $oldver = $s->{"OLDVERSION"};
 246         } else {
 247                 die "MakePatch: Don't know which is the previous version";
 248         }
 249         my $pkg0 = $s->{"PACKAGE"} . "-" . $oldver;
 250
 251         my $oldarch = $s->{"archivedir"} . "/" . $pkg0 . ".tar.gz";
 252         -f $oldarch or die "MakePatch: $oldarch not found";
 253         print "Unpacking $pkg0 from $oldarch\n";
 254         `cd $dd && tar xzf $oldarch`; die if $?;
 255
 256         my $diff = $s->{"PACKAGE"} . "-" . $oldver . "-" . $s->{"VERSION"} . ".diff.gz";
 257         print "Creating a patch from $pkg0 to $pkg1: $diff\n";
 258         `cd $dd && diff -ruN $pkg0 $pkg1 | gzip >$diff`; die if $?;
 259         push @{$s->{"distfiles"}}, "$dd/$diff";
 260 }
 261
 262 sub Upload($) {
 263         my ($s) = @_;
 264         foreach my $u (@{$s->{"uploads"}}) {
 265                 my $url = $u->{"url"};
 266                 print "Upload to $url :\n";
 267                 my @files = ();
 268                 my $filter = $u->{"filter"} || ".*";
 269                 foreach my $f (@{$s->{"distfiles"}}) {
 270                         if ($f =~ $filter) {
 271                                 print "\t$f\n";
 272                                 push @files, $f;
 273                         }
 274                 }
 275                 print "<confirm> "; <STDIN>;
 276                 if ($url =~ m@^scp://([^/]+)(.*)@) {
 277                         $, = " ";
 278                         my $cmd = "scp @files $1:$2\n";
 279                         `$cmd`; die if $?;
 280                 } elsif ($url =~ m@ftp://([^/]+)(.*)@) {
 281                         my $host = $1;
 282                         my $dir = $2;
 283                         open FTP, "|ftp -v $host" or die;
 284                         print FTP "cd $dir\n";
 285                         foreach my $f (@files) {
 286                                 (my $ff = $f) =~ s@.*\/([^/].*)@$1@;
 287                                 print FTP "put $f $ff\n";
 288                         }
 289                         print FTP "bye\n";
 290                         close FTP;
 291                         die if $?;
 292                 } else {
 293                         die "Don't know how to handle this URL scheme";
 294                 }
 295         }
 296 }
 297
 298 sub Dispatch($) {
 299         my ($s) = @_;
 300         $s->Test if $s->{"do_test"};
 301         $s->MakePatch if $s->{"do_patch"};
 302         $s->Upload if $s->{"do_upload"};
 303 }
 304
 305 1;