Перейти к содержимому

Тестирование мобильных приложений
онлайн, начало 22 января
Комплексная система подготовки к сертификации ISTQB FL (КСП ISTQB)
онлайн, начало 20 января
Логи как инструмент тестировщика
онлайн, начало 20 января
Автоматизатор мобильных приложений
онлайн, начало 20 января
Фотография

Реализация CRUD под Perl (в MVC Catalyst)


  • Авторизуйтесь для ответа в теме
В теме одно сообщение

#1 q7u5

q7u5

    Новый участник

  • Members
  • Pip
  • 10 сообщений

Отправлено 11 Август 2009 - 23:26

Реализация CRUD + SQL::Abstract на Perl (в MVC Catalyst)
В данной статье рассматривается реализация CRUD под perl. Все кто программируют под web знают, что главная проблема веб программирования обработать HTML form тэги (<form></form>) и при этом работать с БД (как правило с различными СУБД), что в некоторых случаях бывает затруднительно. CRUD - (англ. create read update delete — «Создание чтение обновление удаление»):

Операция	 SQL-оператор

Создание	 INSERT
Чтение	 SELECT
Редактирование	 UPDATE
Удаление	 DELETE


Реализовано в Django на Python, Ruby on Rails, на многих фреймворках Java и php symfony YII

Catalyst::Controller::FormBuilder от CGI::FormBuilder
Catalyst::Controller::FormFu от HTML::FormFu
Catalyst::Plugin::Form::Processor от Form::Processor
Rose::HTML::Form
Catalyst::Plugin::CRUD
CatalystX::ListFramework::Builder
CatalystX::CRUD::YUI
BasicCRUD

Более детально, например, при ошибке нужно все заполненные данные вернуть пользователю обратно, ну и указать в чем именно ошибка. Для удобного программирования в современных языках программирования есть ORM (англ. Object-relational mapping, русск. Объектно-реляционная проекция) присутствуют практически во всех веб фремворках, они необходимы для решения проблем при работе с реляционными системами управления базами данных. Использование реляционной базы данных для хранения объектно-ориентированных данных приводит к семантическому провалу, заставляя программистов писать программное обеспечение, которое должно уметь как обрабатывать данные в объектно-ориентированном виде, так и уметь сохранить эти данные в реляционной форме. Эта постоянная необходимость в преобразовании между двумя разными формами данных не только сильно снижает производительность, но и создает трудности для программистов, так как обе формы данных накладывают ограничения друг на друга.

Некоторые реализации ORM автоматически синхронизируют загруженные в память объекты с базой данных. Для того чтобы это было возможным, после создания объект-в-SQL-преобразующего SQL-запроса полученные данные копируются в поля объекта, как во всех других реализациях ORM. После этого объект должен следить за изменениями этих значений и записывать их в базу данных.

Системы управления реляционными базами данных показывают хорошую производительность на глобальных запросах, которые затрагивают большой участок базы данных, но объектно-ориентированный доступ более эффективен при работе с малыми объёмами данных, так как это позволяет сократить семантический провал между объектной и реляционной формами данных.

С точки зрения программиста система должна выглядеть как постоянное хранилище объектов. Он может просто создавать объекты и работать с ними как обычно, а они автоматически будут сохраняться в реляционной базе данных.

На практике всё не так просто и очевидно. Все системы ORM обычно проявляют себя в том или ином виде, уменьшая в некотором роде возможность игнорирования базы данных. Более того, слой транзакций может быть медленным и неэффективным (особенно в терминах сгенерированного SQL). Все это может привести к тому, что программы будут работать медленнее и использовать больше памяти, чем программы, написанные «вручную».

Но ORM избавляет программиста от написания большого количества кода, часто однообразного и подверженного ошибкам, тем самым значительно повышая скорость разработки. Кроме того, большинство современных реализаций ORM позволяют программисту при необходимости самому жёстко задать код SQL-запросов, который будет использоваться при тех или иных действиях (сохранение в базу данных, загрузка, поиск и т. д.) с постоянным объектом.

на perl: Class::DBI (CDBI), DBIx::Class(DBIC), Rose::DB::Object (RDBO) и другие

Важно сказать, про шаблоны программирования на которых основаны фремворки, большинство из них которые под web основаны на модели MVC, позволяют использовать основную бизнес логику в контролерах, модели как правило дополнительный классы (тот же ORM) и представление - это HTML или XML шаблон. Но как правило у них очень много возможностей и по этому много исходного кода, они очень ресурсоемкие, единственное целесообразно использовать их в очень больших проектах. Многие программисты не согласны с тем как построенные данные фремворки, главный недостаток, отсутствие провидения большого рефакторинга с помощью тестирования для улучшения парадигм или для ускорение работы программ (и уменьшение потребляемой памяти). Что использовать выбирайте сами.

покажу свой класс реализацию CRUD для SQL::Abstract

Примечание:
1) я продемонстрировал реализацию CRUD, для моих проектов этого было вполне достаточно, я не делал класс максимально удобно и с большими возможностями, по той причине, что каждый может написать/дописать так как захочет.
2) если что-то не понятно - спрашивайте, потому что я не знаю, то что вы не знаете, по этому комментарнии написал слабые.
3) использовать можно не только в MVC Catalyst.


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!!!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: rtyug@ukr.net

=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!!!g;
	$self->{value} =~ s|&|&amp;|g;
	$self->{value} =~ s|<!--|<!--|g;
	$self->{value} =~ s|-->|-->|g;
	$self->{value} =~ s|<script|<script|ig;
	$self->{value} =~ s|>|&gt;|g;
	$self->{value} =~ s|<|&lt;|g;
	$self->{value} =~ s|"|&quot;|g;
	$self->{value} =~ s|  | &nbsp;|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;

зеркало
  • 0

#2 q7u5

q7u5

    Новый участник

  • Members
  • Pip
  • 10 сообщений

Отправлено 10 Декабрь 2009 - 02:33

UPD:

переписал и оптимизировал
  • 0




Количество пользователей, читающих эту тему: 0

0 пользователей, 0 гостей, 0 анонимных

Яндекс.Метрика
Реклама на портале