code style, strip_unsafe_tags()
parent
20ebff4f64
commit
ef4f4bce36
|
@ -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/&/'/g;
|
s/&/'/gso;
|
||||||
s/</</g;
|
s/</</gso;
|
||||||
s/>/>/g;
|
s/>/>/gso;
|
||||||
s/\"/"/g;
|
s/\"/"/gso;
|
||||||
s/\'/'/g;
|
s/\'/'/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,15 +138,18 @@ 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
|
my $index = $names_hash->{$_}; # perl index not column
|
||||||
$index = $_ - 1 if !defined $index && DBI::looks_like_number($_) && $_>=1 && $_ <= $num_of_fields;
|
$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]})")
|
return $sth->set_err(1, "Field '$_' does not exist (not one of @{[keys %$names_hash]})")
|
||||||
|
@ -139,12 +161,16 @@ sub fetchall_hashref {
|
||||||
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__
|
||||||
|
|
|
@ -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 => '.', # каталог с шаблонами
|
||||||
|
|
Loading…
Reference in New Issue