package rutines;
use strict;
use CGI ':standard';

use vars qw(@ISA @EXPORT $VERSION $urlFonemes $farciment $data $dia $mes $any $LATEL $IULA $UPF);

use Exporter;
$VERSION = 1.00;
@ISA = qw(Exporter);

@EXPORT      = qw($farciment $data $dia $mes $any $LATEL $IULA $UPF);

push (@EXPORT, qw(preparaCella printCella printTh printFila signaPerl signoJo));
push (@EXPORT, qw(demanaIP xuclaParam representa representaUnicode));
push (@EXPORT, qw(escriune2 escriune4 llegeixne2 llegeixne4 ltrim rtrim));
push (@EXPORT, qw(extreuDeLlista document documentCSS taula expressaData fesText fesMenu));
push (@EXPORT, qw(preparaMenu1 preparaMenu2 zeroXifra print_fila representaUnicodeWap));
push (@EXPORT, qw(dibuixaTxecs fesTxec preparaTxecs tabulat));
push (@EXPORT, qw(dataFitxer dataCatalana manteniment));
push (@EXPORT, qw(uneixLlistes creuaLlistes xorLlistes amb1sense2Llistes));
# reben les llistes per referencia i en tornen una com a funcio @q3=uneixLlistes(\@q1,\@q2);
push (@EXPORT, qw(truncaLlista ordenaLlistes fys));
# reben una llista per referencia truncaLlista(\@q1,14);
# fys es un desordenador de llistes tret del PERL cookbook
push (@EXPORT, qw(iso2hex hex2chr));


########################
$LATEL = '<a 
href="http://www.iula.upf.es/latel/lpresca.htm" target=\'_top\'>Laboratori de Tecnologies Ling&uuml;&iacute;stiques</a>';
$IULA = '<a 
href="http://www.iula.upf.edu/" target=\'_top\'>IULA</a>';
$UPF = '<a 
href="http://www.upf.edu" target=\'_top\'>UPF</a>';

my ($marca_inici,$marca_fi);
my (@valors,@mostrats,$unicodeDoble);
$marca_inici = '<td>';
$marca_fi = '</td>';
$farciment = '&nbsp;';
$unicodeDoble=0;

#######################################################################################

sub iso2hex($) {
	my $hex = '';
	for (my $i = 0; $i < length($_[0]); $i++) {
		my $ordno = ord substr($_[0], $i, 1);
		$hex .= sprintf("%lx", $ordno);
		}
	$hex =~ s/ $//;
	$hex;
}

sub hex2chr {
my $dins = shift;
$dins =~ s/([a-fA-F0-9][a-fA-F0-9])/pack( "C", hex($1) )/eg;
return $dins;
}

#######################################################################################

sub xuclaParam {
$_  = param("$_[0]");
if (!defined($_)) {return $_[1]|0} else  {return $_};
}    

sub tabulat {
my $mot  = shift;
my $xifra  = shift;
while (length($mot)<$xifra) {$mot .= ' '}
return $mot;
}    

sub demanaIP {
my $IP = $ENV{'X_FORWARDED_FOR'};
return $IP if defined($IP);
$IP = $ENV{'REMOTE_ADDR'};
if (!defined($IP)) {$IP='0.0.0.0'};
return $IP
}

sub dataFitxer {
my ($mes);
if (!-e $_[0]) {return 0}
my $darreraModif = (stat($_[0])) [9];
$darreraModif = scalar localtime($darreraModif);
return dataCatalana($darreraModif);
}

