# BIBLIOTECA / KNIHOVNA #!/usr/bin/perl # última alteração: mudança do nome do projecto # DMS 30 Jan 2003 # diferença entre duas listas PAR 2003 Feb 07 # produto vectorial de duas listas PAR 2003 Feb 11 # mais SGML PAR 2003 Mai 2 use locale; use POSIX qw(locale_h); setlocale(LC_CTYPE, "pt_PT") or die; # Meses abreviados PT,EN,NO @m_pt = ("Jan","Fev","Mar","Abr","Mai","Jun","Jul","Ago","Set","Out","Nov","Dez"); @m_en = ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"); @m_no = ("Jan","Feb","Mar","Abr","Mai","Jun","Jul","Ago","Sep","Okt","Nov","Des"); # Meses completos PT,EN,NO,ES,DE,FR,DA,SV,FI,NL,IS,CA,EU,EE,HU @mc_ca=("gener","febrer","març","abril","maig","juny","juliol","agost","setembre","octubre","novembre","desembre"); @mc_da=("januar","februar","marts","april","maj","juni","juli","august","september","oktober","november","december"); @mc_de=("Januar","Februar","März","April","Mai","Juni","Juli","August","September","Oktober","November","Dezember"); @mc_et=("jaanuar","veebruar","märts","aprill","mai","juuni","juuli","august","september","oktoober","november","detsember"); @mc_en=("January","February","March","April","May","June","July","August","September","October","November","December"); @mc_eu=("urtarrila","otsaila","martxoa","apirila","maiatza","ekaina","uztaila","abuztua","iraila","urria","azaroa","abendua"); @mc_es=("enero","febrero","marzo","abril","mayo","junio","julio","agosto","septiembre","octubre","noviembre","diciembre"); @mc_fi=("tammikuu","helmikuu","maaliskuu","huhtikuu","toukokuu","kesäkuu","heinäkuu","elokuu","syyskuu","lokakuu","marraskuu","joulukuu"); @mc_fr=("janvier","février","mars","avril","mai","juin","juillet","août","septembre","octobre","novembre","décembre"); @mc_hu=("Januar","Februar","März","April","Mai","Juni","Juli","August","September","Oktober","November","Dezember"); @mc_is=("janúar","febrúar","mars","apríl","maí","júní","júlí","ágúst","september","október","nóvember","desember"); @mc_it=("gennaio","febbraio","marzo","aprile","maggio","giugno","luglio","agosto","settembre","ottobre","novembre","dicembre"); @mc_nl=("januari","februari","maart","april","mei","juni","juli","augustus","september","oktober","november","december"); @mc_no=("januar","februar","mars","april","mai","juni","juli","august","september","oktober","november","desember"); @mc_pt=("Janeiro","Fevereiro","Março","Abril","Maio","Junho","Julho","Agosto","Setembro","Outubro","Novembro","Dezembro"); @mc_sv=("januari","februari","mars","april","maj","juni","juli","augusti","september","oktober","november","december"); # Nome do projecto em diferentes línguas %nomeproj=( "ptant"=>"Linguateca", "ptant"=>"Processamento computacional do português", "en"=>"Computational Processing of Portuguese", "no"=>"Databehandling av portugisisk språk", "cs"=>"Poczitaczový zprácovaní portugalštiny" ); return 1; # Lê conteúdo de um ficheiro sub Conteudo { open FX, shift; $t= join '', ; close FX; return $t; } # Idem, mas devolve em formato lista sub ConteudoL { split /\n/, &Conteudo(shift); } # Grava uma string num ficheiro sub Contendo { open FX, "> $_[0]" || die "Não consigo abrir $_[0]\n"; print FX $_[1]; close FX; } # Lê conteúdo de um directório sub DirConteudo { opendir D, shift; @_=grep /\w/, readdir D; closedir D; return @_; } # Ordena uma lista e elimina elementos repetidos sub ListaUnica { %visto=(); return sort grep { ! $visto{$_} ++} @_; } # Elemina elementos repetidos, mas não ordena sub ElemUnicos { %visto=(); return grep { ! $visto{$_} ++} @_; } sub DifLista { my ($l1,$l2,@lf)=@_; foreach $n (@$l1) { push @lf,$n unless (grep /^$n$/, @$l2) } return @lf; } sub ProdVec { my ($l1,$l2,@pv)=@_; foreach $n (@$l1) { push @pv, map { "A:$n B:$_\n"} (@$l2) } return @pv; } # Máximo e mínimo de uma lista sub Max { @_=sort @_; return pop; } sub Min { @_=sort @_; return shift; } # Conversões de codificação sub Cgi2Txt { $_=shift; y/\+/ /; s/%([A-F0-9]{2})/chr(hex($1))/egi; return $_; } sub Txt2Cgi { $_=shift; y/ /+/; s/([\x90-\xff])/sprintf("%%%2X",ord($1))/egi; return $_; } sub MaiusculaInicial { $_=shift; $_=~s#\b(\w)(\w+)\b#\u$1\L$2#g; $_=~s#\bD([aeo]s?)\b#d$1#g; $_=~s#\bE\b#e#g; return $_; } sub ISO2HTML { $_=shift; s/º/º/g; s/ª/ª/g; s/ã/ã/g; s/ñ/ñ/g; s/õ/õ/g; s/Ã/Ã/g; s/Ñ/Ñ/g; s/Õ/Õ/g; s/Á/Á/g; s/É/É/g; s/Í/Í/g; s/Ó/Ó/g; s/Ú/Ú/g; s/á/á/g; s/é/é/g; s/í/í/g; s/ó/ó/g; s/ú/ú/g; s/À/À/g; s/È/È/g; s/Ì/Ì/g; s/Ò/Ò/g; s/Ù/Ù/g; s/à/à/g; s/è/è/g; s/ì/ì/g; s/ò/ò/g; s/ù/ù/g; s/Ç/&Ccdeil;/g; s/ç/ç/g; s/æ/æ/g; s/ø/ø/g; s/å/å/g; s/Æ/Æ/g; s/Ø/Ø/g; s/Å/Å/g; s/Â/Â/g; s/Ê/Ê/g; s/Î/Î/g; s/Ô/Ô/g; s/Û/Û/g; s/â/â/g; s/ê/ê/g; s/î/î/g; s/ô/ô/g; s/û/û/g; s/Ä/Ä/g; s/Ë/Ë/g; s/Ï/Ï/g; s/Ö/Ö/g; s/Ü/Ü/g; s/ä/ä/g; s/ë/ë/g; s/ï/ï/g; s/ö/ö/g; s/ü/ü/g; return $_; } sub HTML2ISO { $_=shift; s/³/«/g; s/²/»/g; s/&#(\d+);/chr($1)/ge; s/º/º/g; s/ª/ª/g; s#"#'#g; s/ã/ã/g; s/ñ/ñ/g; s/õ/õ/g; s/Ã/Ã/g; s/Ñ/Ñ/g; s/Õ/Õ/g; s/Á/Á/g; s/É/É/g; s/Í/Í/g; s/Ó/Ó/g; s/Ú/Ú/g; s/á/á/g; s/é/é/g; s/í/í/g; s/ó/ó/g; s/ú/ú/g; s/À/À/g; s/È/È/g; s/Ì/Ì/g; s/Ò/Ò/g; s/Ù/Ù/g; s/à/à/g; s/è/è/g; s/ì/ì/g; s/ò/ò/g; s/ù/ù/g; s/&Ccdeil;/Ç/g; s/ç/ç/g; s/æ/æ/g; s/ø/ø/g; s/å/å/g; s/&Aelig;/Æ/g; s/Ø/Ø/g; s/Å/Å/g; s/Â/Â/g; s/Ê/Ê/g; s/Î/Î/g; s/Ô/Ô/g; s/Û/Û/g; s/â/â/g; s/ê/ê/g; s/î/î/g; s/ô/ô/g; s/û/û/g; s/Ä/Ä/g; s/Ë/Ë/g; s/Ï/Ï/g; s/Ö/Ö/g; s/Ü/Ü/g; s/ä/ä/g; s/ë/ë/g; s/ï/ï/g; s/ö/ö/g; s/ü/ü/g; s#»#»#g; s#«#«#g; s#‘#'#g; s/&/&/g; s/ / /gi; s#–#-#g; s#?#\?#g; return $_; } sub UtfCod { return chr(128+64+$_[0]/64).chr(128+$_[0]%64); } sub HTML2UTF { $_=shift; s/&#([0-9A-F]+);/&hex($1)/egi; s/&#([0-9]+);/&UtfCod($1)/egi; s/Á/Ã/g; s/á/á/g; s/Â/Â/g; s/â/â/g; s/æ/æ/g; s/&A[Ee]lig;/Æ/g; s/à/à/g; s/À/À/g; s/å/Ã¥/g; s/Å/Ã…/g; s/ã/ã/g; s/Ã/Ã/g; s/Ä/Ä/g; s/ä/ä/g; s/ç/ç/g; s/Ç/Ç/g; s/é/é/g; s/É/É/g; s/ê/ê/g; s/Ê/Ê/g; s/È/È/g; s/è/è/g; s/&E[Tt][Hh];/Ã/g; s/ð/ð/g; s/Ë/Ë/g; s/ë/ë/g; s/Í/Ã/g; s/í/í/g; s/î/î/g; s/Î/ÃŽ/g; s/ì/ì/g; s/Ì/ÃŒ/g; s/Ï/Ã/g; s/ï/ï/g; s/Ñ/Ñ/g; s/ñ/ñ/g; s/Ó/Ó/g; s/ó/ó/g; s/ô/ô/g; s/Ô/Ô/g; s/Ò/Ã’/g; s/ò/ò/g; s/ø/ø/g; s/Ø/Ø/g; s/õ/õ/g; s/Õ/Õ/g; s/Ö/Ö/g; s/ö/ö/g; s/Š/Å /g; s/š/Å¡/g; s/&Szlig;/ß/g; s/þ/þ/g; s/&Thorn;/Þ/g; s/Ú/ú/g; s/ú/Ú/g; s/Û/Û/g; s/û/û/g; s/ù/ù/g; s/Ù/Ù/g; s/ü/ü/g; s/Ü/Ãœ/g; s/Ý/Ã/g; s/ý/ý/g; s/ÿ/ÿ/g; return $_; } # Transforma RTF em Texto (aproximadamente...) sub RTF2TXT { $_=shift; s/\\\'([a-f0-9]{2})/chr(hex($1))/eg; s/\\[lr]quote/'/g; s/\\.*? //g; {} while (s/{[^}]*?;}//sg); {} while (s/{[^ }]*?}//sg); return $_; } # Transforma PostScripts em texto (aproximadamente...) sub PS2TXT { $_=shift; s#\\\(#PAR_ABR#g; s#\\\)#PAR_FEC#g; s#\\(\d\d\d)#chr(oct($1))#eg; @_=($_=~/\((.*?)\)/g); $_=join '', @t; s#PAR_ABR#\(#g; s#PAR_FEC#\)#g; return $_; } # Função data sub Data { my ($lg,$j,$m,$t,$ts)=@_; if ($j eq "h") { ($_,$mn,$h,$t,$m,$j+=1900)=localtime(time); $j+=1900; } else { $m--; } return &DataEN if ($lg eq "en"); return "$t $mc_fr[$m] $j" if ($lg eq "fr"); return "$t $mc_nl[$m] $j" if ($lg eq "nl"); return "$t. $mc_da[$m] $j" if ($lg eq "da"); return "$t. $mc_de[$m] $j" if ($lg eq "de"); return "$t. $mc_no[$m] $j" if ($lg eq "no"); return "$t / $mc_ca[$m] / $j" if ($lg eq "ca"); return "$t. $mc_et[$m] $j. A." if ($lg eq "et"); return "$j.eko $mc_eu[$m]k $t" if ($lg eq "eu"); return "$t. $mc_fi[$m]ta $j" if ($lg eq "fi"); return "$j. $mc_hu[$m] $t." if ($lg eq "hu"); return "den $t $mc_sv[$m] $j" if ($lg eq "sv"); return "$t de $mc_es[$m] de $j" if ($lg eq "es"); return "$t de $mc_pt[$m] de $j" if ($lg eq "pt"); return "$t de $mc_pt[$m] de $j ".sprintf("%02d:%02d",$h,$mn) if ($lg eq "pt.h"); } sub DataEN { $ext=($t%10<3 && ($t<10 || $t>20) ? ("th","st","nd","rd")[$t%10] : "th"); return "$mc_en[$m] $t$ext $j"; } # Códigos ISO Línguas %lang=( "ca","catalão", "cs","checo", "da","dinamarquês", "de","alemão", "el","grego", "en","inglês", "es","castelhano", "fi","finlandês", "fr","francês", "gl","galego", "it","italiano", "nl","neerlandês", "no","norueguês", "pl","polaco", "pt","português", "ru","russo", "sv","sueco", "zh","chinês" );