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;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to release.pm CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / pciutils / maint