[thirdparty/pciutils.git] / maint / release.pm

#!/usr/bin/perl
# A simple system for making software releases
# (c) 2003--2006 Martin Mares <mj@ucw.cz>

package UCW::Release;
use strict;
use warnings;
use Getopt::Long;

our $verbose = 0;

sub new($$) {
	my ($class,$basename) = @_;
	my $s = {
		"PACKAGE" => $basename,
		"rules" => [
			# p=preprocess, s=subst, -=discard
			'(^|/)(CVS|\.arch-ids|{arch}|\.git|tmp)/' => '-',
			'\.(lsm|spec)$' => 'ps',
			'(^|/)README$' => 's'
			],
		"directories" => [
			],
		"conditions" => {
			},
		"DATE" => `date '+%Y-%m-%d' | tr -d '\n'`,
		"LSMDATE" => `date '+%y%m%d' | tr -d '\n'`,
		"distfiles" => [
			],
		"archivedir" => "/home/mj/tmp/archives/$basename",
		"uploads" => [
			],
		# Options
		"do_test" => 1,
		"do_patch" => 1,
		"diff_against" => "",
		"do_upload" => 1
	};
	bless $s;
	return $s;
}

sub GetVersionFromFile($) {
	my ($s,$file,$rx) = @_;
	open F, $file or die "Unable to open $file for version autodetection";
	while (<F>) {
		chomp;
		if (/$rx/) {
			$s->{"VERSION"} = $1;
			print "Detected version $1 from $file\n" if $verbose;
			last;
		}
	}
	close F;
	if (!defined $s->{"VERSION"}) { die "Failed to auto-detect version"; }
	return $s->{"VERSION"};
}

sub GetVersionsFromChangelog($) {
	my ($s,$file,$rx) = @_;
	open F, $file or die "Unable to open $file for version autodetection";
	while (<F>) {
		chomp;
		if (/$rx/) {
			if (!defined $s->{"VERSION"}) {
				$s->{"VERSION"} = $1;
				print "Detected version $1 from $file\n" if $verbose;
			} elsif ($s->{"VERSION"} eq $1) {
				# do nothing
			} else {
				$s->{"OLDVERSION"} = $1;
				print "Detected previous version $1 from $file\n" if $verbose;
				last;
			}
		}
	}
	close F;
	if (!defined $s->{"VERSION"}) { die "Failed to auto-detect version"; }
	return $s->{"VERSION"};
}

sub InitDist($) {
	my ($s,$dd) = @_;
	$s->{"DISTDIR"} = $dd;
	print "Initializing dist directory $dd\n" if $verbose;
	`rm -rf $dd`; die if $?;
	`mkdir -p $dd`; die if $?;
}

sub ExpandVar($$) {
	my ($s,$v) = @_;
	if (defined $s->{$v}) {
		return $s->{$v};
	} else {
		die "Reference to unknown variable $v";
	}
}

