#!/usr/bin/perl
# # # # # #
# Diversar funcoes para algum tipo
# de comunicacao com o browser do
# usuario.
# Tue Mar 20 12:34:00 BRT 2001
# # # # # #
package Ananke::Utils;
use strict;
our $VERSION = '1.0.2';
$SIG{__WARN__} = sub { };
sub getCookies {
# cookies are seperated by a semicolon and a space, this will split
# them and return a hash of cookies
my(@rawCookies) = split (/; /,$ENV{'HTTP_COOKIE'});
my(%cookies);
my($key,$val);
foreach(@rawCookies){
($key, $val) = split (/=/,$_);
$cookies{$key} = $val;
}
return %cookies;
}
# Trata os dados do form
# Formata timestamp.
# Sat Mar 17 22:31:06 BRT 2001
sub getTime {
my($time) = @_;
my ($seg,$min,$hora) = localtime($time);
return sprintf("(%02d:%02d:%02d)",$hora,$min,$seg);
}
# Substitui chars proibidos
sub replace_chars {
my($msg) = @_;
$_ = $msg;
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/Î/Î/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/ò/ò/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/Ð/Ð/g; s/¨/¨/g; s/¡/¡/g;
eval { s/±/±/g; };
s/!/!/g; s/@/@/g; s/\$/$/g; s/%/%/g;
s/\*/*/g; s/\(/(/g; s/\)/)/g;
s/\////g; s/\\/\/g;
return $_;
}
# Recupega Post com multiples values
sub getForm {
my($r,$rr) = @_;
my($i,@j,$k,%r);
# Printa conteudo
if ($r) { $r = $r; }
elsif ($rr) { $r = $rr; }
else { return; }
$i = $r;
while ($i =~ s/^([a-zA-Z0-9-_\%\.\,\+]+)=([a-zA-Z0-9-_\*\@\%\.\,\+]+)?&?//sx) {
$j[0] = $1;
$j[1] = $2;
# Trasnforma os chars especiais em normais
$j[0] =~ tr/+/ /;
$j[0] =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$j[1] =~ tr/+/ /;
$j[1] =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
# Verifica quantas vezes se repete
$k = $r =~ s/(^|&)($j[0]=)/$1$2/gi;
# Verifica se joga em array ou hash
if ($k > 1) { push (@{$r{$j[0]}},$j[1]); }
else { $r{$j[0]} = $j[1] }
$k = 0;
}
return %r if %r;
return 0;
}
# see /usr/src/usr.bin/passwd/local_passwd.c or librcypt, crypt(3)
sub salt {
my($salt); # initialization
my($i, $rand);
my(@itoa64) = ( '0' .. '9', 'a' .. 'z', 'A' .. 'Z' ); # 0 .. 63
# to64
for ($i = 0; $i < 27; $i++) {
srand(time + $rand + $$);
$rand = rand(25*29*17 + $rand);
$salt .= $itoa64[$rand & $#itoa64];
}
return $salt;
}
# Esconda a string
sub escape {
my ($str,$pat) = @_;
$pat = '^A-Za-z0-9 ' if ( $pat eq '' );
$str =~ s/([$pat])/sprintf("%%%02lx", unpack("c",$1))/ge;
$str =~ s/ /\+/g;
return $str;
}
# Decoda a string
sub unescape {
my ($str) = @_;
$str =~ s/\+/ /g;
$str =~ s/%(..)/pack("c", hex($1))/ge;
return $str;
}
# substitui enters por html
sub clean {
my($str) = @_;
$str =~ s/\\r//g;
$str =~ s/\\n\\n/<p>/g;
$str =~ s/\\n/<br>/g;
return $str;
}
1;
=head1 NAME
Ananke::Utils - Utility functions
=head1 DESCRIPTION
Utility functions used to facility your life
=head1 SYNOPSIS
See all functions
=head1 METHODS
=head2 getCookies()
Retrieves any cookie information from the browser
%cookies = Ananke::Utils::getCookies;
=head2 getTime(timestamp)
Return time in hh:mm:ss
$var = &Ananke::Utils::getTime(time());
=head2 replace_chars(string)
Replace all bad chars to html format
$var = &Ananke::Utils::escape("«¼TesTЪ");
=head2 getForm(x,x)
If you use modperl, this functions is very good
my $r = shift;
my (%form,$i,$j);
$i=$r->content; $j=$r->args;
%form = &Ananke::Utils::getForm($i,$j);
this function understand array input, id[1], id[2],id[3]...
=head2 salt()
Return randomic string, used for generate password
=head2 escape(string)
URL encode
http://web/this has spaces' -> 'http://web/this%20has%20spaces'
$var = &Ananke::Utils::escape($ENV{'REQUEST_URI'});
=head2 unescape(string)
URL decode
http://web/this%20has%20spaces -> http://web/this has spaces'
$var = &Ananke::Utils::unescape("http://web/this%20has%20spaces");
=head2 clean(string)
Convert enter to <br> and 2 enters to <p>
$var = clean($textarea);
=head1 AUTHOR
Udlei D. R. Nattis
nattis@anankeit.com.br
http://www.nobol.com.br
http://www.anankeit.com.br
=cut