source: main/tags/2.40/gsdl/perllib/printusage.pm@ 25668

###########################################################################
#
# 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 $options = shift(@_);

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

    # Display option name, description and type
    print STDERR "    <Option>\n";
    print STDERR "      <Name>$optionname</Name>\n";
    print STDERR "      <Desc>$option->{'desc'}</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'}) {
            print STDERR "          <Desc>$optionvalue->{'desc'}</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 $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 = $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 = $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) {
    # Unescape '<' and '>' characters
    $word =~ s/&lt;/</g;
    $word =~ s/&gt;/>/g;

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