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

###########################################################################
#
# 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;


use gsprintf;


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, Range, 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 Range     (#PCDATA)>\n";
    print STDERR "  <!ELEMENT Default   (#PCDATA)>\n";
    print STDERR "  <!ELEMENT List      (Value*)>\n";
    print STDERR "  <!ELEMENT Value     (Name, Desc?)>\n";
    print STDERR "  <!ELEMENT HiddenGLI (#PCDATA)>\n";
    print STDERR "]>\n\n";
}


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

    foreach $option (@$options) {
    local $optionname = $option->{'name'};
    local $optiondesc = &gsprintf::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 range field, display this
    if (defined($option->{'range'})) {
        print STDERR "      <Range>$option->{'range'}</Range>\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 = &gsprintf::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'}) {
        my $optiondeftvalue = $option->{'deft'};

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

        print STDERR "      <Default>$optiondeftvalue</Default>\n";
    }

    # If the option is noted as being hidden in GLI, add that to the printout
    if (defined($option->{'hiddengli'})) {
        print STDERR "      <HiddenGLI>$option->{'hiddengli'}</HiddenGLI>\n";
    }
    # If the argument is not hidden then print out the lowest detail mode it is visible in
    if (defined($option->{'modegli'})) {
        print STDERR "      <ModeGLI>$option->{'modegli'}</ModeGLI>\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 = &gsprintf::lookup_string($language, $option->{'desc'});
    local $optionreqd = $option->{'reqd'};
    if (defined($optionreqd) && $optionreqd eq "yes") {
        $optiondesc = "(" . &gsprintf::lookup_string($language, "{PrintUsage.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 &gsprintf::lookup_string($language, "{PrintUsage.default}");
        print STDERR ": " . &gsprintf::lookup_string($language, $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 = &gsprintf::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 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;