Source code of Windows XP (NT5)
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

453 lines
11 KiB

  1. #---------------------------------------------------------------------
  2. package GetParams;
  3. #
  4. # (c) 2000 Microsoft Corporation. All rights reserved.
  5. #
  6. # Version: 1.00 (01-14-2000) : Basic function implement
  7. # 1.01 (01-17-2000) : Use -tag to define the function
  8. # 1.02 (02-01-2000) : Fix $self problem => Complete Object Oriented
  9. # 1.03 (05-02-2000) : Provide -? and -x:xxx parameters & fix path value problem
  10. # 1.04 (05-04-2000) : Provide getparams, getparamsEnv function & remove $class
  11. #---------------------------------------------------------------------
  12. $VERSION = '1.04';
  13. require 5.003;
  14. use Getopt::Std;
  15. use strict;
  16. no strict 'vars';
  17. no strict 'subs';
  18. require Exporter;
  19. @ISA = qw(Exporter);
  20. sub new {
  21. my ($class)=shift;
  22. my $self = {@_};
  23. $class = ref($class) || $class;
  24. # The keys of 'self' are
  25. #
  26. # -n <necessary format> : see Usage
  27. # -o <option format> : see Usage
  28. # -p <variable list> : see Usage
  29. # -h <hash name> : see Usage
  30. # -VariableSet <varfun> : Variable Setting Function, call varfun($name, $value)
  31. # -Process <profun> : argument process function, call profun(@argumentlist)
  32. # -Error <errfun> : error function, call errfun("error message")
  33. $self->{-Process}=sub {process($self,@_)} if (!defined $self->{-Process});
  34. $self->{-Error}=sub {Error($self, @_)} if (!defined $self->{-Error});
  35. @EXPORT = qw();
  36. return bless ($self, $class);
  37. }
  38. sub process {
  39. my $self=shift;
  40. # Step 0. Backup the @ARGV, because getopts only works for @ARGV
  41. my (@BAK_ARGV) = @ARGV;
  42. # variable defined
  43. #
  44. # $splitnum is a locator, locate to the last element of syntax parameter,
  45. # $splitnum + 1 will be the command line arguments
  46. #
  47. # $swlist := $necessary$optional
  48. #
  49. # @namelist is stored the variable name using in cmd script
  50. my ($splitnum, @ARGV_tmp, $swlist, @namelist, @namelist_tmp)=(-1);
  51. # Step 0.5. filter -? => set $HELP to 1 and translate -x:xxx => -x xxx, \x, .x or /x => -x
  52. for (@_) {
  53. if (/^[\/\\\.]([\w|\?])(:.+)?$/) {
  54. $_ = "-$1$2";
  55. }
  56. if (/-\?/) {
  57. if (defined $self->{-VariableSet}) {
  58. &{$self->{-VariableSet}}("HELP", 1);
  59. } else {
  60. PerlVarSet($self, "HELP", 1);
  61. local $Exporter::ExportLevel = 2; #Export the value to its parent-parent (because its parent is sub {&Process($self,@_)}
  62. import GetParams;
  63. }
  64. return;
  65. } elsif (/^(-.):(.+)?/) {
  66. push @ARGV_tmp, $1;
  67. push @ARGV_tmp, $2;
  68. } else {
  69. push @ARGV_tmp, $_;
  70. }
  71. }
  72. @_ = @ARGV_tmp;
  73. # Step 1. Get switch format for (n)ecessary, (o)ptional, (h)ash and (p)arameter
  74. while (1) {
  75. my $opt = shift;
  76. my $value = shift;
  77. if (($opt =~ /([nohp])/m) && (!defined $self->{"-$1"}) && (!defined $self->{"-p"})) {
  78. my $optchar=$1;
  79. $self->{"-$optchar"} = $value;
  80. $splitnum += 2;
  81. } else {
  82. last;
  83. }
  84. }
  85. @ARGV = @ARGV_tmp[$splitnum+1..$#ARGV_tmp];
  86. &Usage if (!defined($self->{-n}) and !defined($self->{-o}));
  87. $self->{-VariableSet} = sub {PerlHashSet($self, @_)} if ((defined $self->{-h}) && (!defined $self->{-VariableSet}));
  88. $self->{-VariableSet} = sub {PerlVarSet($self, @_)} if (!defined $self->{-VariableSet});
  89. $swlist = "$self->{-n}$self->{-o}";
  90. @namelist_tmp = split(/ /, $self->{-p});
  91. # push user-defined variable name to namelist
  92. while ($swlist =~ /([^:])/g) {
  93. my $optchar = $1;
  94. if ($#namelist_tmp != -1) {
  95. push @namelist, (shift @namelist_tmp);
  96. } else {
  97. &{$self->{-Error}}("Variable not defined for '\$opt_$optchar'");
  98. }
  99. }
  100. # Step 2. According option defined, call getopts to evaluate the use @ARGV
  101. if ($ARGV[0] =~ /^-/) {
  102. getopts($swlist);
  103. } elsif ("$self->{-n}" ne "" or $#ARGV != -1) {
  104. if ($#ARGV == -1) {
  105. &{$self->{-Error}}("Please define parameters");
  106. }
  107. else {
  108. &{$self->{-Error}}("Incorrect switch format");
  109. }
  110. }
  111. # Step 3. Look for the value and set the value via $self->{-VariableSet}
  112. while($swlist =~ /([^:])/g) {
  113. my ($name, $value, $optchar)=(shift @namelist, eval("\$opt_$1"), $1);
  114. if ($value ne "") {
  115. &{$self->{-VariableSet}}($name, $value);
  116. } elsif ($self->{-n} =~ /$optchar/) {
  117. &{$self->{-Error}}("Necessary option '-$optchar' for variable '$name' undefined!!");
  118. }
  119. }
  120. # Step 4. Recover the @ARGV;
  121. @ARGV = @BAK_ARGV;
  122. if(@EXPORT) {
  123. local $Exporter::ExportLevel = 2; #Export the value to its parent-parent (because its parent is sub {&Process($self,@_)}
  124. import GetParams;
  125. }
  126. }
  127. sub getparams {
  128. process(new, @_);
  129. }
  130. sub getparamsENV {
  131. process(new, '-h' => \%ENV, @_);
  132. }
  133. sub Error {
  134. my $self=shift;
  135. printf("echo %s\nseterror.exe 1\n", shift);
  136. exit(1);
  137. }
  138. sub PerlVarSet {
  139. my ($self, $name, $value)=@_;
  140. no strict 'refs';
  141. ${$name} = $value;
  142. push( @EXPORT, "\$$name" );
  143. }
  144. sub CmdVarSet {
  145. my($self, $name, $value)=@_;
  146. print "set $name=$value\n";
  147. }
  148. sub PerlHashSet {
  149. my($self, $name, $value)=@_;
  150. no strict 'refs';
  151. ${$self->{-h}}{$name}="$value";
  152. }
  153. sub Usage {
  154. print <<USAGE;
  155. $0 - Get Option from command line
  156. ============================================================================
  157. Syntax: $0 <syntax> <cmdline> [-?]
  158. where syntax format is [[-n <fmt>|-o <fmt>] [-h hashadrs] [-p varlist]
  159. cmdline format is [arg [arg [...]]
  160. -p must be the last parameter of the syntax
  161. ============================================================================
  162. Parameters:
  163. fmt : <alphabet>[:],
  164. with colon for argument option, such as f: for -f myfile
  165. no colon for switch, such as Y for -Y
  166. hashadrs : store the value with varlist as keys into a hash address;
  167. only for Perl program
  168. varlist : variable list, such as myfile
  169. arg : real arugment, such as abc.txt
  170. ============================================================================
  171. Example:
  172. 1. parse a '-s <server> -p <project> [-r] [-c comment]' parameter
  173. to srv, proj, opt_r, comment
  174. => $0 -n s:p: -o rc: -p "srv proj opt_r comment" -s myserver -p myproj -c mycomment
  175. 2. echo "set HELP = 1"
  176. => $0 -n s:p: -o rc: -p "srv proj opt_r comment" -s myserver -?
  177. 3. compatible use:
  178. => $0 /n s:p: /o:rc: -p "srv proj opt_r comment" -s: myserver /p myproj \c mycomment
  179. USAGE
  180. exit(1);
  181. }
  182. # Command line process
  183. if (eval("\$0=~/" . __PACKAGE__ . "\\.pm\$/i")) {
  184. my $getopt=GetParams->new(-VariableSet => sub {&CmdVarSet($self,@_)});
  185. &{$getopt->{-Process}}(@ARGV);
  186. }
  187. =head1 NAME
  188. B<GetParams> - Process single-character switches with switch clustering
  189. =head1 SYNOPSIS
  190. # for cmd script, below print 'set opt_s=mysrv' and 'set opt_p=myproj'
  191. perl GetParams.pm -n s:p: -o r -p "opt_s opt_p sw_r" -s mysrv -p myproj
  192. # for perl module, below set $opt_s=mysrv and $opt_p=myproj
  193. my $getopt1=GetParams->new;
  194. @syntax = (
  195. -n => 's:p:',
  196. -o => 'rc:',
  197. -p => 'opt_s opt_p opt_r opt_c',
  198. );
  199. # Set variable's value by @ARGV
  200. &{$getopt1->{-Process}}(
  201. @syntax,
  202. @ARGV
  203. );
  204. # Set value to Hash, like $myhash{opt_s}
  205. &{$getopt1->{-Process}}(
  206. '-h' => \%myhash,
  207. @syntax,
  208. @ARGV
  209. );
  210. # or Directly call
  211. GetParams::getparams(
  212. @syntax,
  213. @ARGV
  214. );
  215. GetParams::getparams(
  216. '-h' => \%myhash,
  217. @syntax,
  218. @ARGV
  219. );
  220. # Set variable directly to %ENV
  221. GetParams::getparamsENV(
  222. @syntax,
  223. @ARGV
  224. );
  225. # for help
  226. perl GetParams.pm -?
  227. => SET HELP = 1
  228. &{$getopt1->{-Process}}(
  229. @syntax,
  230. '-?'
  231. );
  232. print $HELP; # print 1
  233. =head1 DESCRIPTION
  234. This module process the signal character switch to variable(s). The format
  235. in C<-n> C<-o> are the same definition of the arguement as L<"Getopt::Std">
  236. module. The real value will be evaluate and assign to the variable defined
  237. in C<-p>. From Perl program, you can also assign the argument into a hash.
  238. Just assign hash address (\%myhash) to C<-h>.
  239. =head1 INSTANCES
  240. =head2 Syntax Parameters
  241. =head3 $GetParams->{-n}=<fmt>
  242. Stored necessary option (<alphabet>:) / switch (<alphabet>), such as
  243. 'a:bc:' for -a <value> -b -c <value>.
  244. =head3 $GetParams->{-o}=<fmt>
  245. Stored optional option (<alphabet>:) / switch (<alphabet>), such as
  246. 'de:' for -d -e <value>.
  247. =head3 $GetParams->{-h}=<hash address>
  248. Only for Perl program, stored to I<hash address> when you want to store
  249. the value to a hash.
  250. =head3 $GetParams->{-p}=<variable list>
  251. A list stored variables name or hash keys, such as 'opt_p opt_x opt_t'.
  252. The switch value will be set to 1 if assigned in the command line arguments.
  253. The order in the I<variable list> should always follow by -n I<fmt> -o I<fmt>
  254. option with space to separate.
  255. =head2 Command Line Parameters
  256. The real argument you want to process, such as @ARGV or %* (for cmd script).
  257. =head1 METHODS
  258. =head3 GetParams->new([syntax format][function assignment])
  259. create an object for process the argument.
  260. # Example for how to use this method
  261. my $getopt1=GetParams->new;
  262. # Example for assign syntax format
  263. my $getopt2=GetParams->new(
  264. -n => 's:',
  265. -p => var_s,
  266. );
  267. # Example for assign function
  268. sub dbgVarSet {
  269. my($name, $value);
  270. print "Assign $value to $name
  271. }
  272. my $getopt3=GetParams->new(-VariableSet = \&dbgVarSet);
  273. =head3 &{$GetParams->{-Process}}([syntax format] <command line arguments>)
  274. stored the procedure for process argument, by default is GetParams::process.
  275. # Example for how to execute this function
  276. my $getopt4=GetParams->new;
  277. &{$getopt4->{-Process}}(
  278. -o => 'rc:',
  279. -p => 'opt_r opt_c',
  280. @ARGV
  281. );
  282. # Example for how to define your process
  283. my $getopt5=GetParams->new(-Process => \&myProcess);
  284. # Example for how to define your process
  285. my $getopt6=GetParams->new;
  286. $getopt6->{-Process}=\&myProcess;
  287. sub myProcess {
  288. my @argu=@_;
  289. my $ptr=0;
  290. for($ptr=0;$ptr<$#argu;$ptr+=2) {
  291. print "option:$argu[$ptr]\t\t$argu[$ptr+1]\n";
  292. }
  293. }
  294. =head3 &{$GetParams->{-VariableSet}}($name,$value)
  295. stored the procedure for Variable Setting, we can call with ($name, $value) for
  296. setting the $value to $name.
  297. # Example for how to define your VariableSet function
  298. my $getopt7=GetParams->new(-VariableSet => \&myVarSet);
  299. # Example for how to define your VariableSet function
  300. my $getopt8=GetParams->new;
  301. $getopt8->{-VariableSet}=\&myVarSet;
  302. # Example for how to define your VariableSet function
  303. my $getopt9=GetParams->new;
  304. &{$getopt9->{-Process}}(
  305. '-o' => 'r',
  306. '-VariableSet' => \&myVarSet, # set in the last minute
  307. '-p' => 'sw_r',
  308. @ARGV
  309. );
  310. sub myVarSet {
  311. my ($name, $value)=@_;
  312. print "Set Value ($value) to Variable ($name)\n";
  313. }
  314. =head3 &{$GetParams->{-Error}}($msg)
  315. stored the procedure for Error handling, we can call with ($errmsg) for the error.
  316. # Example for how to define your Error function for GetParams
  317. my $getopt10=GetParams->new(-Error => \&myError);
  318. # Example for how to define your VariableSet function
  319. my $getopt11=GetParams->new;
  320. $getopt11->{-Error}=\&myError;
  321. # Example for how to define your VariableSet function
  322. my $getopt11=GetParams->new;
  323. &{$getopt9->{-Process}}(
  324. '-o' => 'r',
  325. '-Error' => \&myError, # set in the last minute
  326. '-p' => 'sw_r',
  327. @ARGV
  328. );
  329. sub myError {
  330. my ($msg)=@_;
  331. print "GetParams fail ($msg)\n";
  332. }
  333. =head1 SEE ALSO
  334. L<"Getopt::Std">
  335. =head1 AUTHOR
  336. Benson Tan <[email protected]>
  337. =cut
  338. 1;