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

Автоматизация функционального тестирования
онлайн, начало 13 декабря
Python для начинающих
онлайн, начало 18 декабря
Погружение в тестирование. Jedi point
онлайн, начало 16 декабря
Школа Тест-Аналитика
онлайн, начало 18 декабря
Фотография

Реализация 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 анонимных

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