Factorize the code to handle command-line options for the urpm* tools

in a module urpm::args.

6 files changed, 98 insertions, 248 deletions

diff --git a/urpm/args.pm b/urpm/args.pm
index 7ce058c8..5b4c9764 100644
--- a/urpm/args.pm
+++ b/urpm/args.pm
@@ -187,6 +187,20 @@ my %options_spec = (
 	f => sub {
 	    $::query->{version} = $::query->{release} = $::query->{arch} = 1;
 	},
+	'<>' => sub {
+	    my $x = $_[0];
+	    if ($x =~ /\.rpm$/) {
+		if (-r $x) { push @::files, $x }
+		else { print STDERR N("urpmq: cannot read rpm file \"%s\"\n", $x) }
+	    } else {
+		if ($::query->{src}) {
+		    push @::src_names, $x;
+		} else {
+		    push @::names, $x;
+		}
+		$::query->{src} = 0; #- reset switch for next package.
+	    }
+	},
     },
 
     'urpmi.update' => {
diff --git a/urpme b/urpme
index 74f3af6d..3e1a1070 100644
--- a/urpme
+++ b/urpme
@@ -20,11 +20,11 @@
 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
 #We only make good software ;-)
-#use strict qw(subs vars refs);
 use strict;
 use urpm;
+use urpm::args;
 
-my (@nextargv, $root, $test, $parallel, $auto, $matches, $verbose, $maymatch, $usedistrib, $force, $bug, @l);
+our ($root, $test, $parallel, $auto, $matches, $verbose, $maymatch, $usedistrib, $force, $bug, @l);
 my $askok = N("Is this OK?");
 # Translator: Add here the keys which might be pressed in the "No"-case.
 my $noexpr = N("Nn");
@@ -52,23 +52,8 @@ usage:
 }
 
 @ARGV or usage;
-while (defined($_ = shift @ARGV)) {
-    /^--help$/ and do { usage; next };
-    /^--no-locales$/ and do { undef *N; undef *urpm::N; *N = *urpm::N = sub { sprintf(shift @_, @_) }; next };
-    /^--?auto$/ and do { $auto = 1; next };
-    /^--(no-)?test$/ and do { $test = !$1; next };
-    /^--force$/ and do { $force = 1; next };
-    /^--root$/ and do { push @nextargv, \$root; next };
-    /^--use-distrib$/ and do { push @nextargv, \$usedistrib; next };
-    /^--parallel$/ and do { push @nextargv, \$parallel; next };
-    /^-(.*)$/ and do { foreach (split //, $1) {
-	/[\?h]/ and do { usage; next };
-	/a/ and do { $matches = 1; next };
-	/v/ and do { $verbose = 1; next };
-	die N("urpme: unknown option \"-%s\", check usage with --help\n", $1) } next };
-    @nextargv and do { my $r = shift @nextargv; $r and $$r = $_; next };
-    push @l, $_;
-}
+urpm::args::parse_cmdline();
+@l = @ARGV;
 
 my $urpm = new urpm;
 my $state = {};
@@ -77,11 +62,12 @@ my $state = {};
 $verbose or $urpm->{log} = sub {};
 
 #- just configure parallel mode if available.
