Changeset 4744 for trunk/gsdl/perllib/plugins/BasPlug.pm

Timestamp:

2003-06-20T14:22:34+12:00 (21 years ago)

Author:

mdewsnip

Message:

Tidied up and structures (representing the options of the plugin) in preparation for removing the print_usage() routines.

File:

• trunk/gsdl/perllib/plugins/BasPlug.pm (modified) (6 diffs)

trunk/gsdl/perllib/plugins/BasPlug.pm

@@ -45 +45 @@
 
 my $unicode_list = 
-[ { 'name' => "auto",
-    'desc' => "Use text categorization algorithm to automatically identify the encoding of each source document. This will be slower than explicitly setting the encoding but will work where more than one encoding is used within the same collection." } ,
-  { 'name' => "ascii",
-    'desc' => "Plain 7 bit ascii. This may be a bit faster than using iso_8859_1. Beware of using this on a collection of documents that may contain characters outside the plain 7 bit ascii set though (e.g. German or French documents containing accents), use iso_8859_1 instead." },
-  { 'name' => "utf8",
-    'desc' => "either utf8 or unicode -- automatically detected." },
-  { 'name' => "unicode",
-    'desc' => "just unicode" } ];
+    [ { 'name' => "auto",
+    'desc' => "Use text categorization algorithm to automatically identify the encoding of each source document. This will be slower than explicitly setting the encoding but will work where more than one encoding is used within the same collection." } ,
+      { 'name' => "ascii",
+    'desc' => "Plain 7 bit ascii. This may be a bit faster than using iso_8859_1. Beware of using this on a collection of documents that may contain characters outside the plain 7 bit ascii set though (e.g. German or French documents containing accents), use iso_8859_1 instead." },
+      { 'name' => "utf8",
+    'desc' => "either utf8 or unicode -- automatically detected." },
+      { 'name' => "unicode",
+    'desc' => "just unicode" } ];
 
 my $arguments = 
     [ { 'name' => "process_exp",
-    'desc' => "A perl regular expression to match against filenames. Matching filenames will be processed by this plugin. Each plugin has its own default process_exp. e.g HTMLPlug defaults to '(?i)\.html?\$' i.e. all documents ending in .htm or .html (case-insensitive).",
+    'desc' => "A perl regular expression to match against filenames. Matching filenames will be processed by this plugin. For example, using '(?i).html?\$' matches all documents ending in .htm or .html (case-insensitive).",
     'type' => "string",
     'deft' => "",
@@ -66 +66 @@
     'reqd' => "no" },
       { 'name' => "input_encoding",
-    'desc' => "The encoding of the source documents. Documents will be converted from these encodings and stored internally as utf8. The default input_encoding is 'auto'.",
+    'desc' => "The encoding of the source documents. Documents will be converted from these encodings and stored internally as utf8.",
     'type' => "enum",
     'list' => $unicode_list,
@@ -72 +72 @@
     'deft' => "auto" } ,
       { 'name' => "default_encoding",
-    'desc' => "Use this encoding if -input_encoding is set to 'auto' and the text categorization algorithm fails to extract the encoding or extracts an encoding unsupported by Greenstone.  The default is iso_8859_1.",
-    'type' => "flag",
-    'reqd' => "no" },
+    'desc' => "Use this encoding if -input_encoding is set to 'auto' and the text categorization algorithm fails to extract the encoding or extracts an encoding unsupported by Greenstone.",
+    'type' => "enum",
+    'reqd' => "no",
+        'deft' => "utf8" },
       { 'name' => "extract_language",
     'desc' => "Identify the language of each document and set 'Language' metadata. Note that this will be done automatically if -input_encoding is 'auto'.",
@@ -107 +108 @@
     'desc' => "The maximum historical date to be used as metadata (in a Common Era date, such as 1950).",
     'type' => "int",
+    'deft' => (localtime)[5]+1900,
     'reqd' => "no"},
       { 'name' => "maximum_century",
     'desc' => "The maximum named century to be extracted as historical metadata (e.g. 14 will extract all references up to the 14th century).",
     'type' => "int",
+    'deft' => "-1",
     'reqd' => "no" },
       { 'name' => "no_bibliography",
@@ -196 +199 @@
 }
 
