source: main/tags/2.51/gsdl/perllib/gsprintf.pm@ 32629

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


# Language-specific resource bundle
my %specialresourcebundle = ();
our $specialoutputencoding; # our, so that it can be changed outside.

# Default resource bundle
my %defaultresourcebundle;
my $defaultoutputencoding;

# English resource bundle
my %englishresourcebundle;
my $englishoutputencoding;

# Ignore the OutputEncoding strings in the resource bundles and output all text in UTF-8
my $outputstringsinUTF8 = 0;


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) = @_;
    # Try the language-specific resource bundle first
    my $utf8string = $specialresourcebundle{$stringkey};
    my $outputencoding = $specialoutputencoding;

    # Try the default resource bundle next
    if (!defined($utf8string)) {
    # Load the default resource bundle if it is not already loaded
    &load_default_resource_bundle() if (!%defaultresourcebundle);

    $utf8string = $defaultresourcebundle{$stringkey};
    $outputencoding = $defaultoutputencoding;
    }

    # Try the English resource bundle last
    if (!defined($utf8string)) {
    # Load the English resource bundle if it is not already loaded
    &load_english_resource_bundle() if (!%englishresourcebundle);

    $utf8string = $englishresourcebundle{$stringkey};
    $outputencoding = $englishoutputencoding;
    }

    # No matching string was found, so just return the key
    if (!defined($utf8string)) {
    return $stringkey;
    }

    # Return the string matching the key
    return $utf8string if (!defined($outputencoding) || $outputstringsinUTF8
               || $outputencoding eq "utf8");

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


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

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

    %specialresourcebundle = &read_resource_bundle($resourcebundlefile);
    return if (!%specialresourcebundle);

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


sub load_default_resource_bundle
{
    # Read the default resource bundle
    my $resourcebundlehome = &util::filename_cat("$ENV{'GSDLHOME'}", "perllib");
    my $resourcebundlename = "strings.rb";
    my $resourcebundlefile = &util::filename_cat($resourcebundlehome, $resourcebundlename);

    %defaultresourcebundle = &read_resource_bundle($resourcebundlefile);
    return if (!%defaultresourcebundle);

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


sub load_english_resource_bundle
{
    # Ensure the English resource bundle hasn't already been loaded
    if ($specialresourcebundle{"{Language.code}"} eq "en") {
    $englishresourcebundle = $specialresourcebundle;
    $englishoutputencoding = $specialoutputencoding;
    }
    if ($defaultresourcebundle{"{Language.code}"} eq "en") {
    $englishresourcebundle = $defaultresourcebundle;
    $englishoutputencoding = $defaultoutputencoding;
    }

    # Read the English resource bundle
    my $resourcebundlehome = &util::filename_cat("$ENV{'GSDLHOME'}", "perllib");
    my $resourcebundlename = "strings_en.rb";
    my $resourcebundlefile = &util::filename_cat($resourcebundlehome, $resourcebundlename);

    %englishresourcebundle = &read_resource_bundle($resourcebundlefile);
    return if (!%englishresourcebundle);

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


sub read_resource_bundle
{
    my ($resourcebundlefilepath) = shift(@_);

    # Return an empty hash if the specified resource bundle could not be read
    return () if (!open(RESOURCE_BUNDLE, "<$resourcebundlefilepath"));

    # Load this resource bundle
    my @resourcebundlelines = <RESOURCE_BUNDLE>;
    close(RESOURCE_BUNDLE);

    # Parse the resource bundle
    my %resourcebundle = ();
    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
        $resourcebundle{$linekey} = $linetext;
    }
    }

    return %resourcebundle;
}


sub output_strings_in_UTF8
{
    $outputstringsinUTF8 = 1;
}


1;