sub dataCatalana {
my $darreraModif = $_[0];
$darreraModif =~ s/^Mon /Dilluns /;
$darreraModif =~ s/^Tue /Dimarts /;
$darreraModif =~ s/^Wed /Dimecres /;
$darreraModif =~ s/^Thu /Dijous /;
$darreraModif =~ s/^Fri /Divendres /;
$darreraModif =~ s/^Sat /Dissabte /;
$darreraModif =~ s/^Sun /Diumenge /;
$darreraModif =~ s/ Jan / Gener /;
$darreraModif =~ s/ Feb / Febrer /;
$darreraModif =~ s/ Mar / Mar/;
$darreraModif =~ s/ Apr / Abril /;
$darreraModif =~ s/ May / Maig /;
$darreraModif =~ s/ Jun / Juny /;
$darreraModif =~ s/ Jul / Juliol /;
$darreraModif =~ s/ Aug / Agost /;
$darreraModif =~ s/ Sep / Setembre /;
$darreraModif =~ s/ Oct / Octubre /;
$darreraModif =~ s/ Nov / Novembre /;
$darreraModif =~ s/ Dec / Desembre /;
my ($setmana,$any,$mes,$dia,$hora);
if ($darreraModif =~ /([\w]+) ? ([\w]+) ? (\d{1,2}) (\d\d:\d\d:\d\d) (\d{4,4})/) {
	($setmana,$any,$mes,$dia,$hora)=($1,$5,$2,$3,$4);
	$mes=lc($mes);
	if ($mes =~ /^[ao]/) {$mes ="d'".$mes} else {$mes ="de ".$mes}
	return $setmana.", $dia $mes del $any a les $hora";
	} 
return $darreraModif;
}

sub print_fila {
	print "Crida obsoleta a print_fila<br>\n";
}

sub extreuDeLlista {
  my $quin = $_[0];
  my @tots = split(' ',$_[1]);
if ($quin == 0) {return '**error--'}
elsif ($quin > scalar (@tots)+1) {return '**error++'}
else {$tots[$quin-1] =~ s/_/ /g;return $tots[$quin-1]};
}

sub zeroXifra {
my $text=$_[0];
while (length($text)<$_[1]) {$text = '0'.$text}
return $text;
}

sub preparaCella {
  $marca_inici = $_[0];
  $marca_fi = $_[1];
  }

sub printCella {
  my $dada = $_[0];
  if (!$dada) {$dada="$farciment"};
  print "$marca_inici$dada$marca_fi\n";
  }

sub printTh {
  my $dada = $_[0];
  if (!$dada) {$dada='&nbsp;'};
  print "<th>$dada</th>\n";
  }

sub printFila {
  my $mena = $_[0];
  shift;
  print "<tr>";
  foreach my $contingut (@_)
           {
           if ($mena) {printCella ($contingut);}
               else   {printTh ($contingut);};
           }
  print "</tr>\n";
  }

sub signaPerl {
if ($_[0] eq '127.0.0.1') 
 {
 print "<font color=006600>Fet amb <A href='http://www.macperl.org' target='_top'>MacPerl!</A></font>";
 }
else
 {
 print "\n<A href='http://www.macperl.org' target='_top'><IMG SRC='http://www.macperl.com/g/mpuh.gif' ";
 print "WIDTH=136 HEIGHT=56 ALIGN=TOP ALT='Fet amb MacPerl!' border=0></A><br>\n";
 }
}

sub signoJo {
print "<br>&#169; Llu&iacute;s <A href='http://193.145.43.51' target='_top'>de Yzaguirre</A>, 2002<br>\n";

}

# sub pintaUnAllofon {
# my $nova = '';
# my $lletra = $_[0];
# if ($lletra eq ' ') {return $lletra};
# if    ($lletra eq 'a') {$nova = 'a1'}
# elsif ($lletra eq 'A') {$nova = 'a2'}
# elsif ($lletra eq 'e') {$nova = 'e1'}
# elsif ($lletra eq 'E') {$nova = 'e2'}
# elsif ($lletra eq 'o') {$nova = 'o1'}
# elsif ($lletra eq 'O') {$nova = 'o2'}
# elsif ($lletra eq 'b') {$nova = 'b1'}
# elsif ($lletra eq 'B') {$nova = 'b2'}
# elsif ($lletra eq 'd') {$nova = 'd1'}
# elsif ($lletra eq 'D') {$nova = 'd2'}
# elsif ($lletra eq 'g') {$nova = 'g1'}
# elsif ($lletra eq 'G') {$nova = 'g2'}
# elsif ($lletra eq 'm') {$nova = 'm1'}
# elsif ($lletra eq 'M') {$nova = 'm2'}
# elsif ($lletra eq 'n') {$nova = 'n1'}
# elsif ($lletra eq 'Y') {$nova = 'n2'}
# elsif ($lletra eq 'N') {$nova = 'n3'}
# elsif ($lletra eq 'l') {$nova = 'l1'}
# elsif ($lletra eq 'L') {$nova = 'l2'}
# elsif ($lletra eq 'U') {$nova = 'l3'}
# elsif ($lletra eq 'r') {$nova = 'r1'}
# elsif ($lletra eq 'R') {$nova = 'r2'}
# elsif ($lletra eq 's') {$nova = 's1'}
# elsif ($lletra eq 'S') {$nova = 's2'}
# elsif ($lletra eq 'z') {$nova = 'z1'}
# elsif ($lletra eq 'Z') {$nova = 'z2'}
# elsif ($lletra eq "\'") {$nova = 'ap'}
# else {$nova = $lletra};
# return '<IMG SRC="'.$urlFonemes.'gifs/'.$nova.'.jpg" ALT="?" ALIGN=TOP>'."\n";
# }

