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