Annotation of loncom/cgi/translator.pl, revision 1.1

1.1     ! www         1: #!/usr/bin/perl
        !             2: $|=1;
        !             3: # Generates a html page showing various sataus reports about the cluster
        !             4: # $Id: clusterstatus.pl,v 1.23 2003/09/14 19:00:03 www Exp $
        !             5: #
        !             6: # Copyright Michigan State University Board of Trustees
        !             7: #
        !             8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
        !             9: #
        !            10: # LON-CAPA is free software; you can redistribute it and/or modify
        !            11: # it under the terms of the GNU General Public License as published by
        !            12: # the Free Software Foundation; either version 2 of the License, or
        !            13: # (at your option) any later version.
        !            14: #
        !            15: # LON-CAPA is distributed in the hope that it will be useful,
        !            16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
        !            17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
        !            18: # GNU General Public License for more details.
        !            19: #
        !            20: # You should have received a copy of the GNU General Public License
        !            21: # along with LON-CAPA; if not, write to the Free Software
        !            22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
        !            23: #
        !            24: # /home/httpd/html/adm/gpl.txt
        !            25: #
        !            26: # http://www.lon-capa.org/
        !            27: #
        !            28: use strict;
        !            29: use GDBM_File;
        !            30: 
        !            31: my $buffer;
        !            32: 
        !            33: read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
        !            34: my @pairs=split(/&/,$buffer);
        !            35: my $pair; my $name; my $value;
        !            36: 
        !            37: my %FORM=();
        !            38: my %hash=();
        !            39: 
        !            40: foreach $pair (@pairs) {
        !            41:     ($name,$value) = split(/=/,$pair);
        !            42:     $value =~ tr/+/ /;
        !            43:     $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
        !            44:     $FORM{$name}=$value;
        !            45: } 
        !            46: 
        !            47: 
        !            48: $buffer=$ENV{'QUERY_STRING'};
        !            49: @pairs=split(/&/,$buffer);
        !            50: foreach $pair (@pairs) {
        !            51:     ($name,$value) = split(/=/,$pair);
        !            52:     $value =~ tr/+/ /;
        !            53:     $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
        !            54:     $FORM{$name}=$value;
        !            55: } 
        !            56: print 'Content-type: text/html'."\n\n";
        !            57: 
        !            58: 
        !            59:     print (<<ENDSCREEN);
        !            60: <html><body>
        !            61: <h1>LON-CAPA Localization Project</h1>
        !            62: <h3>Language: $FORM{'lang'}</h3>
        !            63: <a href="/cgi-bin/translator.pl?lang=$FORM{'lang'}&list=1">List all</a><br />
        !            64: ENDSCREEN
        !            65: 
        !            66: $FORM{'lang'}=~s/\W//g;
        !            67: 
        !            68: if ($FORM{'trans'}) {
        !            69:     if (tie(%hash,'GDBM_File',
        !            70: 	  '/home/httpd/perl/logs/'.$FORM{'lang'}.'.db',&GDBM_WRCREAT(),0640)) {
        !            71: 	$hash{$FORM{'arg1'}}=$FORM{'trans'};
        !            72: 	untie %hash;
        !            73: 	print "Stored.";
        !            74:     }
        !            75: } elsif ($FORM{'list'}) {
        !            76:     if (tie(%hash,'GDBM_File',
        !            77: 	  '/home/httpd/perl/logs/'.$FORM{'lang'}.'.db',&GDBM_READER(),0640)) {
        !            78: 	print "<pre>";
        !            79: 	foreach (sort keys %hash) {
        !            80: 	    print "\n   '".$_."'".
        !            81: 		"\n=> '".$hash{$_}."',\n";
        !            82: 	}
        !            83: 	print "</pre>";
        !            84: 	untie %hash;
        !            85:     }
        !            86: } else {
        !            87:     my $trans=$FORM{'arg1'};
        !            88:     if (tie(%hash,'GDBM_File',
        !            89: 	  '/home/httpd/perl/logs/'.$FORM{'lang'}.'.db',&GDBM_READER(),0640)) {
        !            90: 	if ($hash{$trans}) { $trans=$hash{$trans}; }
        !            91: 	untie %hash;
        !            92:     }
        !            93:     print (<<ENDQUERY);
        !            94: <blockquote>$FORM{'arg1'}</blockquote>
        !            95: <form method="post">
        !            96: <input type="hidden" name="org" value="$FORM{'arg1'}">
        !            97: <input type="hidden" name="lang" value="$FORM{'lang'}">
        !            98: <input type="text" size="80" name="trans" value="$trans">
        !            99: <input type="submit">
        !           100: </form>
        !           101: ENDQUERY
        !           102: }
        !           103: 
        !           104: print('</body></html>');
        !           105: exit 0;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>