Агент алкомафии
Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й
Репутация: 2
Всего: 17
|
оптимизировал работы класса еще давно... мне очень понравился интерфейс.... хотел на cpan.org загрузить придумал название Catalyst::Model::CRUD::Abstract  | Код |
use strict;
use warnings;
use parent qw( Catalyst::Model Class::Accessor);
use Class::C3::Adopt::NEXT;
use HTML::Entities::Numbered;
__PACKAGE__->mk_accessors(qw/bad_fields_type all_fields_type/);
# наследуем конструктор, если пригодиться
sub new {
my ( $self, $c ) = @_;
$self = $self->next::method(@_);
}
sub no_sql {
my $self = shift;
$self->{no_sql} = 1;
return $self;
}
sub no_bad {
my $self = shift;
$self->{no_bad} = 1;
return $self;
}
####
# Add out fields
###
sub _add_sql_fields {
my ($self) = @_;
if ( $self->{no_sql} ) {
delete $self->{no_sql};
return;
}
if ( $self->sql_fields_type eq 'array' ) {
if ( !$self->{sql_array_out} ) {
$self->{sql_array_out} = [];
}
push @{ $self->{sql_array_out} },
$self->{key};
# is $self->fails_type array
}
if ( $self->sql_fields_type eq 'hash' ) {
$self->{sql_hash_out}->{ $self->{key} } =
$self->{value};
# $self->fails_type
# HASH key = faild, value = name
}
}
sub _add_bad_fields {
my ($self) = @_;
if ( $self->{no_bad} ) {
delete $self->{no_bad};
return;
}
if ( $self->bad_fields_type eq 'array' ) {
if ( !$self->{bad_array_out} ) {
$self->{bad_array_out} = [];
}
push @{ $self->{bad_array_out} },
$self->{key};
# is $self->fails_type array
}
if ( $self->bad_fields_type eq 'hash' ) {
$self->{bad_hash_out}->{ $self->{key} } =
$self->{value};
# $self->fails_type
# HASH key = faild, value = name
}
}
sub _add_all_fields {
my ($self) = @_;
if ( $self->{no_sql} ) {
delete $self->{no_sql};
return;
}
if ( $self->all_fields_type eq 'array' ) {
if ( !@{ $self->{all_array_out} } ) {
$self->{all_array_out} = [];
}
push @{ $self->{all_array_out} },
$self->{key};
# is $self->fails_type array
}
if ( $self->all_fields_type eq 'hash' ) {
$self->{all_hash_out}->{ $self->{key} } =
$self->{value};
# $self->fails_type
# HASH key = faild, value = name
}
}
####
# Clean text, remove bad tag, etc
###
sub _del_blanks_end_began {
my $self = shift;
$self->{value} =~ s/^\s+//;
$self->{value} =~ s/\s+$//;
return $self;
}
sub _cleaning {
my $self = shift;
$self->{value} =~ s!\0!!g;
$self->{value} =~ s|&|;|g;
$self->{value} =~ s|<!--||g;
$self->{value} =~ s|-->||g;
$self->{value} =~ s|<script||ig;
$self->{value} =~ s|>||g;
$self->{value} =~ s|<||g;
$self->{value} =~ s|"||g;
$self->{value} =~ s| | |g;
$self->{value} =~ s!\|!|!g;
$self->{value} =~ s|\n||g;
$self->{value} =~ s|\$||g;
$self->{value} =~ s|\r||g;
$self->{value} =~ s|\_\_(.+?)\_\_||g;
$self->{value} =~ s|\\||g;
$self->{value} =~ s|\'||g;
$self->{value} =~ s|!||g;
return $self;
}
sub _clean_html {
my $self = shift;
$self->{value} = name2decimal( $self->{value} );
return $self;
}
####
# Valid fields
###
# return $self->{value} and off
sub out {
return shift->{value};
}
sub head_text {
my $self = shift;
$self->{key} = shift if @_;
$self->{value} = shift if @_;
$self->{value} ||= '';
$self->_del_blanks_end_began;
$self->_cleaning;
$self->_add_all_fields();
return $self;
}
sub cut_xss {
my $self = shift;
$self->{key} = shift if @_;
$self->{value} = shift if @_;
$self->{value} ||= '';
$self->_del_blanks_end_began;
$self->_clean_html;
return $self;
}
sub valid_id {
my $self = shift;
$self->{key} = shift;
$self->{value} = shift;
$self->{value} ||= '';
$self->_del_blanks_end_began();
$self->_add_all_fields();
if ( $self->{value} !~ /^\d+$/ ) {
$self->_add_bad_fields();
}
return $self
}
sub int_check {
my $self = shift;
$self->{key} = shift if @_;
$self->{value} = shift if @_;
$self->{value} ||= '';
$self->_del_blanks_end_began();
$self->{value} = $self->{value} eq 'on' ? 1 : 0;
$self->_add_all_fields();
return $self
}
sub one_die {
my $self = shift;
$self->{key} = shift if @_;
$self->{value} = shift if @_;
$self->{value} ||= '';
$self->_del_blanks_end_began();
$self->_add_all_fields();
if ( !$self->{value} == 1 ) {
$self->_add_bad_fields();
}
return $self;
}
sub zero_die {
my $self = shift;
$self->{key} = shift if @_;
$self->{value} = shift if @_;
$self->{value} ||= '';
$self->_del_blanks_end_began();
$self->_add_all_fields();
if ( !$self->{value} == 0 ) {
$self->_add_bad_fields();
}
return $self;
}
sub exist_die {
my $self = shift;
$self->{key} = shift if @_;
$self->{value} = shift if @_;
$self->{value} ||= '';
$self->_add_all_fields();
if ( !$self->{value} ) {
$self->_add_bad_fields();
}
return $self
}
sub addition {
my $self = shift;
$self->{key} = shift if @_;
$self->{value} = shift if @_;
$self->{value} ||= '';
$self->_add_all_fields();
return $self
}
sub del_doublets {
my $self = shift;
my $arr = shift if @_;
my %h;
@{$arr} = grep {! $h{"@$_"}++} @{$arr};
return $arr;
}
####
# Out fields all and bad
###
sub out_all {
my $self = shift;
if ( $self->{all_array_out} && $self->all_fields_type eq 'array' ) {
return $self->{all_array_out};
}
if ( $self->{all_hash_out} && $self->all_fields_type eq 'hash' ) {
return $self->{all_hash_out};
}
}
sub out_bad {
my $self = shift;
if ( @{ $self->{bad_array_out} } && $self->bad_fields_type eq 'array' ) {
return $self->{bad_array_out};
}
if ( $self->{bad_hash_out} && $self->bad_fields_type eq 'hash' ) {
return $self->{bad_hash_out};
}
}
sub out_sql {
my $self = shift;
if ( @{ $self->{sql_array_out} } && $self->sql_fields_type eq 'array' ) {
return $self->{sql_array_out};
}
if ( $self->{sql_hash_out} && $self->sql_fields_type eq 'hash' ) {
return $self->{sql_hash_out};
}
}
sub error_valid {
my $self = shift;
return ( $self->{bad_array_out} || $self->{bad_hash_out} ) ? 1 : undef;
}
=head1 NAME
MyApp::Model::ExtraDBI - DBI Model Class
=head1 SYNOPSIS
See L<MyApp>
=head1 DESCRIPTION
DBI Model Class.
=head1 AUTHOR
Dmitriy
email: [email protected]
=head1 LICENSE
This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
1;
|
| Код | my ( $self, $c, $edit_co ) = @_;
$c->stash->{template} = 'add_section.tt';
my $f = $c->model('ExtraDBI')->new; # инициализируется класс
$f->all_fields_type('hash'); # определяется что возвращать
$f->bad_fields_type('array'); #
# $c->request->params-> хэш форм
$f->cut_xss( 'name_co', $c->request->params->{name_content} )->exist_die;
# Удаляется xss, первый элемент ключ, второй - значение
# дальше идет метод exist_die, если не определено значение,
# то возращает ошибку в массив
$f->cut_xss( 'heading_name_co', $c->request->params->{name_head_content} )
->exist_die;
$f->cut_xss( 'keys_co', $c->request->params->{content_keys} )->exist_die;
$f->cut_xss( 'text_co', $c->request->params->{content_text} )->exist_die;
if ( $c->check_user_roles("moder_se") ) {
# проверяется включен ли элемент HTML check, вкл 1, выкл 0
# и вставляться в хэш,
# дальше из него строиться SQL запрос, хэш отправляется в
# SQL::Abstarct
$f->int_check( 'hiden_g_co',
$c->request->params->{type_hiden_guest_content} );
$f->int_check( 'close_co', $c->request->params->{type_close_content} );
$f->int_check( 'active_co',
$c->request->params->{type_active_content} );
}
$f->int_check( 'hiden_co', $c->request->params->{type_hiden_content} );
$f->int_check( 'voting_co', $c->request->params->{type_voting_content} );
$f->int_check( 'forbi_comm_co', $c->request->params->{forbi_comm_co} );
my $sp;
if ( $c->request->params->{type_section_privat} eq 'on' ) {
$sp = 'AND privat_se = 1';
}
else {
$sp = 'AND privat_se = 0';
$f->no_sql->int_check( 'privat_se', 'on' );
}
if ( !$edit_co && !$c->request->params->{section_child2} ) {
$c->request->params->{section_child2} =
$c->request->params->{type_section_privat} eq '1' ? 1 : 35;
}
if (
$f->no_sql->valid_id(
# это действие в SQL запрос не идет,
# valid_id() если значение не цифра, то ошибка
'parent_se_id', $c->request->params->{section_child2}
)->out
)
{
my $dbh = $c->model('DBI')->dbh;
my $sth = $dbh->prepare(
"SELECT id_se,
id_un,
close_se,
active_se,
forbi_content_se,
privat_se
FROM section
WHERE id_se = ?
$sp
LIMIT 1"
);
$sth->execute( $c->request->params->{section_child2} );
my $section = $sth->fetchrow_hashref();
$sth->finish();
if ( $f->exist_die( 'id_se', $section->{id_se} )->out ) {
# если отсутствует - ошибка
if ( !$c->check_user_roles('moder_se') ) {
if ( $section->{active_se} == 0
&& $section->{id_un} != $c->user->{user}->{id} )
{
$f->no_sql->zero_die( 'active_se', 0 );
}
$f->no_sql->zero_die( 'forbi_content_se',
$section->{forbi_content_se} );
}
}
}
if ($edit_co) {
$f->no_sql->exist_die( 'no_edit_id_co',
$c->request->params->{edit_id_co} );
if ( !$c->check_user_roles('moder_se') ) {
my $dbh = $c->model('DBI')->dbh;
my $sth = $dbh->prepare(
"SELECT id_co,
close_co,
id_un
FROM content
WHERE id_co = ?
LIMIT 1"
);
$sth->execute( $c->request->params->{edit_id_co} );
my $section = $sth->fetchrow_hashref();
$sth->finish();
$f->no_sql->zero_die( 'close_co', $section->{close_se} );
if ( $section->{id_un} == $c->user->{user}->{id} ) {
$f->no_sql->zero_die( 'id_un_no_co', 0 );
}
}
}
# если найдена ошибка, то пропускает обработку СУБД
if ( !$f->error_valid ) {
# если ошибок нету
my $hash = $f->out_all; # получаем хэш SQL
my $type_sql;
my $where; # дополнительный хэш, условие SQL
if ($edit_co) {
# если текущее действие редактирование
$type_sql = 'update';
# sql действие для модуля SQL::Abstarct
$where->{id_co} = $c->request->params->{edit_id_co};
$where->{id_un} = $c->user->{user}->{id}
if ( !$c->check_user_roles('moder_co') );
$hash->{modified} = time;
}
if ( !$edit_co ) {
# аналогично, не редактирование
if ( !$c->check_user_roles("moder_se") ) {
$hash->{hiden_g_co} = 0;
$hash->{close_co} = 0;
$hash->{active_co} = 0;
}
$type_sql = 'insert';
$hash->{created} = time;
$hash->{id_un} = $c->user->{user}->{id};
}
use SQL::Abstract;
my $sql = SQL::Abstract->new;
# генерим запрос, таблица content
my ( $stmt, @bind ) = $sql->$type_sql( 'content', $hash, $where );
my $dbh = $c->model('DBI')->dbh;
my $sth = $dbh->prepare($stmt);
$sth->execute(@bind);
$sth->finish();
# выполнили
my $lastid = $dbh->{mysql_insertid} unless ($edit_co);
# последний элемент для редиректа
my $url;
# редиректим в зависимости от условия
my $redirect_id =
$edit_co ? $c->request->params->{edit_id_co} : $lastid;
if ( $c->request->params->{type_redirect} eq 'on' ) {
$url = '/profile/edit_pesonal_content/' . $redirect_id;
}
else {
$url = '/view_content/' . $redirect_id;
}
$c->response->redirect( $c->uri_for($url) );
$c->detach();
}
else {
# если была ошибка (которая не должна быть, иначе SQL запрос не сработает)
my $out_all = $f->out_all;
# получить все элементы, чтобы заполнить обратно формы ШТМЛ
my $out_bad = $f->out_bad;
# там где была ошибка
$c->stash->{bad_form} = 1;
# ошибка, $c->stash-> хэш который идет в шаблон HTML
while ( my ( $key, $value ) = each( %{$out_all} ) ) {
# ссылка на хэш и в шаблон
$c->stash->{ $key . '_current' } = $value;
}
foreach ( @{$out_bad} ) {
# все плохие эллементы, то же самое массив через ссылку
$_ .= $_ . '_error' if ( $_ eq 'id_se' );
$c->stash->{$_} = 1;
}
# возвращется обратно в зависимости редактирования или добавления
if ( !$edit_co ) {
$c->forward( 'add_content',
[ $c->request->params->{section_child2} ] );
}
else {
$c->forward( 'edit_pesonal_content',
[ $c->request->params->{section_child2} ] );
}
$c->detach();
} |
на счет экранирование тэгов от XSS, можно посмотреть на разные варианты, вот вариант взят с Ikonboard | Код |
sub _clean_html {
my $self = shift;
$self->{value} =~ s!\0!!g;
$self->{value} =~ s|&|&|g;
$self->{value} =~ s|<!--|<!--|g;
$self->{value} =~ s|-->|-->|g;
$self->{value} =~ s|<script|<script|ig;
$self->{value} =~ s|>|>|g;
$self->{value} =~ s|<|<|g;
$self->{value} =~ s|"|"|g;
$self->{value} =~ s| | |g;
$self->{value} =~ s!\|!|!g;
$self->{value} =~ s|\n|<br>|g;
$self->{value} =~ s|\$|$|g;
$self->{value} =~ s|\r||g;
$self->{value} =~ s|\_\_(.+?)\_\_||g;
$self->{value} =~ s|\\|\|g;
$self->{value} =~ s|\'|'|g;
$self->{value} =~ s|!|!|g;
return $self;
} |
#### #### #### и пример из книге Джонатана Роквея “Catalyst” используется: MVC Catatalyst, DBIx::Class, FormBuilder | Код |
package AddressBook::Controller::Address;
use strict;
use warnings;
use base qw(Catalyst::Controller::FormBuilder Catalyst::Controller::
BindLex');
sub add : Local Form('/address/edit') {
my ($self, $c, $person_id) = @_;
$c->stash->{template} = 'address/edit.tt2';
$c->forward('edit', [undef, $person_id]);
}
sub edit : Local Form {
my ($self, $c, $address_id, $person_id) = @_;
my $address : Stashed;
if(!$address_id && $person_id){
# we're adding a new address to $person
# check that person exists
my $person = $c->model('AddressDB::People')->
find({id => $person_id});
if(!$person){
$c->stash->{error} = 'No such person!';
$c->detach('/person/list');
}
# create the new address
$address = $c->model('AddressDB::Addresses')->
new({person => $person});
}
else {
$address = $c->model('AddressDB::Addresses')->
find({id => $address_id});
if(!$address){
$c->stash->{error} = 'No such address!';
$c->detach('/person/list');
}
}
if ($c->form->submitted && $c->form->validate){
# transfer data from form to database
$address->location($c->form->field('location'));
$address->postal ($c->form->field('postal' ));
$address->phone ($c->form->field('phone' ));
$address->email ($c->form->field('email' ));
$address->insert_or_update;
$c->stash->{message} =
($address_id > 0 ? 'Updated ' : 'Added new ').
'address for '. $address->person->name;
$c->detach('/person/list');
}
else {
# transfer data from database to form
if(!$address_id){
$c->stash->{message} = 'Adding a new address ';
}
else {
$c->stash->{message} = 'Updating an address ';
}
$c->stash->{message} .= ' for '. $address->person->name;
$c->form->field(name => 'location',
value => $address->location);
$c->form->field(name => 'postal',
value => $address->postal);
$c->form->field(name => 'phone',
value => $address->phone);
$c->form->field(name => 'email',
value => $address->email);
}
}
sub delete : Local {
my ($self, $c, $address_id) = @_;
my $address = $c->model('AddressDB::Addresses')->
find({id => $address_id});
if($address){
# "Deleted First Last's Home address"
$c->stash->{message} =
'Deleted ' . $address->person->name. q{'s }.
$address->location. ' address';
$address->delete;
}
else {
$c->stash->{error} = 'No such address';
}
$c->forward('/person/list');
}
1; |
|
CRUD 
Загрузка ...
