From 2cfe40f2723867d99c5d8a0ef751454cb42d5c97 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 23 Jul 2010 17:56:48 -0400 Subject: [PATCH] factor out boilerplate common to the commands Should have done this a long time ago. TODO: installation; delta file handling --- Pristine/Tar.pm | 98 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ pristine-bz2 | 72 ++++++++---------------------------------- pristine-gz | 66 ++++++-------------------------------- pristine-tar | 92 +++++++++++------------------------------------------ 4 files changed, 139 insertions(+), 189 deletions(-) create mode 100755 Pristine/Tar.pm diff --git a/Pristine/Tar.pm b/Pristine/Tar.pm new file mode 100755 index 0000000..76b62eb --- /dev/null +++ b/Pristine/Tar.pm @@ -0,0 +1,98 @@ +#!/usr/bin/perl +# pristine-tar utility library + +package Pristine::Tar; + +use warnings; +use strict; +use File::Temp; +use Getopt::Long; +use Exporter q{import}; + +our @EXPORT = qw(error message debug vprint doit doit_redir tempdir dispatch + $verbose $debug $keep); + +our $verbose=0; +our $debug=0; +our $keep=0; + +sub error { + die "$0: @_\n"; +} + +sub message { + print STDERR "$0: @_\n"; +} + +sub debug { + message(@_) if $debug; +} + +sub vprint { + message(@_) if $verbose; +} + +sub doit { + vprint(@_); + if (system(@_) != 0) { + error "command failed: @_"; + } +} + +sub doit_redir { + no warnings 'once'; + my ($in, $out, @args) = @_; + vprint(@args, "<", $in, ">", $out); + open INFILE, "<", $in or die("Could not open '$in' for reading: $!\n"); + open OUTFILE, ">", $out or die("Could not open '$out' for reading: $!\n"); + my $pid = open2(">&OUTFILE", "<&INFILE", @args); + waitpid $pid, 0; +} + +sub tempdir { + return File::Temp::tempdir("pristine-tar.XXXXXXXXXX", + TMPDIR => 1, CLEANUP => !$keep); +} + +# Workaround for bug #479317 in perl 5.10. +sub END { + chdir("/"); +} + +sub dispatch { + my %params=@_; + + my %commands=%{$params{commands}}; + my %options=%{$params{options}} if exists $params{options}; + + my $run=sub { + my $command=shift; + my $i=$commands{$command}; + if (! defined $i) { + error "Unknown subcommand \"$command\""; + } + + # Check that the right number of args were passed by user. + if (defined $i->[1] && @_ != $i->[1]) { + $command="usage"; + $i=$commands{$command}; + } + + $i->[0]->(@_); + + exit 1 if $command eq "usage"; + }; + + Getopt::Long::Configure("bundling"); + if (! GetOptions(%options, + "v|verbose!" => \$verbose, + "d|debug!" => \$debug, + "k|keep!" => \$keep) || + ! @ARGV) { + $run->("usage"); + } + + $run->(@ARGV); +} + +1 diff --git a/pristine-bz2 b/pristine-bz2 index d47a1cf..d45013f 100755 --- a/pristine-bz2 +++ b/pristine-bz2 @@ -82,8 +82,8 @@ Licensed under the GPL, version 2. use warnings; use strict; -use File::Temp; -use Getopt::Long; +use Pristine::Tar; +use Pristine::Delta; use File::Basename qw/basename/; use IPC::Open2; use IO::Handle; @@ -99,46 +99,24 @@ use constant BZIP2_METHOD_HUFFMAN => 0x68; my @supported_bzip2_programs = qw(bzip2 pbzip2 zgz); -my $verbose=0; -my $debug=0; -my $keep=0; my $try=0; +dispatch( + commands => { + usage => [\&usage], + genbz2 => [\&genbz2, 2], + genbdelta => [\&gendelta, 2], + }, + options => { + "t|try!" => \$try, + }, +); + sub usage { print STDERR "Usage: pristine-bz2 [-vdkt] gendelta file.bz2 delta\n"; print STDERR " pristine-bz2 [-vdkt] genbz2 delta file\n"; } -sub debug { - print STDERR "debug: @_\n" if $debug; -} - -sub vprint { - print STDERR "pristine-bz2: @_\n" if $verbose; -} - -sub doit { - vprint(@_); - if (system(@_) != 0) { - die "command failed: @_\n"; - } -} - -sub doit_redir { - no warnings 'once'; - my ($in, $out, @args) = @_; - vprint(@args, "<", $in, ">", $out); - open INFILE, "<", $in or die("Could not open '$in' for reading: $!\n"); - open OUTFILE, ">", $out or die("Could not open '$out' for reading: $!\n"); - my $pid = open2(">&OUTFILE", "<&INFILE", @args); - waitpid $pid, 0; -} - -sub tempdir { - return File::Temp::tempdir("pristine-bz2.XXXXXXXXXX", - TMPDIR => 1, CLEANUP => !$keep); -} - sub readbzip2 { my $filename = shift; my $chars; @@ -369,27 +347,3 @@ sub gendelta { doit("cat", $delta); } } - -Getopt::Long::Configure("bundling"); -if (! GetOptions( - "v|verbose!" => \$verbose, - "d|debug!" => \$debug, - "k|keep!" => \$keep, - "t|try!" => \$try, - ) || @ARGV != 3) { - usage(); - exit 1; -} - -my $command=shift; -if ($command eq 'genbz2') { - genbz2(@ARGV); -} -elsif ($command eq 'gendelta') { - gendelta(@ARGV); -} -else { - print STDERR "Unknown subcommand \"$command\"\n"; - usage(); - exit 1; -} diff --git a/pristine-gz b/pristine-gz index dc9a43d..07c7d62 100755 --- a/pristine-gz +++ b/pristine-gz @@ -89,8 +89,8 @@ Licensed under the GPL, version 2. use warnings; use strict; -use File::Temp; -use Getopt::Long; +use Pristine::Tar; +use Pristine::Delta; use File::Basename qw/basename/; use IPC::Open2; @@ -138,45 +138,19 @@ use constant { GZIP_OS_UNKNOWN => 255, }; -my $verbose=0; -my $debug=0; -my $keep=0; +dispatch( + commands => { + usage => [\&usage], + gendelta => [\&gendelta, 2], + gengz => [\&gengz, 2], + }, +); sub usage { print STDERR "Usage: pristine-gz [-vdk] gendelta file.gz delta\n"; print STDERR " pristine-gz [-vdk] gengz delta file\n"; } -sub debug { - print STDERR "debug: @_\n" if $debug; -} - -sub vprint { - print STDERR "pristine-gz: @_\n" if $verbose; -} - -sub doit { - vprint(@_); - if (system(@_) != 0) { - die "command failed: @_\n"; - } -} - -sub doit_redir { - no warnings 'once'; - my ($in, $out, @args) = @_; - vprint(@args, "<", $in, ">", $out); - open INFILE, "<", $in or die("Could not open '$in' for reading: $!\n"); - open OUTFILE, ">", $out or die("Could not open '$out' for reading: $!\n"); - my $pid = open2(">&OUTFILE", "<&INFILE", @args); - waitpid $pid, 0; -} - -sub tempdir { - return File::Temp::tempdir("pristine-gz.XXXXXXXXXX", - TMPDIR => 1, CLEANUP => !$keep); -} - sub readgzip { my $filename = shift; my $chars; @@ -453,25 +427,3 @@ sub gendelta { } } -Getopt::Long::Configure("bundling"); -if (! GetOptions( - "v|verbose!" => \$verbose, - "d|debug!" => \$debug, - "k|keep!" => \$keep, - ) || @ARGV != 3) { - usage(); - exit 1; -} - -my $command=shift; -if ($command eq 'gengz') { - gengz(@ARGV); -} -elsif ($command eq 'gendelta') { - gendelta(@ARGV); -} -else { - print STDERR "Unknown subcommand \"$command\"\n"; - usage(); - exit 1; -} diff --git a/pristine-tar b/pristine-tar index 329af07..2be0d44 100755 --- a/pristine-tar +++ b/pristine-tar @@ -165,10 +165,10 @@ Licensed under the GPL, version 2 or above. use warnings; use strict; -use File::Temp; +use Pristine::Tar; +use Pristine::Delta; use File::Path; use File::Basename; -use Getopt::Long; use Cwd qw{getcwd abs_path}; # magic identification @@ -183,15 +183,27 @@ use constant GZIP_METHOD_DEFLATE => 0x08; # compression methods, 'h' for Bzip2 ('H'uffman coding), '0' for Bzip1 (deprecated) use constant BZIP2_METHOD_HUFFMAN => 0x68; -my $verbose=0; -my $debug=0; -my $keep=0; -my $message; - # Force locale to C since tar may output utf-8 filenames differently # depending on the locale. $ENV{LANG}='C'; +my $message; + +dispatch( + commands => { + usage => [\&usage], + gentar => [\&gentar, 2], + gendelta => [\&gendelta, 2], + commit => [\&commit, 1], + ci => [\&commit, 1], + checkout => [\&checkout, 1], + co => [\&checkout, 1], + }, + options => { + "m|message=s" => \$message, + }, +); + sub usage { print STDERR "Usage: pristine-tar [-vdk] gendelta tarball delta\n"; print STDERR " pristine-tar [-vdk] gentar delta tarball\n"; @@ -200,39 +212,6 @@ sub usage { exit 1; } -sub error { - die "pristine-tar: @_\n"; -} - -sub message { - print STDERR "pristine-tar: @_\n"; -} - -sub debug { - message(@_) if $debug; -} - -sub vprint { - message(@_) if $verbose; -} - -sub doit { - vprint(@_); - if (system(@_) != 0) { - error "command failed: @_"; - } -} - -sub tempdir { - return File::Temp::tempdir("pristine-tar.XXXXXXXXXX", - TMPDIR => 1, CLEANUP => !$keep); -} - -# Workaround for bug #479317 in perl 5.10. -sub END { - chdir("/"); -} - sub recreatetarball { my $tempdir=shift; my $source=shift; @@ -786,36 +765,3 @@ sub checkout { message("successfully generated $tarball"); } - -Getopt::Long::Configure("bundling"); -if (! GetOptions( - "m|message=s" => \$message, - "v|verbose!" => \$verbose, - "d|debug!" => \$debug, - "k|keep!" => \$keep)) { - usage(); -} - -usage unless @ARGV; -my $command=shift; - -if ($command eq 'gentar') { - usage unless @ARGV == 2; - gentar(@ARGV); -} -elsif ($command eq 'gendelta') { - usage unless @ARGV == 2; - gendelta(@ARGV); -} -elsif ($command eq 'commit' || $command eq 'ci') { - usage unless @ARGV >= 1; - commit(@ARGV); -} -elsif ($command eq 'checkout' || $command eq 'co') { - usage unless @ARGV == 1; - checkout(@ARGV); -} -else { - print STDERR "Unknown subcommand \"$command\"\n"; - usage(); -} -- 2.7.4