File Coverage

blib/lib/Ananke/Utils.pm

Criterion	Covered	Total	%
statement	3	165	1.8
branch	0	10	0.0
condition			n/a
subroutine	1	9	11.1
pod	8	8	100.0
total	12	192	6.2

#!/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/
	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//g;
   $str =~ s/\\n//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  and 2 enters to

	$var = clean($textarea);

=head1 AUTHOR

	Udlei D. R. Nattis
	[e-mail]
	http://www.nobol.com.br
	http://www.anankeit.com.br

=cut