#!/usr/bin/perl -w
BEGIN {
}
print
(
join
"\n"
,
"Content-type: text/html"
,
""
,
""
,
"<head>"
,
"<title>Portuguese Verb Conjugation & Recognition</title>"
,
"<meta name=\"keywords\" "
,
"content=\"Portuguese Portugues verb verbo conjugation recognition\" />"
,
"<meta name=\"description\" content=\"Conjugate and recognize Portuguese verbs\" />"
,
"<link rel=\"stylesheet\" type=\"text/css\""
,
"</head>"
,
"<body>"
);
%FORM
= getform();
$FORM
{verbname} =
""
unless
exists
$FORM
{verbname};
$FORM
{action} =
"conjug"
unless
exists
$FORM
{action};
if
(!
$FORM
{verbname}) {
print
"<H2>You haven't specified any verb, or there's a bug somewhere .... </H2>"
;
}
elsif
(
$FORM
{action} eq
"unconj"
) {
$theverb
=
$FORM
{verbname} ;
$theverb
=~ /\s*(\S+)\s*/ ;
$theverb
= $1 ;
$ans
= unconj(
$theverb
) ;
@res
= list_entries(
"l"
,
$ans
) ;
if
(
@res
)
{
$v
=
''
;
foreach
(
@res
)
{
$v
.=
"<TR><TD ALIGN=CENTER><BIG>"
;
$v
.=
join
"</BIG></TD><TD ALIGN=CENTER><BIG>"
,
@$_
;
$v
.=
"</BIG></TD></TR>"
;
}
$v
=
join
"\n"
,
"<BIG>"
,
"<center>"
,
"<P>The word <B>$theverb</B> is recognized as :"
,
"<BR>"
,
"<P><TABLE BORDER=5 CELLPADDING=10>"
,
"<TR><TD ALIGN=CENTER><BIG>Infinitive</BIG></TD>"
,
"<TD ALIGN=CENTER><BIG>Tense</BIG></TD>"
,
"<TD ALIGN=CENTER><BIG>Person</BIG></TD></TR>"
,
"$v"
,
"</TABLE>"
,
"<BR>"
,
"</BIG>"
,
"</center>"
,
"\n"
;
}
else
{
$ans
= unconj(
"-a"
,
$theverb
) ;
@res
= list_entries(
"l"
,
$ans
) ;
if
(
@res
)
{
$v
=
''
;
foreach
$x
(
@res
) {
my
(
$i
,
$t
,
$p
) =
@$x
;
$x
->[3] = conjug(
"s"
,
$i
,
$t
,
$p
) ;
$v
.=
"<TR><TD ALIGN=CENTER><BIG>"
;
$v
.=
join
"</BIG></TD><TD ALIGN=CENTER><BIG>"
,
@$x
;
$v
.=
"</BIG></TD></TR>"
;
}
$v
=
join
"\n"
,
"<BIG>"
,
"<center>"
,
"<P>The word <B>$theverb</B> is not recognized as-is. However, it looks"
,
"like :"
,
"<BR>"
,
"<P><TABLE BORDER=5 CELLPADDING=10 CELLSPACING=0>"
,
"<TR><TD ALIGN=CENTER><BIG>Infinitive</BIG></TD>"
,
"<TD ALIGN=CENTER><BIG>Tense</BIG></TD>"
,
"<TD ALIGN=CENTER><BIG>Person</BIG></TD>"
,
"<TD ALIGN=CENTER><BIG>Correct Form</BIG></TD></TR>"
,
"$v"
,
"</TABLE>"
,
"<BR>"
,
"<P><B>"
,
"This software comes with NO GUARANTY. </B> "
,
"</BIG>"
,
"</center>"
,
"\n"
;
}
else
{
$v
=
join
"\n"
,
"<BIG><CENTER>"
,
"Sorry, $FORM{verbname} is not recognized. This could be due to a bug"
,
"</BIG></CENTER>"
,
"\n"
;
}
}
print
"<html>"
,
"<h3> Output of unconj : </h3>\n"
,
"$v <BR>\n"
,
"<p> Problems? Found an error in the program?\n"
,
"<A HREF=\"mailto:etienne\@isr.ist.utl.pt\">send me a mail.</a>\n"
;
}
else
{
$theverb
=
$FORM
{verbname} ;
$theverb
=~ /\s*(\S+)\s*/ ;
$theverb
= $1 ;
@opts
= (
"ol"
) ;
push
@opts
,
"-i"
if
$FORM
{isoacc} ;
$v
= conjug (
@opts
,
$theverb
) ;
if
(
$v
=~ /\S/ ){
my
$i
= -1;
sub
rowcol () {
$i
++ % 2 ?
'bgcolor="#efefff"'
:
""
}
$v
=~ s{^(.*)?\s*,}{
"<TR "
. rowcol() .
"><TD> <B>$1</B> </TD><TD> "
}emg;
$v
=~ s!$!</TR></TD>\n!mg ;
$v
=~ s{\s*,\s*}{ </TD><TD> }g ;
$tmp
=
join
(
"</B></TD><TD><B>"
,
"<\TR><TR><TD COLSPAN=7></TD><\TR>"
,
"\n<TR bgcolor=\"#dfdfff\"><TD><B>"
,
"eu"
,
"tu"
,
"ela/ele"
,
"nós"
,
"vós"
,
"eles/elas"
,
"</B><\TR><TR><TD COLSPAN=7></TD><\TR>"
);
$tmp
=~ s/ó/
'o/g if $FORM{isoacc} ; # '
$v
=~ s{(.*?\<\/TR\>)}{ $1
$tmp
}m ;
$v
=
"<center><TABLE rules=\"none\" cellpadding=\"3\">$v</TABLE></center>"
;
}
else
{
$v
=
"Sorry, $FORM{verbname} does not look like a verb ... \n"
;
}
print
"<html>"
,
"<h3> Output of conjug : </h3>\n"
,
"$v <BR>\n"
,
"<p> Problems? Found an error in the program?\n"
,
"<A HREF=\"mailto:etienne\@isr.ist.utl.pt\">send me a mail.</a>\n"
;
}
printform();
print
<<EOFHTML;
</BODY>
</HTML>
EOFHTML
sub
printform {
my
(
$cconj
,
$cunconj
) =
$FORM
{action} eq
"unconj"
?
(
""
,
'checked="checked"'
) : (
'checked="checked"'
,
""
) ;
print
<<EOFHTML;
<h1>Portuguese Verb Conjugation and Recognition Form</h1>
<form method=
"post"
action=
"$thisurl"
enctype=
"application/x-www-form-urlencoded"
>
Accents can be entered as
"'e"
for
"é"
,
"~a"
for
"ã"
,
"\c"
for
"ç"
etc.<br>
<p class=
"myform"
><br>
Enter a new query
<input type=
"text"
name=
"verbname"
/>
<input type=
"submit"
name=
"submit"
value=
"submit"
/>
Action :
<input type=
"radio"
name=
"action"
value=
"conj"
$cconj
/>Conjugate
<input type=
"radio"
name=
"action"
value=
"unconj"
$cunconj
/>Recognize
<br>
<br>
<input type=
"checkbox"
name=
"isoacc"
unchecked>
Don't output accentuated (ISO-8959-1) characters<br>
<br>
</p>
</form>
<p>Author : <A HREF=
"mailto:etienne\@isr.ist.utl.pt"
>Etienne Grossmann</A>
(contact me
for
any kind of feedback).</p>
EOFHTML
}
sub
getform {
my
$buffer
=
""
;
if
(
exists
(
$ENV
{
'REQUEST_METHOD'
}) &&
$ENV
{
'REQUEST_METHOD'
} eq
"POST"
) {
read
(STDIN,
$buffer
,
$ENV
{
'CONTENT_LENGTH'
});
}
elsif
(
exists
$ENV
{
'QUERY_STRING'
}) {
$buffer
=
$ENV
{
'QUERY_STRING'
};
}
my
@pairs
=
split
(/&/,
$buffer
);
foreach
my
$pair
(
@pairs
)
{
my
(
$name
,
$value
) =
split
(/=/,
$pair
);
$value
=~ s/\+/ /g;
$value
=~ s/%([a-fA-F0-9][a-fA-F0-9])/
pack
(
"C"
,
hex
($1))/eg;
$value
=~ s/~!/ ~!/g;
$value
=~ s/\</\
<
\;/g;
$value
=~ s/\>/\
>
\;/g;
$value
=~ s/[\r\n]//g;
push
(
@data
,
$name
,
$value
);
}
my
%form
=
@data
;
}