source: main/tags/2.40/gsdl/bin/script/picklanguage.pl@ 21085

#!/usr/bin/perl -w

###########################################################################
#
# picklanguage.pl
#
# 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.
#
###########################################################################

# This code generates the front page of the Greenstone Interface Translation Agency
# which asks the user to pick their base language and translating language before
# proceeding into the translation pages

BEGIN {
    if (!defined($ENV{'GSDLHOME'})) {
    print STDERR "GSDLHOME not set\n";
    return 1;
    }
    unshift (@INC, "$ENV{'GSDLHOME'}/perllib");
}


use util;
use CGI;


sub main
{
    my $gsdldir = "$ENV{'GSDLHOME'}";
    # Read the languages available from etc/main.cfg
    my $maincfg_fname = util::filename_cat($gsdldir, "etc", "main.cfg");
    if (!open(MCFILE, "<$maincfg_fname")) {
    print STDERR "Error: Could not open $maincfg_fname: $!\n";
    return 2;
    }

    my @languages;
    my $line;
    while (defined ($line=<MCFILE>)) {
    chomp($line);
    if ($line =~ m/^Language\s+/i) {
        my @args = split(/ +/,$line);
        my ($lang_abbr) = ($args[1] =~ m/^shortname=(.*)$/);
        my ($lang_long) = ($args[2] =~ m/^longname=(.*)$/);
        push(@languages, $lang_long);
    }
    }
    close MCFILE;

    # Write the HTML content of the page to tmp/lang/picklanguage.lang
    my $dir = util::filename_cat($gsdldir, "tmp", "lang");
    # creates directory if it doesn't already exist
    my $currentmask = umask;
    umask(0000);
    if (!-e $dir) {
    if (! mkdir($dir, 0777)) {
        print STDERR "Couldn't create directory $dir\n";
        return 3;
    }
    }
    my $picklang_fname = util::filename_cat($dir, "picklanguage.lang");

    # Make the file world writeable
    if (! open(HTMLFILE,">$picklang_fname")) {
    umask($currentmask);
    print STDERR "Error: Could not create $picklang_fname: $!\n";
    return 4;
    }
    umask($currentmask);

    # Writes to file the instructions on how to use the interface (_textinitial_)
    #   and then displays a table at the end with menu options from which the user
    #   selects their base and translation languages, and submits these choices
    #   to proceed into the interface translation agency
    my $query = new CGI;
    print HTMLFILE (" _textinitial_ <br>\n",
            "<table border=\"2\" cellpadding=\"8\"><tr><td><center>",
            "_textselectbase_ <p>\n",
            $query->popup_menu(-name=>"bl",
                       -values=>\@languages,
                       -default=>'English'),
            "<p></center></td><td><center>\n",
            "_textselectforeign_ <p>\n",
            $query->popup_menu(-name=>"tlng",
                       -values=>\@languages),
            "<p>\n",
            "_textselectnew_ <p>\n",
            $query->textfield(-name=>"ownchoice",
                      -default=>"",
                      -size=>50),
            "<p></center></td></tr></table>\n",
            $query->submit("submitlanguage","_textenter_"),
            "</center><p>\n",
            "<center><img src=\"_httpimg_/divb.gif\"></center><p>");
    close HTMLFILE;
    return 0;
}


exit &main();