source: trunk/gsdl/perllib/gsprintf.pm@ 6940

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


use unicode;
use util;


my $loadedlanguage = "<none>";
my %loadedresourcebundle = ();
my $outputencoding;


sub gsprintf
{
    my ($handle, $text_string, @text_arguments) = @_;

    # Return unless the required arguments were supplied
    return unless (defined($handle) && defined($text_string));

    # Look up all the strings in the dictionary
    $text_string =~ s/(\{[^\}]+\})/&lookup_string($1)/eg;

    # Resolve the string arguments using sprintf, then write out to the handle
    print $handle sprintf($text_string, @text_arguments);
}


sub lookup_string
{
    my ($stringkey) = @_;

    # Load the default resource bundle if one isn't already loaded
    if ($loadedlanguage eq "<none>") {
    &load_resource_bundle("");
    }

    # Return just the key if there is no string matching the key
    return $stringkey if (!defined($loadedresourcebundle{$stringkey}));

    # Otherwise return the string matching the key
    my $utf8_string = $loadedresourcebundle{$stringkey};
    return $utf8_string if (!defined($outputencoding) || $outputencoding eq "UTF-8");

    # If an 8-bit output encoding has been defined, encode the string appropriately
    return &unicode::unicode2singlebyte(&unicode::utf82unicode($utf8_string), $outputencoding);
}


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

    # If the desired resource bundle is the one already loaded, no action is necessary
    if ($language eq $loadedlanguage) {
    return;
    }

    # Open the appropriate resource bundle
    my $resourcebundlehome = &util::filename_cat("$ENV{'GSDLHOME'}", "perllib");
    my $resourcebundlename = "strings_" . $language . ".rb";
    my $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";
    }

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

    # Load this resource bundle
    $loadedlanguage = $language;
    %loadedresourcebundle = ();
    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 =~ /^([^:]+):(.+)$/;
        my $linekey = "{" . $1 . "}";
        my $linetext = $2;

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

    # Read the output encoding to use from the resource bundle
    if ($ENV{'GSDLOS'} =~ /windows/) {
    $outputencoding = $loadedresourcebundle{"{OutputEncoding.windows}"};
    }
    else {
    $outputencoding = $loadedresourcebundle{"{OutputEncoding.unix}"};
    }
}


sub get_output_encoding
{
    return $outputencoding;
}


sub set_output_encoding
{
    $outputencoding = shift(@_);
}


1;