sub representa {
return "Crida obsoleta a representa; cal posar-hi representaUnicode";
#my $resultat = '<table border=0><tr><td>';
# my $resultat = '';
# my $mot = $_[0];
# my $k = length($mot);
# for (my $i=0;$i<$k;$i++)
#    {$resultat .= pintaUnAllofon(substr($mot,$i,1))}
# return $resultat;
#return $resultat.'</td></tr></table>';
}

sub pintaUnicode {
my $nova = '';
my $lletra = $_[0];
if ($unicodeDoble) {
	if ($lletra eq 'Z') {$nova = 'd&#865;&#658;'} #africada dg
	elsif ($lletra eq 'S') {$nova = 't&#865;&#643;'} #africada tx
	elsif ($lletra eq 'z') {$nova = 'd&#865;z'} #africada dz
	elsif ($lletra eq 's') {$nova = 't&#865;s'} #africada ts
	elsif ($lletra eq 'E') {$nova = '&#230;'} # E esp oberta
	elsif ($lletra eq 'o') {$nova = '&#339;'} # ^
	elsif ($lletra eq 'A') {$nova = '&#592;'} # neutra esp oberta
	elsif ($lletra eq 'a') {$nova = '&#593;'} # a molt posterior
	;
	$unicodeDoble=0;
	return $nova;
	}
if ($lletra eq 'Q') {$unicodeDoble=1;return ''};
if    ($lletra eq 'A') {$nova = '&#601;'}
elsif ($lletra eq 'E') {$nova = '&#603;'}
elsif ($lletra eq 'O') {$nova = '&#596;'}
elsif ($lletra eq 'M') {$nova = '&#625;'}
elsif ($lletra eq 'N') {$nova = '&#331;'}
elsif ($lletra eq 'Y') {$nova = '&#626;'}
elsif ($lletra eq 'B') {$nova = '&#946;'}
elsif ($lletra eq 'D') {$nova = '&eth;'}
elsif ($lletra eq 'G') {$nova = '&#611;'}
elsif ($lletra eq 'Z') {$nova = '&#658;'}
elsif ($lletra eq 'S') {$nova = '&#643;'}
elsif ($lletra eq 'r') {$nova = '&#638;'}
elsif ($lletra eq 'R') {$nova = 'r'}
elsif ($lletra eq 'F') {$nova = '&#633;'} # erra invertida
elsif ($lletra eq 'L') {$nova = '&#654;'}
elsif ($lletra eq 'W') {$nova = '&#619;'} #ewa vewar
elsif ($lletra eq "'") {$nova = '&#712;'}
elsif ($lletra eq '`') {$nova = '&#716;'}
elsif ($lletra eq 'X') {$nova = '&#967;'} #kh
elsif ($lletra eq 'H') {$nova = '&#952;'} #theta
elsif ($lletra eq 'c') {$nova = '&#607;'}
elsif ($lletra eq 'C') {$nova = '&#669;'}
elsif ($lletra eq 'K') {$nova = 'c'}
elsif ($lletra eq '_') {$nova = '&#8255;'}
else {$nova = $lletra};
return $nova;
}

sub representaUnicode {
my $resultat = "<font FACE='SILDoulosUnicodeIPA, Doulos SIL' color=$_[1] size=$_[2]>";
my $mot = $_[0];
my $k = length($mot);
for (my $i=0;$i<$k;$i++)
   {$resultat .= pintaUnicode(substr($mot,$i,1))}
return $resultat.'</font>';
}

