test/etags/perl-src/yagrip.pl

   1 #Yet Another Getopt Routine In Perl
   2 # jgreely@cis.ohio-state.edu, 89/11/1
   3 #usage:
   4 #&getopt("f:bar") ||
   5 #       die &usage("script","f:bar","oo","[files ...]");
   6 #
   7 sub getopt {
   8         local($_,$flag,$opt,$f,$r,@temp) = @_;
   9         @temp = split(/(.):/);
  10         while ($#temp >= $[) {
  11                 $flag .= shift(@temp);
  12                 $opt .= shift(@temp);
  13         }
  14         while ($_ = $ARGV[0], /^-(.)(.*)/ && shift(@ARGV)) {
  15                 ($f,$r) = ($1,$2);
  16                 last if $f eq '-';
  17                 if (index($flag,$f) >= $[) {
  18                         eval "\$opt_$f++;";
  19                         $r =~ /^(.)(.*)/,redo if $r ne '';
  20                 }elsif (index($opt,$f) >= $[) {
  21                         $r = $r eq '' ? shift(@ARGV) : $r;
  22                         eval "\$opt_$f = \$r;";
  23                 }else{
  24                         print STDERR "Unrecognized switch \"-$f\".\n";
  25                         return 0;
  26                 }
  27         }
  28         return 1;
  29 }
  30
  31 #usage: usage:
  32 # &usage(progname,arglist,@names,@last);
  33 #ex:
  34 # &usage("script","f:bar","oo","[file ...]");
  35 #would return
  36 # "usage: script [-f oo] [-bar] [file ...]"
  37 #
  38 sub usage {
  39         local($prog,$_,@list) = @_;
  40         local($string,$flag,@string,@temp,@last) = ();
  41         @temp = split(/(.):/);
  42         push(@string,"usage:",$prog);
  43         while ($#temp >= $[) {
  44                 if (($flag = shift(@temp)) ne '') {
  45                         push(@string,"[-$flag]");
  46                 }
  47                 if (($flag = shift(@temp)) ne '') {
  48                         push(@string,sprintf("[-%s %s]",$flag,shift(@list)));
  49                 }
  50         }
  51         push(@string,@list) if $#list >= $[;
  52         return join(' ',@string) . "\n";
  53 }
  54 1;