| Subject: | Parse values for sizes with suffixes, e. g. "--size 10M" |
The attached patch allows to parse values with GNU find-like suffixes
("10M" -> 10 * 1024 * 1024).
The type code "t" was chosen purely for egoistical reasons, as "I" is
used internally, "S" (for space or suffix) is too close to the totally
unrelated "s", and I didn't want to spend any more time on finding a good
mnemonic :-).
The tests do not properly cover bundling at the moment.
| Subject: | 0001-Add-type-for-size-values-with-suffixes.patch |
From 1a895457e111d0dc280e9e91daf146661d16bcc7 Mon Sep 17 00:00:00 2001
From: Tim Landscheidt <tim@tim-landscheidt.de>
Date: Sun, 11 Dec 2011 02:53:22 +0000
Subject: [PATCH] Add type for size values with suffixes.
The suffixes chosen were taken from GNU find.
The choice for `t' as the type code is totally arbitrary. The test
cases do not properly cover bundling.
---
cpan/Getopt-Long/lib/Getopt/Long.pm | 35 ++++++++++++++++++++++++++------
cpan/Getopt-Long/t/gol-suffixes.t | 37 +++++++++++++++++++++++++++++++++++
2 files changed, 65 insertions(+), 7 deletions(-)
create mode 100644 cpan/Getopt-Long/t/gol-suffixes.t
diff --git a/cpan/Getopt-Long/lib/Getopt/Long.pm b/cpan/Getopt-Long/lib/Getopt/Long.pm
index c827d3c..1d55993 100644
--- a/cpan/Getopt-Long/lib/Getopt/Long.pm
+++ b/cpan/Getopt-Long/lib/Getopt/Long.pm
@@ -59,6 +59,7 @@ sub ParseOptionSpec($$);
sub OptCtl($);
sub FindOption($$$$$);
sub ValidValue ($$$$$);
+sub ParseSuffixedValue($);
################ Local Variables ################
@@ -244,6 +245,7 @@ use constant PAT_XINT =>
"|".
"0[0-7_]*".
")";
+use constant PAT_TINT => "(?:(?:0|[1-9][0-9]*)[cwbkMG]?)";
use constant PAT_FLOAT => "[-+]?[0-9._]+(\.[0-9_]+)?([eE][-+]?[0-9_]+)?";
sub GetOptions(@) {
@@ -662,7 +664,7 @@ sub GetOptionsFromArray(@) {
if ( @$argv ) {
if ( ValidValue($ctl, $argv->[0], 1, $argend, $prefix) ) {
$arg = shift(@$argv);
- $arg =~ tr/_//d if $ctl->[CTL_TYPE] =~ /^[iIo]$/;
+ $arg =~ tr/_//d if $ctl->[CTL_TYPE] =~ /^[iIot]$/;
($key,$arg) = $arg =~ /^([^=]+)=(.*)/
if $ctl->[CTL_DEST] == CTL_DEST_HASH;
next;
@@ -783,7 +785,7 @@ sub ParseOptionSpec ($$) {
[!+]
|
# ... or a value/dest/repeat specification
- [=:] [ionfs] [@%]? (?: \{\d*,?\d*\} )?
+ [=:] [ionfst] [@%]? (?: \{\d*,?\d*\} )?
|
# ... or an optional-with-default spec
: (?: -?\d+ | \+ ) [@%]?
@@ -832,7 +834,7 @@ sub ParseOptionSpec ($$) {
}
else {
my ($mand, $type, $dest) =
- $spec =~ /^([=:])([ionfs])([@%])?(\{(\d+)?(,)?(\d+)?\})?$/;
+ $spec =~ /^([=:])([ionfst])([@%])?(\{(\d+)?(,)?(\d+)?\})?$/;
return (undef, "Cannot repeat while bundling: \"$opt\"\n")
if $bundling && defined($4);
my ($mi, $cm, $ma) = ($5, $6, $7);
@@ -1134,20 +1136,24 @@ sub FindOption ($$$$$) {
elsif ( $type eq 'i' # numeric/integer
|| $type eq 'I' # numeric/integer w/ incr default
+ || $type eq 't' # numeric/integer w/ suffix
|| $type eq 'o' ) { # dec/oct/hex/bin value
- my $o_valid = $type eq 'o' ? PAT_XINT : PAT_INT;
+ my $o_valid = $type eq 'o' ? PAT_XINT :
+ $type eq 't' ? PAT_TINT : PAT_INT;
if ( $bundling && defined $rest
&& $rest =~ /^($key_valid)($o_valid)(.*)$/si ) {
($key, $arg, $rest) = ($1, $2, $+);
chop($key) if $key;
- $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) : 0+$arg;
+ $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) :
+ $type eq 't' ? ParseSuffixedValue ($arg) : 0+$arg;
unshift (@$argv, $starter.$rest) if defined $rest && $rest ne '';
}
elsif ( $arg =~ /^$o_valid$/si ) {
$arg =~ tr/_//d;
- $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) : 0+$arg;
+ $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) :
+ $type eq 't' ? ParseSuffixedValue ($arg) : 0+$arg;
}
else {
if ( defined $optarg || $mand ) {
@@ -1246,9 +1252,10 @@ sub ValidValue ($$$$$) {
elsif ( $type eq 'i' # numeric/integer
|| $type eq 'I' # numeric/integer w/ incr default
+ || $type eq 't' # numeric/integer w/ suffix
|| $type eq 'o' ) { # dec/oct/hex/bin value
- my $o_valid = $type eq 'o' ? PAT_XINT : PAT_INT;
+ my $o_valid = $type eq 'o' ? PAT_XINT : $type eq 'o' ? PAT_TINT : PAT_INT;
return $arg =~ /^$o_valid$/si;
}
@@ -1262,6 +1269,14 @@ sub ValidValue ($$$$$) {
die("ValidValue: Cannot happen\n");
}
+sub ParseSuffixedValue ($) {
+ my ($arg) = @_;
+ my %SuffixFactors = ('' => 1, 'c' => 1, 'w' => 2, 'b' => 512, 'k' => 1024, 'M' => 1024 * 1024, 'G' => 1024 * 1024 * 1024);
+
+ $arg =~ /^([0-9]+)([cwbkMG]?)/;
+ return $1 * $SuffixFactors {$2};
+}
+
# Getopt::Long Configuration.
sub Configure (@) {
my (@options) = @_;
@@ -1888,6 +1903,12 @@ hexadecimal string (C<0x> followed by '0' .. '9', 'a' .. 'f', case
insensitive), or a binary string (C<0b> followed by a series of '0'
and '1').
+=item t
+
+Integer for size values. Either non-C<0> followed by a sequence of
+digits or C<0>, optionally suffixed by C<c> (factor 1), C<w> (2), C<b>
+(512), C<k> (1024), C<M> (1024**2), or C<G> (1024**3).
+
=item f
Real number. For example C<3.14>, C<-6.23E24> and so on.
diff --git a/cpan/Getopt-Long/t/gol-suffixes.t b/cpan/Getopt-Long/t/gol-suffixes.t
new file mode 100644
index 0000000..fb938ef
--- /dev/null
+++ b/cpan/Getopt-Long/t/gol-suffixes.t
@@ -0,0 +1,37 @@
+#!./perl -w
+
+no strict;
+
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ @INC = '../lib';
+ chdir 't';
+ }
+}
+
+use Getopt::Long qw(:config no_ignore_case);
+# my $want_version="2.39";
+# die("Getopt::Long version $want_version required--this is only version ".
+# $Getopt::Long::VERSION)
+# unless $Getopt::Long::VERSION ge $want_version;
+
+print "1..17\n";
+
+@ARGV = qw(-a 1 -b 1c -c 1w -d 1b -e 1k -f 1M -g 1G bar);
+print (GetOptions("a=t", "b=t", "c=t", "d=t", "e=t", "f=t", "g=t") ? "" : "not ", "ok 1\n");
+print ((defined $opt_a) ? "" : "not ", "ok 2\n");
+print (($opt_a == 1) ? "" : "not ", "ok 3\n");
+print ((defined $opt_b) ? "" : "not ", "ok 4\n");
+print (($opt_b == 1) ? "" : "not ", "ok 5\n");
+print ((defined $opt_c) ? "" : "not ", "ok 6\n");
+print (($opt_c == 2) ? "" : "not ", "ok 7\n");
+print ((defined $opt_d) ? "" : "not ", "ok 8\n");
+print (($opt_d == 512) ? "" : "not ", "ok 9\n");
+print ((defined $opt_e) ? "" : "not ", "ok 10\n");
+print (($opt_e == 1024) ? "" : "not ", "ok 11\n");
+print ((defined $opt_f) ? "" : "not ", "ok 12\n");
+print (($opt_f == 1024 ** 2) ? "" : "not ", "ok 13\n");
+print ((defined $opt_g) ? "" : "not ", "ok 14\n");
+print (($opt_g == 1024 ** 3) ? "" : "not ", "ok 15\n");
+print ((@ARGV == 1) ? "" : "not ", "ok 16\n");
+print (($ARGV[0] eq "bar") ? "" : "not ", "ok 17\n");
--
1.6.2.5