source: trunk/gsdl/perllib/printusage.pm@ 4873

###########################################################################
#
# printusage.pm --
# A component of the Greenstone digital library software
# from the New Zealand Digital Library Project at the 
# University of Waikato, New Zealand.
#
# Copyright (C) 1999 New Zealand Digital Library Project
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
###########################################################################


package PrintUsage;


sub print_xml_header
{
    print STDERR "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
    print STDERR "<!DOCTYPE Info [\n";
    print STDERR "  <!ELEMENT Info      (Name, Desc, Arguments)>\n";
    print STDERR "  <!ELEMENT Arguments (Option*)>\n";
    print STDERR "  <!ELEMENT Option    (Name, Desc, Type, Required, Default?, List?)>\n";
    print STDERR "  <!ELEMENT Name      (#PCDATA)>\n";
    print STDERR "  <!ELEMENT Desc      (#PCDATA)>\n";
    print STDERR "  <!ELEMENT Type      (#PCDATA)>\n";
    print STDERR "  <!ELEMENT Required  (#PCDATA)>\n";
    print STDERR "  <!ELEMENT Default   (#PCDATA)>\n";
    print STDERR "  <!ELEMENT List      (Value*)>\n";
    print STDERR "  <!ELEMENT Value     (Name, Desc?)>\n";
    print STDERR "]>\n\n";
}


sub print_options_xml
{
    local $language = shift(@_);
    local $options = shift(@_);

    foreach $option (@$options) {
    local $optionname = $option->{'name'};
    local $optiondesc = &lookup_string($language, $option->{'desc'});

    # Escape '<' and '>' characters
    $optiondesc =~ s/</&lt;/g;
    $optiondesc =~ s/>/&gt;/g;

    # Display option name, description and type
    print STDERR "    <Option>\n";
    print STDERR "      <Name>$optionname</Name>\n";
    print STDERR "      <Desc>$optiondesc</Desc>\n";
    print STDERR "      <Type>$option->{'type'}</Type>\n";

    # If the option has a required field, display this
    if (defined($option->{'reqd'})) {
        print STDERR "      <Required>$option->{'reqd'}</Required>\n";
    }

    # If the option has a list of possible values, display these
    if (defined $option->{'list'}) {
        print STDERR "      <List>\n";
        local $optionvalueslist = $option->{'list'};
        foreach $optionvalue (@$optionvalueslist) {
        print STDERR "        <Value>\n";
        print STDERR "          <Name>$optionvalue->{'name'}</Name>\n";
        if (defined $optionvalue->{'desc'}) {
            local $optionvaluedesc = &lookup_string($language, $optionvalue->{'desc'});

            # Escape '<' and '>' characters
            $optionvaluedesc =~ s/</&lt;/g;
            $optionvaluedesc =~ s/>/&gt;/g;

            print STDERR "          <Desc>$optionvaluedesc</Desc>\n";
        }
        print STDERR "        </Value>\n";
        }

        # 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)) {
            print STDERR "        <Value>\n";
            print STDERR "          <Name>$enc</Name>\n";
            print STDERR "          <Desc>$e->{$enc}->{'name'}</Desc>\n";
            print STDERR "        </Value>\n";
        }
        }

        print STDERR "      </List>\n";
    }

    # Show the default value for the option, if there is one
    if (defined $option->{'deft'}) {
        print STDERR "      <Default>$option->{'deft'}</Default>\n";
    }

    print STDERR "    </Option>\n";
    }
}


sub find_longest_option_string
{
    local $options = shift(@_);

    local $maxlength = 0;
    foreach $option (@$options) {
    local $optionname = $option->{'name'};
    local $optiontype = $option->{'type'};

    local $optionlength = length("  -$optionname");
    if ($optiontype ne "flag") {
        $optionlength = $optionlength + length(" <$optiontype>");
    }

    # Remember the longest
    if ($optionlength > $maxlength) {
        $maxlength = $optionlength;
    }
    }
    return $maxlength;
}


sub print_options_txt
{
    local $language = shift(@_);
    local $options = shift(@_);
    local $optiondescoffset = shift(@_);

    foreach $option (@$options) {
    # Display option name
    local $optionname = $option->{'name'};
    print STDERR "  -$optionname";
    local $optionstringlength = 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 + length(" <$optiontype>");
    }

    # Display the option description
    local $optiondesc = &lookup_string($language, $option->{'desc'});
    local $optionreqd = $option->{'reqd'};
    if (defined($optionreqd) && $optionreqd eq "yes") {
        $optiondesc = "(REQUIRED) " . $optiondesc;
    }
    &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 = &lookup_string($language, $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)) {
        print STDERR " " x $optiondescoffset;
        print STDERR "$enc:";

        local $encodingdesc = $e->{$enc}->{'name'};
        &display_text_in_column($encodingdesc, $optiondescoffset + 2,
                    $optiondescoffset + length("$enc:"), 80);
        }
    }

    # Add a blank line to separate options
    print STDERR "\n";
    }
}


sub lookup_string
{
    local ($language, $stringkey) = @_;

    # Load the appropriate resource bundle
    local %resourcebundle = &load_resource_bundle($language);

    # Return the text matching the key (or just the key, if no match was found)
    return $resourcebundle{$stringkey} || $stringkey;
}


my $cachedlanguage = "<none>";
my %cachedresourcebundle = ();

sub load_resource_bundle
{
    local $language = shift(@_);

    # If the desired resource bundle is the one cached, return it
    if ($language eq $cachedlanguage) {
    return %cachedresourcebundle;
    }

    # Open the appropriate resource bundle
    local $resourcebundlehome = &util::filename_cat("$ENV{'GSDLHOME'}", "perllib");
    local $resourcebundlename = "strings_" . $language . ".rb";
    local $resourcebundlefile = &util::filename_cat($resourcebundlehome, $resourcebundlename);

    # If the specific resource bundle cannot be opened, use the generic (English) one
    if (!open(RESOURCE_BUNDLE, "<$resourcebundlefile")) {
    $resourcebundlename = "strings.rb";
    $resourcebundlefile = &util::filename_cat($resourcebundlehome, $resourcebundlename);
    open(RESOURCE_BUNDLE, "<$resourcebundlefile")
        or die "Error: Could not open generic resource bundle $resourcebundlefile.\n";
    }

    local @resourcebundlelines = <RESOURCE_BUNDLE>;
    close(RESOURCE_BUNDLE);

    # Load and cache this resource bundle
    $cachedlanguage = $language;
    %cachedresourcebundle = ();
    foreach $line (@resourcebundlelines) {
    # Remove any trailing whitespace
    $line =~ s/(\s*)$//;

    # Ignore comments and empty lines
    if ($line !~ /^\#/ && $line ne "") {
        # Parse key (everything up to the first colon)
        $line =~ /^([^:]+):(.+)$/;
        local $linekey = "{" . $1 . "}";
        local $linetext = $2;

        # Map key to text
        $cachedresourcebundle{$linekey} = $linetext;
    }
    }

    return %cachedresourcebundle;
}


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) {
    # If printing this word would exceed 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");
    }

    print STDERR "\n";
}


1;