Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

Getppt::(LongStd) replacement

by Anonymous Monk
on Mar 16, 2000 at 18:54 UTC ( #5464=sourcecode: print w/ replies, xml ) Need Help??

Category: CLI modules
Author/Contact Info lanzz <lanzz@graffiti.net>
Description:
 usage:
use importopt (namespace=>"NS", options=>{opt1=>"type", opt2=>"type[]", opt3=>"=opt1"}); types: i (integer) /^[+-]?[0-9]+$/ f (float) /^[+-]?[0-9.]+(e[+-]?[0-9]+)?$/ s (string) /./ v (void) /^$/ new types can be defined by simply adding their regexp in %type. name=>"i[]" will define @NS::name holding all the values for all instances of --name. name=>"i" will define $NS::name holding the last given value if there are multiple instances (no error/warning given). name=>"=other" will make the option "name" an alias for the option "other". if "other" is defined to be an array (other=>"i[]"), then @NS::name will be an alias for @NS::other, else $NS::name will be an alias for $NS::other. your script won't be able to tell which one was used on the command line. options syntaxes (equivalent): -option[=value] --option[=value]
if value is ommited, 1 is assumed (for boolean options). all non-option @ARGV's will be copied to @NS::_args. if there are any errors (unknown option or invalid value), $NS::_err will be set to an error code and an error message will be displayed. error codes: 1: invalid value (didn't match regexp for type) 2: unknown option 3: reference to nonexistent option (aliasing)
package importopt;

use strict;

my %type = (i => "^[+-]?[0-9]+\$",
            s => ".",
            f => "^[+-]?[0-9.]+(e[+-][0-9]+)?\$",
            v => "^\$");

sub import (@) {
  no strict 'refs';
  shift (@_);
  my %arg = @_;
  if (!defined ($arg {options})) { return(); }
  my $ns = $arg {namespace} || "";
  my %opt = %{$arg {options}};
  my $args = \@{"$ns\::_args"};
  my $err = \${"$ns\::_err"};  
  foreach my $o (keys (%opt)) {
    if ($opt{$o} =~ /^([a-zA-Z])(\[\])?$|^=(.*)/) {
      my ($t, $a, $r) = ($1 || "", $2 || "", $3 || "");
      
      if ($r) { # option is an alias for another option
        unless ($opt{$r}) {
          print STDERR ("$o: reference to nonexistent option $r\n");
          $$err = 3;
        }
        $opt{$o} = $opt{$r};
        if (defined (@{"$ns\::$r"})) {
          *{"$ns\::$o"} = \@{"$ns\::$r"};
        } else {
          *{"$ns\::$o"} = \${"$ns\::$r"};
        }
      } else { # assigning twice to avoid "used only once" warning - p
+erhaps not the cleanest solution
        if ($a) {
          @{"$ns\::$o"} = ();
          @{"$ns\::$o"} = ();
        } else {
          ${"$ns\::$o"} = "";
          ${"$ns\::$o"} = "";
        }
        $opt{$o} = $t;
      }
    }
  }
  
  @$args = ();
  $$err = 0;

  while (@ARGV) {
    if ($ARGV[0] =~ /^--?(.*?)(?:=(.*))?$/o) {
      my ($n, $v) = ($1, $2);
      if (defined ($opt{$n})) {
        if (($type{$opt{$n}}) && (($v || "") =~ /$type{$opt{$n}}/i)) {
          unless (defined ($v)) { $v = ""; }
          if (defined (${"$ns\::$n"})) {
            ${"$ns\::$n"} = $v;
          } else {
            push (@{"$ns\::$n"}, $v);
          }
        } else {
          print STDERR ("\"$v\": invalid value for $n ($opt{$n})\n");
          $$err = 1;
        }
      } else {
        print STDERR ("$n: unknown option\n");
        $$err = 2;
      }
    } else {
      push (@$args, $ARGV[0]);
    }
    shift (@ARGV);
  }
  @ARGV = @$args;
}

1;

Comment on Getppt::(LongStd) replacement
Download Code

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://5464]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (10)
As of 2015-07-04 14:12 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (60 votes), past polls