sub CopyFile($$$$) {
	my ($s,$f,$dir,$action) = @_;

	(my $d = $f) =~ s@(^|/)[^/]*$@@;
	$d = "$dir/$d";
	-d $d || `mkdir -p $d`; die if $?;

	my $preprocess = ($action =~ /p/);
	my $subst = ($action =~ /s/);
	if ($preprocess || $subst) {
		open I, "$f" or die "open($f): $?";
		open O, ">$dir/$f" or die "open($dir/$f): $!";
		my @ifs = ();	# stack of conditions, 1=satisfied
		my $empty = 0;	# last line was empty
		my $is_makefile = ($f =~ /(Makefile|.mk)$/);
		while (<I>) {
			if ($subst) {
				s/@([0-9A-Za-z_]+)@/$s->ExpandVar($1)/ge;
			}
			if ($preprocess) {
				if (/^#/ || $is_makefile) {
					if (/^#?ifdef\s+(\w+)/) {
						if (defined ${$s->{"conditions"}}{$1}) {
							push @ifs, ${$s->{"conditions"}}{$1};
							next;
						}
						push @ifs, 0;
					} elsif (/^#ifndef\s+(\w+)/) {
						if (defined ${$s->{"conditions"}}{$1}) {
							push @ifs, -${$s->{"conditions"}}{$1};
							next;
						}
						push @ifs, 0;
					} elsif (/^#if\s+/) {
						push @ifs, 0;
					} elsif (/^#?endif/) {
						my $x = pop @ifs;
						defined $x or die "Improper nesting of conditionals";
						$x && next;
					} elsif (/^#?else/) {
						my $x = pop @ifs;
						defined $x or die "Improper nesting of conditionals";
						push @ifs, -$x;
						$x && next;
					}
				}
				@ifs && $ifs[$#ifs] < 0 && next;
				if (/^$/) {
					$empty && next;
					$empty = 1;
				} else { $empty = 0; }
			}
			print O;
		}
		close O;
		close I;
		! -x $f or chmod(0755, "$dir/$f") or die "chmod($dir/$f): $!";
	} else {
		`cp -a $f $dir/$f`; die if $?;
	}
}

sub GenPackage($) {
	my ($s) = @_;
	$s->{"PKG"} = $s->{"PACKAGE"} . "-" . $s->{"VERSION"};
	my $dd = $s->{"DISTDIR"};
	my $pkg = $s->{"PKG"};
	my $dir = "$dd/$pkg";
	print "Generating $dir\n";

	FILES: foreach my $f (`find . -type f`) {
		chomp $f;
		$f =~ s/^\.\///;
		my $action = "";
		my @rules = @{$s->{"rules"}};
		while (@rules) {
			my $rule = shift @rules;
			my $act = shift @rules;
			if ($f =~ $rule) {
				$action = $act;
				last;
			}
		}
		($action =~ /-/) && next FILES;
		print "$f ($action)\n" if $verbose;
		$s->CopyFile($f, $dir, $action);
	}

	foreach my $d (@{$s->{"directories"}}) {
		`mkdir -p $dir/$d`; die if $?;
	}

	if (-f "$dir/Makefile") {
		print "Cleaning up\n";
		`cd $dir && make distclean >&2`; die if $?;
	}

	print "Creating $dd/$pkg.tar.gz\n";
	my $tarvv = $verbose ? "vv" : "";
	`cd $dd && tar cz${tarvv}f $pkg.tar.gz $pkg >&2`; die if $?;
	push @{$s->{"distfiles"}}, "$dd/$pkg.tar.gz";

	my $adir = $s->{"archivedir"};
	my $afile = "$adir/$pkg.tar.gz";
	print "Archiving to $afile\n";
	-d $adir or `mkdir -p $adir`;
	`cp $dd/$pkg.tar.gz $afile`; die if $?;

	return $dir;
}

sub GenFile($$) {
	my ($s,$f) = @_;
	my $sf = $s->{"DISTDIR"} . "/" . $s->{"PKG"} . "/$f";
	my $df = $s->{"DISTDIR"} . "/$f";
	print "Generating $df\n";
	`cp $sf $df`; die if $?;
	push @{$s->{"distfiles"}}, $df;
}

sub ParseOptions($) {
	my ($s) = @_;
	GetOptions(
		"verbose!" => \$verbose,
		"test!" => \$s->{"do_test"},
		"patch!" => \$s->{"do_patch"},
		"diff-against=s" => \$s->{"diff_against"},
		"upload!" => \$s->{"do_upload"}
	) || die "Syntax: release [--verbose] [--test] [--nopatch] [--diff-against=<version>] [--noupload]";
}

sub Test($) {
	my ($s) = @_;
	my $dd = $s->{"DISTDIR"};
	my $pkg = $s->{"PKG"};
	my $log = "$dd/$pkg.log";
	print "Doing a test compilation\n";
	`( cd $dd/$pkg && make ) >$log 2>&1`;
	die "There were errors. Please inspect $log" if $?;
	`grep -q [Ww]arning $log`;
	$? or print "There were warnings! Please inspect $log.\n";
	print "Cleaning up\n";
	`cd $dd/$pkg && make distclean`; die if $?;
}

sub MakePatch($) {
	my ($s) = @_;
	my $dd = $s->{"DISTDIR"};
	my $pkg1 = $s->{"PKG"};
	my $oldver;
	if ($s->{"diff_against"} ne "") {
		$oldver = $s->{"diff_against"};
	} elsif (defined $s->{"OLDVERSION"}) {
		$oldver = $s->{"OLDVERSION"};
	} else {
		print "WARNING: No previous version known. No patch generated.\n";
		return;
	}
	my $pkg0 = $s->{"PACKAGE"} . "-" . $oldver;

	my $oldarch = $s->{"archivedir"} . "/" . $pkg0 . ".tar.gz";
	-f $oldarch or die "MakePatch: $oldarch not found";
	print "Unpacking $pkg0 from $oldarch\n";
	`cd $dd && tar xzf $oldarch`; die if $?;

	my $diff = $s->{"PACKAGE"} . "-" . $oldver . "-" . $s->{"VERSION"} . ".diff.gz";
	print "Creating a patch from $pkg0 to $pkg1: $diff\n";
	`cd $dd && diff -ruN $pkg0 $pkg1 | gzip >$diff`; die if $?;
	push @{$s->{"distfiles"}}, "$dd/$diff";
}

sub Upload($) {
	my ($s) = @_;
	foreach my $u (@{$s->{"uploads"}}) {
		my $url = $u->{"url"};
		print "Upload to $url :\n";
		my @files = ();
		my $filter = $u->{"filter"} || ".*";
		foreach my $f (@{$s->{"distfiles"}}) {
			if ($f =~ $filter) {
				print "\t$f\n";
				push @files, $f;
			}
		}
		print "<confirm> "; <STDIN>;
		if ($url =~ m@^scp://([^/]+)(.*)@) {
			$, = " ";
			my $host = $1;
			my $dir = $2;
			$dir =~ s@^/~@~@;
			$dir =~ s@^/\./@@;
			my $cmd = "scp @files $host:$dir\n";
			`$cmd`; die if $?;
		} elsif ($url =~ m@ftp://([^/]+)(.*)@) {
			my $host = $1;
			my $dir = $2;
			open FTP, "|ftp -v $host" or die;
			print FTP "cd $dir\n";
			foreach my $f (@files) {
				(my $ff = $f) =~ s@.*\/([^/].*)@$1@;
				print FTP "put $f $ff\n";
			}
			print FTP "bye\n";
			close FTP;
			die if $?;
		} else {
			die "Don't know how to handle this URL scheme";
		}
	}
}

sub Dispatch($) {
	my ($s) = @_;
	$s->Test if $s->{"do_test"};
	$s->MakePatch if $s->{"do_patch"};
	$s->Upload if $s->{"do_upload"};
}

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