-$urpm->configure(synthesis => ($parallel and 'none'),
-		 root => $root,
-		 parallel => $parallel,
-		 usedistrib => $usedistrib,
-		 );
+$urpm->configure(
+    synthesis => ($parallel ? 'none' : ''),
+    root => $root,
+    parallel => $parallel,
+    usedistrib => $usedistrib,
+);
 
 #- examine packages...
 my @toremove = $urpm->find_packages_to_remove($state, \@l,
diff --git a/urpmf b/urpmf
index a32033dd..4bf687dc 100755
--- a/urpmf
+++ b/urpmf
@@ -18,9 +18,9 @@
 #- along with this program; if not, write to the Free Software
 #- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
-#use strict qw(subs vars refs);
 use strict;
 use urpm;
+use urpm::args;
 
 sub usage {
     print STDERR N("urpmf version %s
@@ -68,61 +68,30 @@ usage:
 }
 
 #- default options.
-my $update = 0;
-my $media = '';
-my $excludemedia = '';
-my $sortmedia = '';
-my $synthesis = '';
-my $verbose = 0;
-my $quiet;
-my $uniq = '';
-my $pattern = '';
-my $full = '';
-my $env;
-my (%params, %uniq);
+our $update = 0;
+our $media = '';
+our $excludemedia = '';
+our $sortmedia = '';
+our $synthesis = '';
+our $verbose = 0;
+our $quiet;
+our $uniq = '';
+our $pattern = '';
+our $full = '';
+our $env;
+our (%params, %uniq);
 
 #- parse arguments list.
-my $expr;
-while (defined($_ = shift @ARGV)) {
-    /^--help$/ and do { usage; next };
-    /^--no-locales$/ and do { undef *N; undef *urpm::N; *N = *urpm::N = sub { sprintf(shift @_, @_) }; next };
-    /^--update$/ and do { $update = 1; next };
-    /^--media$/ and do { $media = shift @ARGV; next };
-    /^--mediums$/ and do { $media = shift @ARGV; next };
-    /^--exclude-?media$/ and do { $excludemedia = shift @ARGV; next };
-    /^--sort-?media$/ and do { $sortmedia = shift @ARGV; next };
-    /^--synthesis$/ and do { $synthesis = shift @ARGV; next };
-    /^--verbose$/ and do { $verbose = 1; next };
-    /^--quiet$/ and do { $quiet = 1; next };
-    /^--uniq$/ and do { $uniq = 1; next };
-    /^--all$/ and do { $params{$_} = 1
-			 foreach qw(filename group size summary description sourcerpm packager buildhost url
-				    provides requires files conflicts obsoletes); next };
-    /^--name$/ and do { $params{filename} = 1; next };
-    /^--(group|size|epoch|summary|description|sourcerpm|packager|buildhost|url|provides|requires|files|conflicts|obsoletes)$/ and
-      do { $params{$1} = 1; next };
-    /^--env$/ and do { $env = shift @ARGV; next };
-    /^-v$/ and do { $verbose = 1; next };
-    /^-q$/ and do { $quiet = 1; next };
-    /^-u$/ and do { $uniq = 1; next };
-    /^-i$/ and do { $pattern = 'i'; next };
-    /^-f$/ and do { $full = 'full'; next };
-    /^-e$/ and do { $expr .= '('.(shift @ARGV).')'; next };
-    /^-a$/ and do { $expr .= ' && '; next };
-    /^-o$/ and do { $expr .= ' || '; next };
-    /^[!\(\)]$/ and do { $expr .= $_; next };
-    #- assume a regex directly unless a ++ is inside the string, someother to use ?
-    /\+\+/ and $_ = quotemeta $_;
-    $expr .= 'm{'.$_.'}'.$pattern;
-}
+our $expr;
+urpm::args::parse_cmdline();
 
 my $urpm = new urpm;
 $verbose or $urpm->{log} = sub {};
 
 foreach (scalar(keys %params)) {
-    $_ eq 0 and do { defined $quiet or $quiet = 1; $params{files} = 1 };
-    $_ eq 1 and do { defined $quiet or $quiet = 1 };
-    $_ > 1 and do { defined $quiet or $quiet = 0 };
+    $_ == 0 and do { defined $quiet or $quiet = 1; $params{files} = 1 };
+    $_ == 1 and do { defined $quiet or $quiet = 1 };
+    $_ > 1  and do { defined $quiet or $quiet = 0 };
 }
 
 #- build callback according expression.
diff --git a/urpmi.addmedia b/urpmi.addmedia
index 5e0f3f38..6efb7941 100755
--- a/urpmi.addmedia
+++ b/urpmi.addmedia
@@ -20,23 +20,15 @@
 
 #- this program is based upon old urpmi.addmedia
 
-#use strict qw(subs vars refs);
 use strict;
 use urpm;
+use urpm::args;
 
-sub main {
-    my ($name, $url, $with, $relative_hdlist, %options);
-    #- parse /etc/urpmi/mirror.config if present, or use default mandrake mirror.
-    my $mirrors = 'http://www.linux-mandrake.com/mirrorsfull.list';
-    if (-e "/etc/urpmi/mirror.config") {
-	local (*F, $_);
-	open F, "/etc/urpmi/mirror.config";
-	while (<F>) {
-	    chomp; s/#.*$//; s/^\s*//; s/\s*$//;
-	    /^url\s*=\s*(.*)/ and $mirrors = $1;
-	}
-	close F;
-    }
+# Default mirror list
+our $mirrors = 'http://www.linux-mandrake.com/mirrorsfull.list';
+
+sub usage {
+    my $m = shift;
 # Translator: The URI types strings 'file:', 'ftp:', 'http:',
 # Translator: and 'removable:' must not be translated!
 # Translator: neither the ``with''.
@@ -81,57 +73,40 @@ and [options] are from
 ") . N("  -c             - clean headers cache directory.
 ") . N("  -f             - force generation of hdlist files.
 ");
+    warn $m ? "$usage\n$m" : $usage;
+    exit 0;
+}
+
+sub main {
+    our %options;
+    #- parse /etc/urpmi/mirror.config if present, or use default mandrake mirror.
+    if (-e "/etc/urpmi/mirror.config") {
+	local (*F, $_);
+	open F, "/etc/urpmi/mirror.config";
+	while (<F>) {
+	    chomp; s/#.*$//; s/^\s*//; s/\s*$//;
+	    /^url\s*=\s*(.*)/ and $mirrors = $1;
+	}
+	close F;
+    }
+    #---
     $options{force} = 0;
     $options{noclean} = 1;
     $options{probe_with} = 'synthesis'; #- no the default is to probe synthesis file.
     my $urpm = new urpm;
-    while ($_ = shift @_) {
-	/^--?c$/ and $options{noclean} = 0, next;
-	/^--?h$/ and next;
-	/^--?f$/ and ++$options{force}, next;
-	/^--?z$/ and ++$options{compress}, next;
-	/^--wget$/ and $urpm->{options}{downloader} = 'wget', next;
-	/^--curl$/ and $urpm->{options}{downloader} = 'curl', next;
-	/^--limit-rate$/ and do { $options{limit_rate} = shift @_; next };
-	/^--proxy$/ and do {
-	    my ($proxy, $port) = ($_ = shift @_) =~ m,^(?:http://)?([^:]+(:\d+)?)/*$, or
-		die N("bad proxy declaration on command line\n");
-	    $proxy .= ":1080" unless $port;
-	    $urpm->{proxy}{http_proxy} = $proxy;
-	    next;
-	};
-	/^--proxy-user$/ and do {
-	    ($_ = shift @_) =~ /(.+):(.+)/, or
-		die N("bad proxy declaration on command line\n");
-	    $urpm->{proxy}{user} = $1;
-	    $urpm->{proxy}{pwd} = $2;
-	    next;
-	};
-	/^--probe-synthesis$/ and $options{probe_with} = 'synthesis', next;
-	/^--probe-hdlist$/ and $options{probe_with} = 'hdlist', next;
-	/^--no-probe$/ and $options{probe_with} = undef, next;
-	/^--no-md5sum$/ and $options{nomd5sum} = 1, next;
-	/^--distrib$/ and $options{distrib} = undef, next;
-	/^--distrib-(.*)$/ and $options{distrib} = $1, next;
-	/^--from$/ and $options{mirrors_url} = shift @_, next;
-	/^--version$/ and $options{version} = shift @_, next;
-	/^--arch$/ and $options{arch} = shift @_, next;
-	/^--update$/ and $options{update} = 1, next;
-	/^--virtual$/ and $options{virtual} = 1, next;
-	/^-/ and die $usage . N("\nunknown options '%s'\n", $_);
-	($name, $url, $with, $relative_hdlist) = ($_, @_);
-	last;
-    }
+    urpm::args::parse_cmdline(urpm => $urpm);
+    our ($name, $url, $with, $relative_hdlist) = @ARGV;
+
     #- allow not to give name immediately.
     $options{distrib} or $url or ($url, $name) = ($name, '');
-    my ($type) = $url =~ m,^([^:]*)://, or $options{distrib} or die $usage;
+    my ($type) = $url =~ m,^([^:]*)://, or $options{distrib} or usage;
 
     $urpm->read_config;
     exists $options{limit_rate} or $options{limit_rate} = $urpm->{options}{'limit-rate'};
 
     if (exists $options{distrib}) {
 	if (defined $options{distrib}) {
-	    $name or die $usage;
+	    $name or usage;
 	    #- extended distribution support, code is directly inlined here.
 	    #- -h always set, updates should allow setting update flag.
 	    $options{distrib} eq 'updates' and $options{update} = 1;
@@ -190,7 +165,8 @@ and [options] are from
 	    }
 	    close F;
 	} else {
-	    $with || $relative_hdlist and die N("%s\nno need to give <relative path of hdlist> with --distrib", $usage);
+	    $with || $relative_hdlist
+		and usage N("no need to give <relative path of hdlist> with --distrib");
 
 	    $urpm->add_distrib_media($name, $url, virtual => $options{virtual}, update => $options{update});
 	}
@@ -205,12 +181,12 @@ and [options] are from
 	    $urpm->update_media(%options, callback => \&urpm::sync_logger);
 	}
     } else {
-	$name or die $usage;
+	$name or usage;
 
 	if ($with eq "with") {
-	    $relative_hdlist or die N("%s\n<relative path of hdlist> missing\n", $usage);
+	    $relative_hdlist or usage N("<relative path of hdlist> missing\n");
 	} elsif ($type =~ /ftp|http|rsync|ssh/) {
-	    $options{probe_with} || $with eq "with" or die N("%s\n`with' missing for network media\n", $usage);
+	    $options{probe_with} || $with eq "with" or usage N("`with' missing for network media\n");
 	}
 
 	$urpm->add_medium($name, $url, $relative_hdlist, virtual => $options{virtual}, update => $options{update});
@@ -232,4 +208,4 @@ and [options] are from
     $urpm->try_umounting_removables;
 }
 
-main(@ARGV);
+main();
diff --git a/urpmi.update b/urpmi.update
index b861657e..a4dcbd7c 100755
--- a/urpmi.update
+++ b/urpmi.update
@@ -18,43 +18,12 @@
 
 #- this program is based upon old urpmi.addmedia
 
-#use strict qw(subs vars refs);
+use strict;
 use urpm;
+use urpm::args;
 
-sub main {
-    my (@toupdates, %options);
-    my $urpm = new urpm;
-
-    $options{force} = 0;
-    $options{noclean} = 1;
-    while ($_ = shift @_) {
-	/^--?a$/ and $options{all} = 1, next;
-	/^--?c$/ and $options{noclean} = 0, next;
-	/^--?f$/ and ++$options{force}, next;
-	/^--?z$/ and ++$options{compress}, next;
-	/^--update$/ and $options{update} = 1, next;
-	/^--force-key$/ and $options{forcekey} = 1, next;
-	/^--wget$/ and $urpm->{options}{downloader} = 'wget', next;
-	/^--curl$/ and $urpm->{options}{downloader} = 'curl', next;
-	/^--limit-rate$/ and do { $options{limit_rate} = shift @_; next };
-	/^--proxy$/ and do {
-	    my ($proxy, $port) = ($_ = shift @_) =~ m,^(?:http://)?([^:]+(:\d+)?)/*$, or
-		die N("bad proxy declaration on command line\n");
-	    $proxy .= ":1080" unless $port;
-	    $urpm->{proxy}{http_proxy} = $proxy;
-	    next;
-	};
-	/^--proxy-user$/ and do {
-	    ($_ = shift @_) =~ /(.+):(.+)/, or
-		die N("bad proxy declaration on command line\n");
-	    $urpm->{proxy}{user} = $1;
-	    $urpm->{proxy}{pwd} = $2;
-	    next;
-	};
-	/^--no-md5sum$/ and $options{nomd5sum} = 1, next;
-	/^--?noa$/ and next; #- default, keeped for compability.
-	/^--?d$/ and next; #- default, keeped for compability.
-	/^-/ and die N("usage: urpmi.update [options] <name> ...
+sub usage {
+    warn N("usage: urpmi.update [options] <name> ...
 where <name> is a medium name to update.
 ") . N("  --help         - print this help message.
 ") . N("  --wget         - use wget to retrieve distant files.
@@ -70,9 +39,18 @@ where <name> is a medium name to update.
 ") . N("  -a             - select all non-removable media.
 ") . N("  -c             - clean headers cache directory.
 ") . N("  -f             - force generation of hdlist files.
-") . (/^--?h(?:elp)$/ ? '' : N("\nunknown options '%s'\n", $_));
-	push @toupdates, $_;
-    }
+");
+    exit 0;
+}
+
+sub main {
+    our (@toupdates, %options);
+    my $urpm = new urpm;
+
+    $options{force} = 0;
+    $options{noclean} = 1;
+
+    urpm::args::parse_cmdline(urpm => $urpm);
 
     $urpm->read_config;
     exists $options{limit_rate} or $options{limit_rate} = $urpm->{options}{'limit-rate'};
@@ -101,4 +79,4 @@ where <name> is a medium name to update.
     $urpm->try_umounting_removables;
 }
 
-main(@ARGV);
+main();
diff --git a/urpmq b/urpmq
index fb31f4a2..e5d62ff3 100755
--- a/urpmq
+++ b/urpmq
@@ -22,14 +22,15 @@
 
 use strict;
 use urpm;
+use urpm::args;
 use MDK::Common;
 
 #- default options.
 my $query = { use_provides => 1, };
 
-my @files;
-my @names;
-my @src_names;
+our @files;
+our @names;
+our @src_names;
 
 sub usage {
     print STDERR N("urpmq version %s
@@ -93,82 +94,8 @@ usage:
 my $urpm = new urpm;
 
 #- parse arguments list.
-my @nextargv;
 @ARGV or usage;
-while (defined($_ = shift @ARGV)) {
-    /^--help$/ and do { usage };
-    /^--update$/ and do { $query->{update} = 1; next };
-    /^--media$/ and do { push @nextargv, \$query->{media}; next };
-    /^--exclude-?media$/ and do { push @nextargv, \$query->{excludemedia}; next };
-    /^--sort-?media$/ and do { push @nextargv, \$query->{sortmedia}; next };
-    /^--mediums$/ and do { push @nextargv, \$query->{media}; next };
-    /^--synthesis$/ and do { push @nextargv, \$query->{synthesis}; next };
-    /^--auto-select$/ and do { $query->{deps} = $query->{upgrade} = $query->{auto_select} = 1; next };
-    /^--fuzzy$/ and do { $query->{fuzzy} = $query->{all} = 1; next };
-    /^--keep$/ and do { $query->{keep} = 1; next };
-    /^--list$/ and do { $query->{list} = 1; next };
-    /^--list-media$/ and do { $query->{list_media} = 1; next };
-    /^--list-url$/ and do { $query->{list_url} = 1; next };
-    /^--dump-config$/ and do { $query->{dump_config} = 1; next };
-    /^--list-nodes$/ and do { $query->{list_nodes} = 1; next };
-    /^--list-aliases$/ and do { $query->{list_aliases} = 1; next };
-    /^--src$/ and do { $query->{src} = 1; next };
-    /^--headers$/ and do { $query->{headers} = 1; next };
-    /^--sources$/ and do { $query->{sources} = 1; next };
-    /^--force$/ and do { $query->{force} = 1; next };
-    /^--skip$/ and do { push @nextargv, \$query->{skip}; next };
-    /^--root$/ and do { push @nextargv, \$query->{root}; next };
-    /^--use-distrib$/ and do { push @nextargv, \$query->{usedistrib}; next };
-    /^--parallel$/ and do { push @nextargv, \$query->{parallel}; next };
-    /^--wget$/ and do { $urpm->{options}{downloader} = 'wget'; next };
-    /^--curl$/ and do { $urpm->{options}{downloader} = 'curl'; next };
-    /^--proxy$/ and do {
-	my ($proxy, $port) = ($_ = shift @ARGV) =~ m,^(?:http://)?([^:]+(:\d+)?)/*$, or
-	    die N("bad proxy declaration on command line\n");
-	$proxy .= ":1080" unless $port;
-	$urpm->{proxy}{http_proxy} = "http://$proxy";
-	next;
-    };
-    /^--proxy-user$/ and do {
-	($_ = shift @ARGV) =~ /(.+):(.+)/, or
-	    die N("bad proxy declaration on command line\n");
-	$urpm->{proxy}{user} = $1;
-	$urpm->{proxy}{pwd} = $2;
-	next;
-    };
-    /^--env$/ and do { push @nextargv, \$query->{env}; next };
-    /^--changelog$/ and do { $query->{changelog} = 1; next };
-    /^-(.*)$/ and do { foreach (split //, $1) {
-	/[\?h]/ and do { usage; next };
-	/d/ and do { $query->{deps} = 1; next };
-	/u/ and do { $query->{upgrade} = 1; next };
-	/a/ and do { $query->{all} = 1; next };
-	/m/ and do { $query->{deps} = $query->{upgrade} = 1; next };
-	/M/ and do { $query->{deps} = $query->{upgrade} = 1; next };
-	/c/ and do { $query->{complete} = 1; next };
-	/g/ and do { $query->{group} = 1; next };
-	/p/ and do { $query->{use_provides} = 1; next };
-	/P/ and do { $query->{use_provides} = 0; next };
-	/R/ and do { $query->{what_requires} = 1; next };
-	/y/ and do { $query->{fuzzy} = $query->{all} = 1; next };
-	/s/ and do { $query->{src} = 1; next };
-	/v/ and do { $query->{verbose} = 1; next };
-	/i/ and do { $query->{info} = 1; next };
-	/r/ and do { $query->{version} = $query->{release} = 1; next };
-	/f/ and do { $query->{version} = $query->{release} = $query->{arch} = 1; next };
-	/l/ and do { $query->{list_files} = 1; next };
-	print STDERR N("urpmq: unknown option \"-%s\", check usage with --help\n", $1); exit(1) } next };
-    @nextargv and do { my $r = shift @nextargv; $r and $$r = $_; next };
-    /\.rpm$/ and do { if (-r $_) { push @files, $_ }
-		      else { print STDERR N("urpmq: cannot read rpm file \"%s\"\n", $_) }
-		      next };
-    if ($query->{src}) {
-	push @src_names, $_;
-    } else {
-	push @names, $_;
-    }
-    $query->{src} = 0; #- reset switch for next package.
-}
+urpm::args::parse_cmdline(urpm => $urpm);
 
 #- remove verbose if not asked.
 $query->{verbose} or $urpm->{log} = sub {};