sub representaUnicodeWap {
my $resultat = "";
my $mot = $_[0];
my $k = length($mot);
for (my $i=0;$i<$k;$i++)
   {$resultat .= pintaUnicode(substr($mot,$i,1))}
return $resultat;
}

sub taula {
if ($_[0]) {print "</table>\n";return}
print "<table border=$_[1]>\n"
}

sub documentCSS {
my $url = '@import url(http://193.145.43.51/gifs/LdYM.css);';
print << "FI";
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
	<head>
	<META name="language" content="Catalan">
		<title>$_[0]</title>	  	
		<style type="text/css">
$url
  	</style>
	</head>
	<body
FI
}

sub document {
if ($_[0]) {print "</body></html>\n";return}
print "<html><head><title>$_[1]</title></head>\n<body bgcolor=white><h1>$_[1]</h1>\n"
}

sub llegeixne2 {
my $i = ord(substr($_[0],$_[1],1))+(ord(substr($_[0],$_[1]+1,1))*2**8);
return $i;
}

sub llegeixne4 {
my $i = ord(substr($_[0],$_[1],1))+(ord(substr($_[0],$_[1]+1,1))*2**8)
      +(ord(substr($_[0],$_[1]+2,1))*2**16)+(ord(substr($_[0],$_[1]+3,1))*2**24);
return $i;
}

sub escriune2 {
my $xifra = $_[0];
my ($x1,$x2);
$x1 = $xifra % 2**8;
$x2 = $xifra / 2**8;
return chr($x1).chr($x2);
}

sub escriune4 {
my $xifra = $_[0];
my ($x1,$x2,$x3,$x4);
$x1 = $xifra % 2**8;
$xifra = $xifra / 2**8;
$x2 = $xifra % 2**8;
$xifra = $xifra / 2**8;
$x3 = $xifra % 2**8;
$x4 = $xifra / 2**8;
return chr($x1).chr($x2).chr($x3).chr($x4);
}

sub ltrim {
my $test = 1;
my $linia = $_[0];
while ($test) {
   $test = 0;
   if (length($linia) == 1)
      {
      if ($linia eq ' ') {$linia=''}
      }
    else
      {
      $test = (substr($linia,0,1) eq ' ');
      if ($test) {$linia = substr($linia,1)}
      };
   }
return $linia;
}

sub rtrim {
my $test = 1;
my $linia = $_[0];
while ($test) {
   $test = 0;
   if (length($linia) == 1)
      {
      if ($linia eq ' ') {$linia=''}
      }
    else
      {
      $test = (substr($linia,-1) eq ' ');
      if ($test) {$linia = substr($linia,0,-1)}
      };
   }
return $linia;
}

sub preparaMenu1 {
(@valors) = (@_);
}

sub preparaMenu2 {
(@mostrats) = (@_);
}

