code style, strip_unsafe_tags()

databind
vitalif 2008-09-05 22:38:55 +00:00 committed by Vitaliy Filippov
parent 20ebff4f64
commit ef4f4bce36
2 changed files with 68 additions and 39 deletions

View File

@ -1,7 +1,5 @@
#!/usr/bin/perl #!/usr/bin/perl
# Некоторые простые полезные функции
=head1 Некоторые простые полезные функции
=cut
package VMX::Common; package VMX::Common;
@ -10,19 +8,25 @@ use Encode;
use Digest::MD5; use Digest::MD5;
require Exporter; require Exporter;
@EXPORT_OK = qw(quotequote min max trim htmlspecialchars strip_tags file_get_contents dbi_hacks ar1el filemd5 mysql_quote updaterow_hashref insertall_hashref dumper_no_lf); @EXPORT_OK = qw(quotequote min max trim htmlspecialchars strip_tags strip_unsafe_tags file_get_contents dbi_hacks ar1el filemd5 mysql_quote updaterow_hashref insertall_hashref dumper_no_lf);
%EXPORT_TAGS = (all => [ @EXPORT_OK ]); %EXPORT_TAGS = (all => [ @EXPORT_OK ]);
our $t; our $t;
my $safe_tags = [qw/div span h1 h2 a b i u p strike strong small big blink center ol pre sub sup font br table tr td th tbody tfoot thead tt ul li em img marquee/];
## ##
# Exporter-ский импорт + возможность подмены функции в DBI # Exporter-ский импорт + возможность подмены функции в DBI
## ##
sub import { sub import
foreach (@_) { {
if ($_ eq '!dbi_hacks') { foreach (@_)
{
if ($_ eq '!dbi_hacks')
{
return Exporter::import(@_); return Exporter::import(@_);
} elsif ($_ eq 'dbi_hacks') { }
elsif ($_ eq 'dbi_hacks')
{
$_ = '!dbi_hacks'; $_ = '!dbi_hacks';
} }
} }
@ -40,7 +44,8 @@ sub import {
# Функция возвращает минимальное из значений # Функция возвращает минимальное из значений
# $r = min (@list) # $r = min (@list)
## ##
sub min { sub min
{
return undef if (@_ < 1); return undef if (@_ < 1);
my $r = shift; my $r = shift;
foreach (@_) { $r = $_ if $r > $_; } foreach (@_) { $r = $_ if $r > $_; }
@ -51,7 +56,8 @@ sub min {
# Функция возвращает максимальное из значений # Функция возвращает максимальное из значений
# $r = max (@list) # $r = max (@list)
## ##
sub max { sub max
{
return undef if (@_ < 1); return undef if (@_ < 1);
my $r = shift; my $r = shift;
foreach (@_) { $r = $_ if $r < $_; } foreach (@_) { $r = $_ if $r < $_; }
@ -61,33 +67,35 @@ sub max {
## ##
# shift arrayref # shift arrayref
## ##
sub ar1el { sub ar1el
my $a = shift; {
return undef unless 'ARRAY' eq ref $a; return undef unless 'ARRAY' eq ref $_[0];
return shift @$a; return shift @{$_[0]};
} }
## ##
# Функция обрезает пробельные символы в начале и конце строки # Функция обрезает пробельные символы в начале и конце строки
# $r = trim ($r) # trim ($r) in-place
## ##
sub trim { sub trim
my $a = shift; {
$a =~ s/^\s+|\s+$//os; $_[0] =~ s/^\s+//so;
return $a; $_[0] =~ s/\s+$//so;
$_[0];
} }
## ##
# аналог htmlspecialchars из PHP # аналог htmlspecialchars из PHP
# $str = htmlspecialchars ($str) # $str = htmlspecialchars ($str)
## ##
sub htmlspecialchars { sub htmlspecialchars
{
$_ = shift; $_ = shift;
s/&/&apos;/g; s/&/&apos;/gso;
s/</&lt;/g; s/</&lt;/gso;
s/>/&gt;/g; s/>/&gt;/gso;
s/\"/&quot;/g; s/\"/&quot;/gso;
s/\'/&apos;/g; s/\'/&apos;/gso;
return $_; return $_;
} }
@ -95,21 +103,32 @@ sub htmlspecialchars {
# аналог strip_tags из PHP # аналог strip_tags из PHP
# $str = strip_tags ($str) # $str = strip_tags ($str)
## ##
sub strip_tags { sub strip_tags
{
$_ = shift; $_ = shift;
my $ex = join '|', (shift =~ /[a-z0-9_\-]+/giso); my $ex = join '|', @{shift};
s/<\/?(?!\/?($ex))([a-z0-9_\-]+)[^<>]*>//gis; s/<\/?(?!\/?($ex))([a-z0-9_\-]+)[^<>]*>//gis;
return $_; return $_;
} }
##
# удаление небезопасных HTML тегов
##
sub strip_unsafe_tags
{
strip_tags($_, $safe_tags);
}
## ##
# аналог file_get_contents из PHP # аналог file_get_contents из PHP
# $contents = file_get_contents ($filename) # $contents = file_get_contents ($filename)
## ##
sub file_get_contents { sub file_get_contents
{
my ($tmp, $res); my ($tmp, $res);
open ($tmp, '<'.$_[0]); open ($tmp, '<'.$_[0]);
if ($tmp) { if ($tmp)
{
local $/ = undef; local $/ = undef;
$res = <$tmp>; $res = <$tmp>;
close ($tmp); close ($tmp);
@ -119,32 +138,39 @@ sub file_get_contents {
## ##
# изменённый вариант функции DBI::_::st::fetchall_hashref # изменённый вариант функции DBI::_::st::fetchall_hashref
# <ни фига не нужный велосипед>
## ##
sub fetchall_hashref { sub fetchall_hashref
{
my ($sth, $key_field) = @_; my ($sth, $key_field) = @_;
my $hash_key_name = $sth->{FetchHashKeyName} || 'NAME'; my $hash_key_name = $sth->{FetchHashKeyName} || 'NAME';
my $names_hash = $sth->FETCH("${hash_key_name}_hash"); my $names_hash = $sth->FETCH("${hash_key_name}_hash");
my @key_fields = (ref $key_field) ? @$key_field : $key_field ? ($key_field) : (); my @key_fields = (ref $key_field) ? @$key_field : $key_field ? ($key_field) : ();
my @key_indexes; my @key_indexes;
my $num_of_fields = $sth->FETCH('NUM_OF_FIELDS'); my $num_of_fields = $sth->FETCH('NUM_OF_FIELDS');
foreach (@key_fields) { foreach (@key_fields)
my $index = $names_hash->{$_}; # perl index not column {
$index = $_ - 1 if !defined $index && DBI::looks_like_number($_) && $_>=1 && $_ <= $num_of_fields; my $index = $names_hash->{$_}; # perl index not column
return $sth->set_err(1, "Field '$_' does not exist (not one of @{[keys %$names_hash]})") $index = $_ - 1 if !defined $index && DBI::looks_like_number($_) && $_>=1 && $_ <= $num_of_fields;
return $sth->set_err(1, "Field '$_' does not exist (not one of @{[keys %$names_hash]})")
unless defined $index; unless defined $index;
push @key_indexes, $index; push @key_indexes, $index;
} }
my $rows = {}; my $rows = {};
$rows = [] unless @key_indexes; $rows = [] unless @key_indexes;
my $NAME = $sth->FETCH($hash_key_name); my $NAME = $sth->FETCH($hash_key_name);
my @row = (undef) x $num_of_fields; my @row = (undef) x $num_of_fields;
$sth->bind_columns(\(@row)) if @row; $sth->bind_columns(\(@row)) if @row;
while ($sth->fetch) { while ($sth->fetch)
{
my $ref; my $ref;
if (@key_indexes) { if (@key_indexes)
{
$ref = $rows; $ref = $rows;
$ref = $ref->{$row[$_]} ||= {} for @key_indexes; $ref = $ref->{$row[$_]} ||= {} for @key_indexes;
} else { }
else
{
push @$rows, {}; push @$rows, {};
$ref = $rows->[@$rows-1]; $ref = $rows->[@$rows-1];
} }
@ -156,7 +182,8 @@ sub fetchall_hashref {
## ##
# Обновить строку или несколько строк по значениям ключа # Обновить строку или несколько строк по значениям ключа
## ##
sub updaterow_hashref { sub updaterow_hashref
{
my ($dbh, $table, $row, $key) = @_; my ($dbh, $table, $row, $key) = @_;
return 0 unless return 0 unless
$dbh && $dbh &&
@ -256,3 +283,4 @@ sub dumper_no_lf
} }
1; 1;
__END__

View File

@ -36,6 +36,7 @@ sub new
'l' => 'lc', 'l' => 'lc',
'u' => 'uc', 'u' => 'uc',
'q' => 'quotequote', 'q' => 'quotequote',
'H' => 'strip_unsafe_tags',
'L' => \&language_ref, 'L' => \&language_ref,
}, },
root => '.', # каталог с шаблонами root => '.', # каталог с шаблонами