Changeset 11309 for trunk

Timestamp:

2006-03-08T11:40:01+13:00 (18 years ago)

Author:

kjdon

Message:

now uses new parse2 parsing instead of old parsargv, and creator no longer checked for syntax

File:

• trunk/gsdl/bin/script/mkcol.pl (modified) (12 diffs)

trunk/gsdl/bin/script/mkcol.pl

@@ -39 +39 @@
 }
 
-use parsargv;
+use parse2;
 use util;
 use cfgread;
-use gsprintf;
+use gsprintf 'gsprintf';
 use printusage;
+
+use strict;
+no strict 'subs'; # allow barewords (eg STDERR) as function arguments
+
+my $public_list = 
+    [ { 'name' => "true",
+    'desc' => "{mkcol.public.true}"},
+      { 'name' => "false",
+    'desc' => "{mkcol.public.false}"} 
+      ];
+
+my $win31compat_list = 
+    [ { 'name' => "true",
+    'desc' => "{mkcol.win31compat.true}"},
+      { 'name' => "false",
+    'desc' => "{mkcol.win31compat.false}"} 
+      ];
 
 my $arguments =
@@ -65 +82 @@
       { 'name' => "public",
     'desc' => "{mkcol.public}",
-    'type' => "string",
+    'type' => "enum",
     'deft' => "true",
+    'list' => $public_list,
     'reqd' => "no" },
       { 'name' => "title",
@@ -90 +108 @@
       { 'name' => "win31compat",
     'desc' => "{mkcol.win31compat}",
-    'type' => "string",
+    'type' => "enum",
     'deft' => "true",
-    'reqd' => "no" } ];
+    'list' => $win31compat_list,
+    'reqd' => "no" },
+      { 'name' => "gli",
+    'desc' => "",
+    'type' => "flag",
+    'reqd' => "no",
+    'hiddengli' => "yes" },
+      { 'name' => "xml",
+    'desc' => "{scripts.xml}",
+    'type' => "flag",
+    'reqd' => "no",
+    'hiddengli' => "yes" }
+      ];
 
 my $options = { 'name' => "mkcol.pl",
@@ -98 +128 @@
         'args' => $arguments };
 
-sub gsprintf
-{
-    return &gsprintf::gsprintf(@_);
-}
+# options
+my ($creator, $optionfile, $maintainer, $collectdir, $public, 
+    $title, $about, $plugin, $quiet, $language, $win31compat, $gli);
+
+#other variables
+my ($collection, $capcollection, $pluginstring, @plugin);
+
+&main();
 
 
@@ -126 +160 @@
     closedir(DIR);
 
-    foreach $file (@files)
+    foreach my $file (@files)
     {
     my $thisfile = &util::filename_cat ($modeldir, $file);
@@ -146 +180 @@
         (&gsprintf(STDERR, "{common.cannot_create_file}\n", $destfile) && die);
 
-        while (defined ($line = <INFILE>)) {
+        while (defined (my $line = <INFILE>)) {
         $line =~ s/\*\*collection\*\*/$collection/g;
         $line =~ s/\*\*COLLECTION\*\*/$capcollection/g;
@@ -165 +199 @@
 }
 
-# get and check options
-sub parse_args {
-    my ($argref) = @_;
-    if (!&parsargv::parse($argref,
-              'language/.*/', \$language,
-              'optionfile/.*/', \$optionfile,
-              'collectdir/.*/', \$collectdir,
-              'creator/\w+\@[\w\.]+/', \$creator,
-              'maintainer/\w+\@[\w\.]+/', \$maintainer,
-              'public/true|false/true', \$public,
-              'title/.+/', \$title,
-              'about/.+/', \$about,
-              'plugin/.+', \@plugin,
-              'quiet', \$quiet,
-              'win31compat/true|false/true', \$win31compat,
-              'gli', \$gli,
-              q^xml^, \$xml
-              )) {
+
+sub main {
+    
+    my $xml = 0;
+    
+    my $hashParsingResult = {};
+    my $intArgLeftinAfterParsing = parse2::parse(\@ARGV,$arguments,$hashParsingResult,"allow_extra_options");
+    # If there is more than one argument left after parsing, it mean user input too many arguments.
+    if($intArgLeftinAfterParsing > 1)
+    {
     &PrintUsage::print_txt_usage($options, "{mkcol.params}");
     die "\n";
     }
-}
-
-sub main {
-
-    &parse_args (\@ARGV);
+    
+    foreach my $strVariable (keys %$hashParsingResult)
+    {
+    eval "\$$strVariable = \$hashParsingResult->{\"\$strVariable\"}";
+    }
+
 
     # If $language has been specified, load the appropriate resource bundle
     # (Otherwise, the default resource bundle will be loaded automatically)
-    if ($language) {
+    if ($language && $language =~ /\S/) {
     &gsprintf::load_language_specific_resource_bundle($language);
     }
@@ -200 +227 @@
     if ($xml) {
     &PrintUsage::print_xml_usage($options);
-    die "\n";
+    print "\n";
+    return;
     }
 
@@ -216 +244 @@
     }
     close OPTIONS;
-    &parse_args ($options);
-    }
-
+    my $optionsParsingResult = {};
+    my $optionsParseFailed = "false";
+    if (!parse2::parse($options,$arguments,$optionsParsingResult)) {
+        &PrintUsage::print_txt_usage($options, "{mkcol.params}");
+        die "\n";
+    }
+        
+    foreach my $strVariable (keys %$optionsParsingResult)
+    {
+        eval "\$$strVariable = \$optionsParsingResult->{\"\$strVariable\"}";
+    }
+    }
+    
     # load default plugins if none were on command line
     if (!scalar(@plugin)) {
@@ -248 +286 @@
     }
 
-    # We don't want creator to be required anymore - John Thompson 28-11-2003
-    #if (!defined($creator) || $creator eq "") {
-    #   &gsprintf(STDOUT, "{mkcol.creator_undefined}\n");
-    #   die "\n";
-    #}
-
-    #Of course thats means we don't want to default maintainer unless a creator is provided
     if (defined($creator) && (!defined($maintainer) || $maintainer eq "")) {
     $maintainer = $creator;
@@ -271 +302 @@
     # get the strings to include.
     $pluginstring = "";
-    foreach $plugin (@plugin) {
-    $pluginstring .= "plugin         $plugin\n";
-    }
-
-    $mdir = &util::filename_cat ($ENV{'GSDLHOME'}, "collect", "modelcol");
+    foreach my $plug (@plugin) {
+    $pluginstring .= "plugin         $plug\n";
+    }
+
+    my $mdir = &util::filename_cat ($ENV{'GSDLHOME'}, "collect", "modelcol");
+    my $cdir;
     if (defined $collectdir && $collectdir =~ /\w/) {
     if (!-d $collectdir) {
@@ -303 +335 @@
 }
 
-&main ();
+