#!/usr/bin/perl -wT
#this is for /usr/internet/infosystems/httpd/cgi-bin or /www/cgi-bin
# Copyright: Guido Socher, eedgus
# $Revision: 1.4 $, last changed: $Date: 1999/10/06 20:29:11 $
#
=head1 Get a new articel number
getticket provides a interface to reserve new article numbers.
=head1 DESCRIPTION
This is a system where editors can themselves pick article numbers
in advance. getticket sends out mails.
=cut
# -------------------------------------------------------
use strict;
my %FORM;
my %html;
#
# Location of important files
#
my $url = "undefined";
#
my %LANGUAGES = ( " en" => "English" , " es" => "Spanish" , " fr" => "French" ,
" de" => "German" );
#
my @LANGS;
my $NumLANGS=0;
#
my $dbfile= "ArticleNumbers.txt";
my $langfile="ArticleLanguages.txt";
#
my %STATUS;
my %TYPES = (
" free" => 'Untranslated',
" going" => 'In curse' ,
" done" => 'Finished'
);
#
#print "Content-type: text/html\n\n";
#
&cgi_receive;
my $number;
my $title;
my %TRANSLATORS;
my $lang;
my %languages;
my @line;
&readHTMLpage;
&printHTMLpage('main');
my $count=0;
open(FF,"$langfile")||die "ERROR: languages file doesn't exist\n";
while() {
next unless (/\w/);
chomp;
@line=split(/\+\+/);
$number = shift @line;
chop $number;
chop @line;
if ( $number eq "000" ) {
while ( ($LANGS[$NumLANGS] = shift @line) ) {
next unless $LANGS[$NumLANGS] ne ' 00';
$NumLANGS++;
}
next;
}
for ( $count=0 ; $count<$NumLANGS ; $count++ ) {
if ( $line[$count] ne ' 00' && $line[$count] ne ' ' ) {
$STATUS{$number . $LANGS[$count]} = $line[$count];
}
}
}
close FF;
&printHTMLpage('tablehead');
print "
\n";
open(FF,"$dbfile")||die "ERROR: can not read db\n";
for ( $count=0 ; $count<$NumLANGS ; $count++ ) {
print '
\n";
}
close FF;
&printHTMLpage('tablefoot');
&printHTMLpage('mainfoot');
#--------------------------------------------------------
sub printHTMLpage($){
my $reqpage = shift;
my $tmp;
die "ERROR: no such template $reqpage\n" unless ($html{$reqpage});
for (@{$html{$reqpage}}){
print;
}
}
#--------------------------------------------------------
sub readHTMLpage(){
#read and print any text between __ xxx __ and the next __
my $pagename="nix";
while(){
if (/^__ (\w+) __/){
$pagename=$1;
next;
}
next if (/^__ /);
# the /o is important!!
s/\$url/$url/o;
push(@{$html{$pagename}},$_);
}
}
#--------------------------------------------------------
sub cgi_receive{
my $buffer = "";
my $pair;
my $name;
my $value;
if ($ENV{'GATEWAY_INTERFACE'} && $ENV{'GATEWAY_INTERFACE'} =~ /CGI/){
if ($ENV{'REQUEST_METHOD'} eq 'GET') {
if($ENV{'QUERY_STRING'}){
$buffer = $ENV{'QUERY_STRING'};
}
}elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
read(STDIN, $buffer,$ENV{'CONTENT_LENGTH'});
}else{
die "Unknown REQUEST_METHOD: $ENV{'REQUEST_METHOD'}";
}
}else {
$buffer = $ARGV[0] if ($ARGV[0]);
}
# now decode it:
#
# Split the name-value pairs
foreach $pair (split(/\&/, $buffer)){
($name, $value) = split(/=/, $pair);
$value = " " unless ($value);
# Un-Webify plus signs and %-encoding
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$FORM{$name} = $value;
}
}
#--------------------------------------------------------
__END__
__ main __
LF article ticket number
LinuxFocus article translation status report.
__ main2 __
The box below should be revisited. It's there in order to avoid rewriting.