+
+# sub print_usage_new
+# {
+# }
+
+
+sub print_usage_new
+{
+    local $self = shift(@_);
+    local $optionlist = $self->{'option_list'};
+    local $pluginoptions = pop(@$optionlist);
+    return if (!defined($pluginoptions));
+
+    local $pluginname = $pluginoptions->{'name'};
+    local $pluginargs = $pluginoptions->{'args'};
+
+    # Produce the usage information using the data structure above
+    print STDERR " usage: plugin $pluginname";
+    if (defined($pluginargs)) {
+    print STDERR " [options]";
+    }
+    print STDERR "\n\n";
+
+    # Display the plugin options, if there are some
+    if (defined($pluginargs)) {
+    # Find the length of the longest option string
+    local $maxlength = 0;
+    foreach $option (@$pluginargs) {
+        local $optionname = $option->{'name'};
+        local $optiontype = $option->{'type'};
+
+        local $optionstringlength = length($optionname);
+        if ($optiontype ne "flag") {
+        $optionstringlength = $optionstringlength + 3 + length($optiontype);
+        }
+
+        # Remember the longest
+        if ($optionstringlength > $maxlength) {
+        $maxlength = $optionstringlength;
+        }
+    }
+
+    # Calculate the column offset of the option descriptions
+    local $optiondescoffset = 3 + $maxlength + 2;
+
+    # Display the plugin options
+    print STDERR " options:\n";
+    foreach $option (@$pluginargs) {
+        # Display option name
+        local $optionname = $option->{'name'};
+        print STDERR "  -$optionname";
+        local $optionstringlength = 3 + length($optionname);
+ 
+        # Display option type, if the option is not a flag
+        local $optiontype = $option->{'type'};
+        if ($optiontype ne "flag") {
+        print STDERR " <$optiontype>";
+        $optionstringlength = $optionstringlength + (2 + length($optiontype) + 1);
+        }
+
+        # Display the option description
+        local $optiondesc = $option->{'desc'};
+        &display_text_in_column($optiondesc, $optiondescoffset, $optionstringlength, 80);
+
+        # Show the default value for the option, if there is one
+        local $optiondefault = $option->{'deft'};
+        if (defined($optiondefault)) {
+        print STDERR " " x $optiondescoffset;
+        print STDERR "Default: " . $optiondefault . "\n";
+        }
+
+        # If the option has a list of possible values, display these
+        local $optionvalueslist = $option->{'list'};
+        if (defined($optionvalueslist)) {
+        print STDERR "\n";
+        foreach $optionvalue (@$optionvalueslist) {
+            local $optionvaluename = $optionvalue->{'name'};
+            print STDERR " " x $optiondescoffset;
+            print STDERR "$optionvaluename:";
+
+            local $optionvaluedesc = $optionvalue->{'desc'};
+            &display_text_in_column($optionvaluedesc, ($optiondescoffset + 2),
+                        $optiondescoffset + length($optionvaluename), 80);
+        }
+        }
+
+        # Special case for 'input_encoding'
+        if ($optionname =~ m/^input_encoding$/i) {
+        my $e = $encodings::encodings;
+        foreach $enc (sort {$e->{$a}->{'name'} cmp $e->{$b}->{'name'}} keys (%$e)) {
+            local $encodingname = $enc;
+            print STDERR " " x $optiondescoffset;
+            print STDERR "$enc:";
+
+            local $encodingdesc = $e->{$enc}->{'name'};
+            &display_text_in_column($encodingdesc, ($optiondescoffset + 2),
+                        $optiondescoffset + length($encodingname), 80);
+        }
+        }
+
+        # Add a blank line to separate options
+        print STDERR "\n";
+    }
+    }
+
+    # If the plugin inherits from another, do the parent now
+    if (defined($optionlist)) {
+    $self->print_usage_new();
+    }
+}
+
+
+sub display_text_in_column
+{
+    local ($text, $columnbeg, $firstlineoffset, $columnend) = @_;
+
+    # Spaces are put *before* words, so treat the column beginning as 1 smaller than it is
+    $columnbeg = $columnbeg - 1;
+
+    # Add some padding (if needed) for the first line
+    local $linelength = $columnbeg;
+    if ($firstlineoffset < $columnbeg) {
+    print STDERR " " x ($columnbeg - $firstlineoffset);
+    }
+    else {
+    $linelength = $firstlineoffset;
+    }
+
+    # Break the text into words, and display one at a time
+    local @words = split(/ /, $text);
+
+    foreach $word (@words) {
+    # Unescape '<' and '>' characters
+    $word =~ s/&lt;/</g;
+    $word =~ s/&gt;/>/g;
+
+    # If printing this word would except the column end, start a new line
+    if (($linelength + length($word)) >= $columnend) {
+        print STDERR "\n";
+        print STDERR " " x $columnbeg;
+        $linelength = $columnbeg;
+    }
+
+    # Write the word
+    print STDERR " " . $word;
+    $linelength = $linelength + (length($word) + 1);
+    }
+
+    print STDERR "\n";
+}
+
+
 sub print_general_usage {
     my ($plugin_name) = @_;
@@ -316 +471 @@
              q^process_exp/.*/^, \$self->{'process_exp'},
              q^block_exp/.*/^, \$self->{'block_exp'},
+             q^extract_language^, \$self->{'extract_language'},
              q^extract_acronyms^, \$self->{'extract_acronyms'}, 
-             q^extract_keyphrases^, \$self->{'kea'}, #with extra options 
-             q^extract_keyphrase_options/.*/^, \$self->{'kea_options'}, #no extra options
+             q^extract_keyphrases^, \$self->{'kea'}, #with extra options (UNDOCUMENTED)
+             q^extract_keyphrase_options/.*/^, \$self->{'kea_options'}, #no extra options (UNDOCUMENTED)
              qq^input_encoding/$enc/auto^, \$self->{'input_encoding'},
              qq^default_encoding/$denc/utf8^, \$self->{'default_encoding'},