sub fesMenu {
my $actiu = $_[0];
my $net = $_[2];
my ($j,$m,$v,$retorn);
$retorn = '';
$retorn =  "<td align=center>" unless $net;
$retorn .= "<SELECT NAME='$_[1]'>";
for ($j=0;$j<=$#valors;$j++)
	{
	$m=$mostrats[$j]; 
	$v=$valors[$j]; 
	if ($v eq $actiu) {
		$retorn .= "<OPTION VALUE='$v' SELECTED>$m\n";
		}
	else  {
		$retorn .= "<OPTION VALUE='$v'>$m\n";
		}
	}
$retorn .="</SELECT>\n";
$retorn .="</td>\n" unless $net;
if ($net) {return $retorn} else {print "$retorn";return 1}
}

sub fesText {
print "<td align=center><INPUT TYPE='text' size=$_[2] name='$_[0]' value=$_[1]></td>\n";
}

sub expressaData {
($any,$mes,$dia) = split("-",$data);
print "<table border=0><tr><th>$data</th>\n"; 
preparaMenu1(qw/01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31/);
preparaMenu2(qw/1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31/);
fesMenu($dia,'dia');
preparaMenu1(qw/01 02 03 04 05 06 07 08 09 10 11 12/);
preparaMenu2(qw/gener febrer mar&ccedil; abril maig juny juliol agost setembre octubre novembre desembre/);
fesMenu($mes,'mes');
preparaMenu1(qw/2001 2002 2003 2004 2005/);
preparaMenu2(qw/2001 2002 2003 2004 2005/);
fesMenu($any,'any');
print "</tr></table>\n"; 
}

sub fesTxec {
print "<td align=center><INPUT TYPE='checkbox' name='$_[0]' value='jes'";
print " CHECKED" if $_[1];
print "></td>\n";
}

sub dibuixaTxecs {
print "<td>\n";
for (my $j=1;$j<=$_[0];$j++) {
	print "\t<img SRC=\"http://retoc.iula.upf.edu/comuns/txecboig.gif\" alt=\"$j\"align=top>\n";
	}
print "</td>\n";
}

sub preparaTxecs {
my $m = "";
for (my $j=1;$j<=$_[0];$j++) {
	$m .=  "\t<img SRC=\"http://retoc.iula.upf.edu/comuns/txecboig.gif\" alt=\"$j\"align=top>\n";
	}
return $m;
}

sub uneixLlistes {
my (%triats,$membre);
my ($a1,$a2) = @_;
foreach $membre (@$a1,@$a2) {$triats{$membre}=1}
return sort {$a <=> $b} keys %triats;
}

sub creuaLlistes {
my (%triats,$membre,@a3);
my ($a1,$a2) = @_;
foreach $membre (@$a1,@$a2) {$triats{$membre}++}
@a3=();
foreach $membre (sort {$a <=> $b} keys %triats) {push(@a3,$membre) if $triats{$membre}>1};
return @a3;
}

sub xorLlistes {
my (%triats,$membre,@a3);
my ($a1,$a2) = @_;
foreach $membre (@$a1,@$a2) {$triats{$membre}++}
@a3=();
foreach $membre (sort {$a <=> $b} keys %triats) {push(@a3,$membre) if $triats{$membre}==1};
return @a3;
}

sub amb1sense2Llistes {
my (%triats,$membre,@a3);
my ($a1,$a2) = @_;
foreach $membre (@$a1) {$triats{$membre}=1}
foreach $membre (@$a2) {$triats{$membre}=2 if exists($triats{$membre})}
@a3=();
foreach $membre (sort {$a <=> $b} keys %triats) {push(@a3,$membre) if $triats{$membre}==1};
return @a3;
}

sub truncaLlista {
my $a1 = $_[0];
my $mida = scalar(@$a1);
if ($mida > $_[1]) {$#$a1=$_[1]-1} 	
}

sub fys { # fisher_yates_shuffle perl cookbook, pÅ^g. 121
my $array = shift; # rep un parÅ^metre Ä@
my ($i,$j);
for ($i = @$array; --$i;) {
	$j = int rand ($i+1);
	next if $i == $j;
	($$array[$i],$$array[$j]) = ($$array[$j],$$array[$i]);
	}
}

sub ordenaLlistes {
my $array = shift; # rep un parÅ^metre Ä@
@$array = sort {$a <=> $b} @$array;
}

sub manteniment {
print "<HTML><head><title>Laboratori de Tecnologies Ling&uuml;&iacute;stiques</title></head><BODY BGCOLOR=white>" unless $_[0];
print << "ON3";
<table border=0 width=100%>
<tr><td bgcolor='#aaaaaa'><center>
<br> &nbsp; <b>
<font face="Times" size="5" color=white>
Laboratori de Tecnologies Ling&uuml;&iacute;stiques
</font>
</b><br>
<font face="Times" size="2" color=white>
Institut de Ling&uuml;&iacute;stica Aplicada - UPF
</font>
<br>&nbsp;</td></tr><tr><td><center><br>
<font face="Times" size="4" color=blue>
Estem fent operacions de manteniment.<br>
Torneu-ho a provar d\'ac&iacute; a un minut.<br><br>
</font>
</td></tr><tr><td><br><br><center>
<img src='http://193.145.43.51/gifs/obres.gif'>
<br><br>
</td></tr><tr><td><br><br><center>
<font face="Times" size="4" color=blue>
Perdoneu les mol&egrave;sties.
</font>
<br>
<a href='http://www.iula.upf.es/latel/lpresca.htm' target='_top'>
LATEL</a>
 - <a href='http://www.iula.upf.es/' target='_top'>
IULA</a>
 - <a href='http://www.upf.es/' target='_top'>
UPF</a>
ON3
}




########################

1;                            # final del modul
