CRUD perl реализация, есть ли ошибки

И всё прочее, что касается HTML
Правила форума
Убедительная просьба юзать теги [code] при оформлении листингов.
Сообщения не оформленные должным образом имеют все шансы быть незамеченными.
Аватара пользователя
ProFTP
подполковник
Сообщения: 3388
Зарегистрирован: 2008-04-13 1:50:04
Откуда: %&й
Контактная информация:

CRUD perl реализация, есть ли ошибки

Непрочитанное сообщение ProFTP » 2009-06-21 3:48:57

вот дописал свой класс для обработки форм

я хотел бы на cpan.org может модуль сделать
прокомментируйте как написано, нормально? кто как реализовывал?

вот сам класс

Код: Выделить всё

package MyApp::Model::ExtraDBI;

use strict;
use warnings;

use base qw( Catalyst::Model Class::Accessor);

use NEXT;

use HTML::Entities::Numbered;

__PACKAGE__->mk_accessors(qw/bad_fields_type all_fields_type/); # вместо $f->bad_fields_type('arrey');  -->  $self->bad_fields_type eq 'arrey' 
                                                                                              # удобно когда много гемороя, в данном случае можно без него

sub new {  # наследуем конструктор
	my ( $self, $c ) = @_;
	$self = $self->NEXT::new(@_);
}

sub no_sql {  # метод если есть, то не вставляется в 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_bad_fields {     
	my ($self) = @_;

	if ( $self->{no_bad} == 1 ) {
		$self->{no_bad} = undef;
		return;
	}
           # куда заносить в массив или в хэш
	if ( $self->bad_fields_type eq 'arrey' ) {  
		if ( !$self->{bad_arrey_out} ) {
			$self->{bad_arrey_out} = [];  # массив

		}
		push @{ $self->{bad_arrey_out} },
		  $self->{key};	# is $self->fails_type  arrey

	}

	if ( $self->bad_fields_type eq 'hash' ) {

		$self->{bad_hash_out}->{ $self->{key} } =
		  $self->{value};  # $self->fails_type  HASH   key = faild, value = name
	}

}
                   # добавляется в другой массив или в хэш все элементы 
                   # которые идут в SQL или в форму для возврата
sub _add_all_fields {
	my ($self) = @_;

	if ( $self->{no_sql} == 1 ) {
		$self->{no_sql} = undef;
		return;
	}

	if ( $self->all_fields_type eq 'arrey' ) {

		if ( !@{ $self->{all_arrey_out} } ) {
			$self->{all_arrey_out} = [];
		}

		push @{ $self->{all_arrey_out} },
		  $self->{key};	# is $self->fails_type  arrey
	}

	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
###
sub head_text {
	my $self = shift;

	$self->{key}   = shift; # первый элемент
	$self->{value} = shift; # второй элемент

	$self->_del_blanks_end_began;
	$self->_cleaning;
	$self->_add_all_fields();

	return $self->{value} if ( defined wantarray );  # wantarray для ттого тчобы определить если ли элемент 
                                                      #который ждет получить какие-то значение  $bla = $bla->bla;
                                                        # то есть если написано так $bla->bla->bla2 , что чтобы возвратить объект второму методу bla2
}

sub valid_id {
	my $self = shift;

	$self->{key}   = shift;
	$self->{value} = shift;

	$self->_del_blanks_end_began();
	$self->_add_all_fields();

	if ( !$self->{value} =~ /^\d+$/ ) {  # цифра
		$self->_add_bad_fields();
		$self->{value} = undef;
	}
	return $self->{value} if ( defined wantarray );

}

sub int_check {
	my $self = shift;
	$self->{key}   = shift;
	$self->{value} = shift;

	$self->_del_blanks_end_began();
	$self->{value} = $self->{value} eq 'on' ? '1' : '0';
	$self->_add_all_fields();

	return $self->{value} if ( defined wantarray );

}

sub one_die {
	my $self = shift;

	$self->{key}   = shift;
	$self->{value} = shift;

	$self->_del_blanks_end_began();

	$self->_add_all_fields();

	if ( !$self->{value} == 1 ) {
		$self->_add_bad_fields();
		$self->{value} = undef;
	}
	return $self->{value} if ( defined wantarray );
}

sub zero_die {
	my $self = shift;

	$self->{key}   = shift;
	$self->{value} = shift;

	$self->_del_blanks_end_began();

	$self->_add_all_fields();

	if ( !$self->{value} == 0 ) {
		$self->_add_bad_fields();
		$self->{value} = undef;
	}
	return $self->{value} if ( defined wantarray );
}

sub cut_xss {

	my $self = shift;

	$self->{key}   = shift if @_;
	$self->{value} = shift if @_;

	$self->_del_blanks_end_began;
	$self->_clean_html;

	return $self->{value} if (wantarray);
	return $self;
}

sub exist_die {
	my $self = shift;

	$self->{key}   = shift if @_;
	$self->{value} = shift if @_;

	$self->_add_all_fields();

	if ( !$self->{value} ) {
		$self->_add_bad_fields();
		$self->{value} = undef;
		$self->{key}   = undef;
	}

	return $self->{value} if (wantarray);
	return $self;

}

####
#   Out fields all and bad
###
            # получение массива или хэша SQL
sub out_all {
	my $self = shift;

	if ( defined $self->{all_arrey_out} && $self->all_fields_type eq 'arrey' ) {
		return $self->{all_arrey_out};
	}

	if ( defined $self->{all_hash_out} && $self->all_fields_type eq 'hash' ) {
		return $self->{all_hash_out};
	}

}
           # там где были ошибки
sub out_bad {
	my $self = shift;

	if ( defined @{ $self->{bad_arrey_out} }
		&& $self->bad_fields_type eq 'arrey' )
	{
		return $self->{bad_arrey_out};
	}

	if ( defined $self->{bad_hash_out} && $self->bad_fields_type eq 'hash' ) {
		return $self->{bad_hash_out};
	}

}
                # есть ли ошибки вывести 1
sub error_valid {
	my $self = shift;

	if ( $self->{bad_arrey_out} || $self->{bad_hash_out} ) {
		return 1;
	}
	else {
		return undef;
	}

}

как работает:

Код: Выделить всё

	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('arrey');  #
             
             # $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 запрос не идет, если значение не цифра, то ошибка
			'parent_se_id', $c->request->params->{section_child2}
		)
	  )
	{

		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} ) ) {  # если от сутствует - ошибка

			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-> хэш котоырй эиет в шаблон ШТМЛ
                   
		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();

	}
Pеrl FAQ
perl -e 'print join"",map $$_[rand@$_],([0..9,'a'..'z','A'..'Z'])x30'
ИзображениеИзображение

Хостинговая компания Host-Food.ru
Хостинг HostFood.ru
 

Услуги хостинговой компании Host-Food.ru

Хостинг HostFood.ru

Тарифы на хостинг в России, от 12 рублей: https://www.host-food.ru/tariffs/hosting/
Тарифы на виртуальные сервера (VPS/VDS/KVM) в РФ, от 189 руб.: https://www.host-food.ru/tariffs/virtualny-server-vps/
Выделенные сервера, Россия, Москва, от 2000 рублей (HP Proliant G5, Intel Xeon E5430 (2.66GHz, Quad-Core, 12Mb), 8Gb RAM, 2x300Gb SAS HDD, P400i, 512Mb, BBU):
https://www.host-food.ru/tariffs/vydelennyi-server-ds/
Недорогие домены в популярных зонах: https://www.host-food.ru/domains/

zg
полковник
Сообщения: 5845
Зарегистрирован: 2007-12-07 13:51:33
Откуда: Верх-Нейвинск

Re: CRUD perl реализация, есть ли ошибки

Непрочитанное сообщение zg » 2009-06-21 6:16:17

ProFTP писал(а):вот дописал свой класс для обработки форм
и где по нему документация?
ProFTP писал(а):я хотел бы на cpan.org может модуль сделать
без документации можешь толку от твоего модуля ровно ноль
ProFTP писал(а):прокомментируйте как написано, нормально? кто как реализовывал?
реализовывал что?

Аватара пользователя
ProFTP
подполковник
Сообщения: 3388
Зарегистрирован: 2008-04-13 1:50:04
Откуда: %&й
Контактная информация:

Re: CRUD perl реализация, есть ли ошибки

Непрочитанное сообщение ProFTP » 2009-06-21 6:50:19

действительно документация нужна...
zg писал(а): реализовывал что?
CRUD (создание, чтение, изенение и удаление) апликация (это от Java пошло, потом везде появилось)
http://ru.wikipedia.org/wiki/CRUD

обработка Form HTML и обноврменно работа с СУБД, УДОБНАЯ...
Pеrl FAQ
perl -e 'print join"",map $$_[rand@$_],([0..9,'a'..'z','A'..'Z'])x30'
ИзображениеИзображение

zg
полковник
Сообщения: 5845
Зарегистрирован: 2007-12-07 13:51:33
Откуда: Верх-Нейвинск

Re: CRUD perl реализация, есть ли ошибки

Непрочитанное сообщение zg » 2009-06-21 8:36:13

ProFTP писал(а):обработка Form HTML и обноврменно работа с СУБД, УДОБНАЯ...
и шо тут такого удобного?
ProFTP писал(а):arrey
нету такого понятия, есть array

Аватара пользователя
ProFTP
подполковник
Сообщения: 3388
Зарегистрирован: 2008-04-13 1:50:04
Откуда: %&й
Контактная информация:

Re: CRUD perl реализация, есть ли ошибки

Непрочитанное сообщение ProFTP » 2009-06-21 9:08:28

1) сразу идет обработка текста с форм на ООП
2) сразу в одном методе вставка и добавление (insert update)
3) SQL запрос иедт в абстракции или ORM на уровне ООП языка
4) экономия кода в основным модулях, чтобы мусорку там не делать
5) возможна кроссплатформа между некоторыми СУБД (oracle, sqlite, mysql, pgsql etc), програма сразу на некоторых может работать, нужно только таблицы создать

вот я еще показывал, на ОРМ

Код: Выделить всё

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;
Pеrl FAQ
perl -e 'print join"",map $$_[rand@$_],([0..9,'a'..'z','A'..'Z'])x30'
ИзображениеИзображение

zg
полковник
Сообщения: 5845
Зарегистрирован: 2007-12-07 13:51:33
Откуда: Верх-Нейвинск

Re: CRUD perl реализация, есть ли ошибки

Непрочитанное сообщение zg » 2009-06-21 9:15:15

ProFTP писал(а):1) сразу идет обработка текста с форм на ООП
а нах? текст он и есть текст, зачем ему ООП?
ProFTP писал(а):2) сразу в одном методе вставка и добавление
ты хоть схему нарисуй нафига оно надо
ProFTP писал(а):3) SQL запрос иедт в абстракции или ORM на уровне ООП языка
чего? я честно говоря абстракции запросов не заметил
ProFTP писал(а):вот я еще показывал, на ОРМ
по моему это не твой код, потому как комменты писал человек, знающий инглиш, да и по стилю сильно различается

Аватара пользователя
ProFTP
подполковник
Сообщения: 3388
Зарегистрирован: 2008-04-13 1:50:04
Откуда: %&й
Контактная информация:

Re: CRUD perl реализация, есть ли ошибки

Непрочитанное сообщение ProFTP » 2009-06-21 9:27:24

zg писал(а):а нах? текст он и есть текст, зачем ему ООП?
регулярные выражения, всякие обработки форм если програма большая, и строить запрос на ходу и т.д.
zg писал(а): ты хоть схему нарисуй нафига оно надо
абстракция, то что сам запрос в хэшах, массивах или в ООП, то есть самого SQL запроса нету...

вот я определяю что я буду делать вставлять или обновлять

Код: Выделить всё

    if ($edit_co) {

            $type_sql = 'update';

            $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;

        my ( $stmt, @bind ) = $sql->$type_sql( 'content', $hash, $where );

схему сложно написать, она одна и таже вот я использовал раньше код:
(какой лучше код тот которвый вверу с CRUD, наверное лучше?)

Код: Выделить всё

sub add_section : Local {
    my ( $self, $c ) = @_;
    $c->stash->{template} = '/home/x0/data/www/MyApp/root/add_section.tt';
    my $dbh = $c->model('DBI')->dbh;
    my $sth = $dbh->prepare(
        "SELECT id_se, name_se 
                             FROM section
                      ");
    $sth->execute();
    my $loop_data;
    push @{$loop_data}, $_ while $_ = $sth->fetchrow_hashref();
    $sth->finish();
    $c->stash->{user_exists} = $c->user_exists();
    my $ff = $c->user;
    $c->stash->{messages} = $loop_data;
    $c->stash->{admin} = 1 if ( $c->user->{user}->{username} eq 'admin' );
}
sub add_section2 : Local {
    my ( $self, $c ) = @_;
    $c->stash->{template} = 'add_section.tt';
   my  $ps;   my $er;      %{$er}=();
    $ps = $c->request->params;
    my $lastid;        my $re;
   my @sql;     my @sqlp;
    my $section;
    %{$section} = ();
    
        $ps->{type_section_privat} = $ps->{type_section_privt} eq 'on' ? '1' : '0';    
            if ( $c->user->{user}->{username} eq 'admin' )
              {
               $ps->{type_section_hidden_guest} = $ps->{type_section_hidden_guest} eq 'on' ? '1' : '0';    
                 $ps->{type_section_forb_s} = $ps->{type_section_forb_s} eq 'on' ? '1' : '0';    
                 $ps->{type_section_forb_c} = $ps->{type_section_forb_c} eq 'on' ? '1' : '0';   
                 $ps->{type_section_active} = $ps->{type_section_active} eq 'on' ? '1' : '0';   
              }
    if ( $ps->{type_section_privat} eq 'on' ) {
        $ps->{type_section_privat} = 1;
        $section->{id_se} = 'privat';
    }
    else {
        if ($ps->{section_child}) {
            my $dbh = $c->model('DBI')->dbh;
            my $sth = $dbh->prepare(
                "SELECT id_se
                                      FROM section
                                      WHERE id_se = ?
                                      LIMIT 1"
            );
            $sth->execute($ps->{section_child});
            $section = $sth->fetchrow_hashref();
            $sth->finish();
            $ps->{type_section_privat} = '0';
        }
    }
    my $error_se;
    unless ($ps->{name_section}) {
        $error_se = 1;
    }
    if ( $error_se != 1 && $section->{id_se} ) {
       
        push @sql, 
             $c->user->{user}->{id},
             $section->{id_se},
             $ps->{name_section},
             $ps->{type_section_privat},
             '0',
             time;    
        
        
            if ( $c->user->{user}->{username} eq 'admin' ) {
                    
                push @sql,
                   $ps->{type_section_active},
                   $ps->{type_section_forb_s},
                    $ps->{type_section_forb_s},
                    $ps->{type_section_hidden_guest};
                    
            } else {
                push @sql,
                   '1',
                   '0',
                    '0',
                    '0';            
            }
            
            my $sql;
         if ( $ps->{submit} && $ps->{submit} eq 'Add section' ) {
        
          $sql = "INSERT INTO section (  id_un,
                                            parent_se_id,
                                            name_se,
                                            privat_se,
                                            close_se,
                                            created,
                                            active_se,
                                            forbi_section_se,
                                            forbi_content_se,
                                            hiden_g_co 
                               ) 
              VALUES (?,
                      ?,
                      ?,
                      ?,
                      ?,
                      ?,
                      ?,
                      ?,
                      ?,
                      ?)
               ";
         
          }
                        
         if ( $ps->{submit} && $ps->{submit} eq 'Edit section' ) {
            
                    if ( $c->user->{user}->{username} eq 'admin' ) {
            push @sqlp,
               'active_se = ?',
                    'forbi_section_se = ?',
                    'forbi_content_se = ?',
                    'hiden_g_co = ?';
                    
                push @sql,
                   $ps->{type_section_active},
                   $ps->{type_section_forb_s},
                    $ps->{type_section_forb_s},
                    $ps->{type_section_hidden_guest};                    
                     } 
                             
              push @sql, $ps->{id_content};
                my $sql2    = join(',', @sqlp);    
                
              $sql = " UPDATE section 
                         SET     parent_se_id = ?,
                                            name_se = ?,
                                            privat_se = ?,
                                            close_se = ?,
                                            created = ?,
                                        $sql2       
                       WHERE id_se = ?
                             ";
        }
        
        my $dbh = $c->model('DBI')->dbh;
        my $sth = $dbh->prepare($sql);
        $sth->execute(@sql);
        $sth->finish();
        $lastid = $dbh->{mysql_insertid} if ($ps->{submit} eq 'Add section');
      
        if ($ps->{type_redirect} eq 'on') {
          $lastid = $lastid eq '' ? $ps->{id_se} : $lastid;    
            $c->response->redirect($c->uri_for('/profile/edit_personal_section/'.$lastid));
         } else {
            $c->response->redirect($c->uri_for('/profile/view_pesonal_section'));
        }
    }
    else {
      $c->response->redirect($c->uri_for('/profile/view_pesonal_section'));
    }
sub add_content : Local {
    my ( $self, $c ) = @_;
    $c->stash->{template} = 'add_content.tt';
    my $dbh = $c->model('DBI')->dbh;
    my $sth = $dbh->prepare(
        "SELECT id_se, name_se 
                             FROM section
                                                         ");
    $sth->execute();
    my $loop_data;
    push @{$loop_data}, $_ while $_ = $sth->fetchrow_hashref();
    $sth->finish();
    $c->stash->{user_exists} = $c->user_exists();
    my $ff = $c->user;
    $c->stash->{messages} = $loop_data;
}
sub add_content2 : Local {
    my ( $self, $c ) = @_;
    $c->stash->{template} = 'add_section.tt';
  my $lastid;     my  $ps;
  my $er;     %{$er}=();
   $ps = $c->request->params;
    my $content;
    if ( $ps->{submit} && $ps->{submit} eq 'Edit content' ) {
        if ( $ps->{id_content} ) {
            my @sql, my $sqlp;
            if ( $c->user->{user}->{username} eq 'admin' )
              {
                  push @sql, $ps->{id_content};
            }
            else {
                  push @sql, $ps->{id_content}, $c->user->{user}->{id};
                  $sqlp = 'AND id_un = ?';
            }
            my $dbh = $c->model('DBI')->dbh;
            my $sth = $dbh->prepare(
                  "SELECT id_co
                                        FROM content
                                       WHERE id_co = ?
                                             $sqlp
                                       LIMIT 1"
            );
            $sth->execute(@sql);
            $content = $sth->fetchrow_hashref();
            $sth->finish();
            unless ( $content->{'id_co'} ) {
            $er->{'no_id_content'} = 1;
            }
        } else {
            $er->{'id_content_error'} = 1;
        }
   }
$ps->{type_hiden_content} = $ps->{type_hiden_content} eq 'on' ? '1' : '0';    
 
    
$ps->{type_voting_content} = $ps->{type_voting_content} eq 'on' ? '1' : '0';        
    my $section;
    if ( $ps->{type_content_privat} eq 'on' ) {
          $ps->{type_content_privat} = '1';
          $ps->{section_child}       = $c->user->{user}->{id};
    }
    else {
          if ( defined( $ps->{section_child} ) ) {
              my $dbh = $c->model('DBI')->dbh;
              my $sth = $dbh->prepare(
                  "SELECT id_se
                                      FROM section
                                      WHERE id_se = ?
                                      LIMIT 1"
              );
              $sth->execute( $ps->{section_child} );
              $section = $sth->fetchrow_hashref();
              $sth->finish();
              $er->{'no_id_content'} = 1 unless ( defined $section->{'id_se'} );
          }
    }
    unless ( defined $er->{'no_id_content'} ) {
              my @sqlp;              my @sql;
              my $sqlw;       my $sql;
          if ( $ps->{submit} && $ps->{submit} eq 'Add content' ) {
             $sql = '
           INSERT INTO content ( id_un,            
                                    id_se,             
                                        name_co,          
                                            heading_name_co,  
                                            keys_co,          
                                            text_co,         
                                            active_co,        
                                            hiden_co,         
                                            hiden_g_co,       
                                            close_co,         
                                            voting_co,        
                                            vo_all_co,       
                                            vo_balls_co,     
                                            vo_per,           
                                            created  ) 
              VALUES (?,
                      ?,
                      ?,
                      ?,
                      ?,
                      ?,
                      ?,
                      ?,
                      ?,
                      ?,
                      ?,
                      ?,
                      ?,
                      ?,
                      ?)
         
         ';
              push @sql,
                $c->user->{user}->{id},
                $ps->{section_child},
                $ps->{name_content},
                $ps->{name_hiden_content},
                $ps->{content_keys},
                $ps->{content_text},
                '0',
                $ps->{type_hiden_content},
                '0',
                '0',
                $ps->{type_voting_content},
                '1',
                '1',
                '1',
                time;
               
          }
          if ( $ps->{submit} && $ps->{submit} eq 'Edit content' ) {
            push @sql,
            $ps->{name_content},
            $ps->{name_hiden_content},
            $ps->{content_keys},
            $ps->{content_text},
            $ps->{type_hiden_content},
            $ps->{type_voting_content},
            time;
              if ( $c->user->{user}->{username} eq 'admin' )
                {
                
                unless ($ps->{type_content_privat} eq 'on') {
                push @sql, $ps->{section_child};                
                push @sqlp, 'id_se = ?';
                }
                
                    push @sql, 
                    $ps->{type_active_admin},
                    $ps->{type_hiden_admin},
                    $ps->{type_close_admin} ;
                    push @sqlp, 'active_co = ?',   
                               'hiden_co = ?',
                             'close_co = ?';
              }
              else {
                    push @sql,
                    $ps->{section_child}, 
                    $c->user->{user}->{id};
                    push @sqlp, 'id_se = ?';            
                    $sqlw = 'id_un = ?';
              }
              
              push @sql, $ps->{id_content};
                my $sql2    = join(',', @sqlp);    
                
              $sql = " UPDATE content 
                         SET  name_co = ?,
                              heading_name_co  = ?,  
                                        keys_co = ?,          
                                        text_co = ?, 
                                        hiden_g_co = ?,
                                        voting_co = ?,
                                        modified = ?,
                                        $sql2       
                       WHERE $sqlw                  
                         AND id_co = ?
                             ";
               }
   my $dbh = $c->model('DBI')->dbh;
                     my $sth = $dbh->prepare($sql);
       $sth->execute(@sql);
        $sth->finish();
        $lastid = $dbh->{mysql_insertid} if ($ps->{submit} eq 'Add content');
        if ($ps->{type_redirect} eq 'on') {
          $lastid = $lastid eq '' ? $ps->{id_content} : $lastid;    
                    $c->response->redirect($c->uri_for('/profile/edit_pesonal_content/'.$lastid));
            
         } else {
                            $c->response->redirect($c->uri_for('/profile/view_pesonal_content'));
        }
                return;
        } else {
            $c->stash->{no_id_content} = $er->{'no_id_content'};
            
            $c->stash->{id_content_error} = $er->{id_content_error};
                         $c->forward('/profile/edit_pesonal_content/'.$ps->{id_content});
        }
}
}
Pеrl FAQ
perl -e 'print join"",map $$_[rand@$_],([0..9,'a'..'z','A'..'Z'])x30'
ИзображениеИзображение

zg
полковник
Сообщения: 5845
Зарегистрирован: 2007-12-07 13:51:33
Откуда: Верх-Нейвинск

Re: CRUD perl реализация, есть ли ошибки

Непрочитанное сообщение zg » 2009-06-21 9:51:43

вот если честно, из всего этого набора букв я нормально понял только код про package AddressBook::Controller::Address;, но его писал не ты. Из твоего кода я вообще нифига не понял... :unknown:

Аватара пользователя
ProFTP
подполковник
Сообщения: 3388
Зарегистрирован: 2008-04-13 1:50:04
Откуда: %&й
Контактная информация:

Re: CRUD perl реализация, есть ли ошибки

Непрочитанное сообщение ProFTP » 2009-06-21 10:38:53

там идет много проверок просто, а что именно не понятно?
Pеrl FAQ
perl -e 'print join"",map $$_[rand@$_],([0..9,'a'..'z','A'..'Z'])x30'
ИзображениеИзображение

zg
полковник
Сообщения: 5845
Зарегистрирован: 2007-12-07 13:51:33
Откуда: Верх-Нейвинск

Re: CRUD perl реализация, есть ли ошибки

Непрочитанное сообщение zg » 2009-06-21 14:17:04

ProFTP писал(а):а что именно не понятно?
логика работы... скрипт что-то делает, а что и зачем не понятно, комментов-то нет :(

Аватара пользователя
ProFTP
подполковник
Сообщения: 3388
Зарегистрирован: 2008-04-13 1:50:04
Откуда: %&й
Контактная информация:

Re: CRUD perl реализация, есть ли ошибки

Непрочитанное сообщение ProFTP » 2009-06-21 20:47:28

ok напишу

но там вся документация идет к это модулю http://search.cpan.org/~ribasushi/SQL-A ... bstract.pm

только это не со всем ОРМ, то есть оно заточне под этот модуль, если ты будет другой ОРм использовать, то оно будет по другому, я как раз написать под этот модуль обработку форм

1) при обработки форм на ходу строиться хэш (или хэши, я ограничился одним хэшем) в котором сам запрос
2) дальше в конце если ошибок форм нету, то идет выполнение в СУБД, те элеенты которые нужно еще добавить в SQL, то добавляется в этот хэш
3) если ошибка в форм, то выводиться поля всех данных, и пишется где именно была ошибка
Pеrl FAQ
perl -e 'print join"",map $$_[rand@$_],([0..9,'a'..'z','A'..'Z'])x30'
ИзображениеИзображение

zg
полковник
Сообщения: 5845
Зарегистрирован: 2007-12-07 13:51:33
Откуда: Верх-Нейвинск

Re: CRUD perl реализация, есть ли ошибки

Непрочитанное сообщение zg » 2009-06-21 21:43:04

ProFTP писал(а):то есть оно заточне под этот модуль, если ты будет другой ОРм использовать, то оно будет по другому, я как раз написать под этот модуль обработку форм
то ли тут слов не хватает, то ли промт переводил древний, как-то странно предложение составлено :no:
ProFTP писал(а):3) если ошибка в форм, то выводиться поля всех данных, и пишется где именно была ошибка
я не про эту логику... вопрос был уровнем выше - не вдаваясь в релизацию, опиши зачем нужен твой код и какую логическую функцию он выполняет. Написать нужно просто и ясно - мой код делает магахрень, чтобы облегчить жизнь программерам и сделать их хлеб совсем халявским. Мегахрень заключается в следующем - тыры-пыры, тарам-пам-пам, и пошло описание... Мою хрень надо использовать потому, что она такая-растакая с переподвыподвертом и в красных сапогах.

Аватара пользователя
ProFTP
подполковник
Сообщения: 3388
Зарегистрирован: 2008-04-13 1:50:04
Откуда: %&й
Контактная информация:

Re: CRUD perl реализация, есть ли ошибки

Непрочитанное сообщение ProFTP » 2009-06-21 23:03:09

ok напишу, это будет не просто, там надо еще придумать как-то по другому реализовать модуль, чтоыб его на cpan.org выложить, а то он не смотрится (сама реализация))
Pеrl FAQ
perl -e 'print join"",map $$_[rand@$_],([0..9,'a'..'z','A'..'Z'])x30'
ИзображениеИзображение

Аватара пользователя
ProFTP
подполковник
Сообщения: 3388
Зарегистрирован: 2008-04-13 1:50:04
Откуда: %&й
Контактная информация:

Re: CRUD perl реализация, есть ли ошибки

Непрочитанное сообщение ProFTP » 2009-06-22 23:45:57

я коменты написал, посмотрите кто-то

как, номрально? где бы еще добавить коменты?

описание, статью не писал, так как сложно сформулировать надо подумать как...
Pеrl FAQ
perl -e 'print join"",map $$_[rand@$_],([0..9,'a'..'z','A'..'Z'])x30'
ИзображениеИзображение

zg
полковник
Сообщения: 5845
Зарегистрирован: 2007-12-07 13:51:33
Откуда: Верх-Нейвинск

Re: CRUD perl реализация, есть ли ошибки

Непрочитанное сообщение zg » 2009-06-23 5:26:00

ProFTP писал(а):как, номрально?
да собственно как было так и осталось... В комменты надо писать не только текущее действие, но и его логическую нагрузку.
ProFTP писал(а):# удобно когда много гемороя, в данном случае можно без него
порадовал :-D а что всё-таки имелось в виду?

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

Я могу рассказать от и до, что нужно сделать, чтобы с кодом не было проблем, но при условии, что это тебе, конечно, нужно.

Аватара пользователя
thefree
лейтенант
Сообщения: 980
Зарегистрирован: 2008-12-29 9:23:19
Откуда: Весёлая Страна

Re: CRUD perl реализация, есть ли ошибки

Непрочитанное сообщение thefree » 2009-06-23 8:55:24

извините, что ворвусь в производственный дебаты.
но я делаю проще, я проста задаюсь вопросом "на*уй мне это над?" и как правило всегда находится ответ.
А еще можно нарисовать БС, очень помогает.
Не судите меня строго, Я не волшебник, а только учусь!
http://planetbsd.ru - RSS-агрегатор *BSD по Рунету

Аватара пользователя
ProFTP
подполковник
Сообщения: 3388
Зарегистрирован: 2008-04-13 1:50:04
Откуда: %&й
Контактная информация:

Re: CRUD perl реализация, есть ли ошибки

Непрочитанное сообщение ProFTP » 2009-06-23 9:05:37

ладно проехали

вот аналогичные модули только не много больше возможостей
http://search.cpan.org/~nwiger/CGI-Form ... uilder.pod
http://search.cpan.org/~cfranks/HTML-Fo ... /FormFu.pm
писать столько не собираюсь пока, разве что на пенсии... :)
Pеrl FAQ
perl -e 'print join"",map $$_[rand@$_],([0..9,'a'..'z','A'..'Z'])x30'
ИзображениеИзображение

Аватара пользователя
thefree
лейтенант
Сообщения: 980
Зарегистрирован: 2008-12-29 9:23:19
Откуда: Весёлая Страна

Re: CRUD perl реализация, есть ли ошибки

Непрочитанное сообщение thefree » 2009-06-23 9:39:13

мне вот такая штучка понравилась, не как руки не доходят переписать ... никто не сталкивался или возможно есть самопал у кого то?
Вложения
mySQL.txt
(20.85 КБ) 34 скачивания
Не судите меня строго, Я не волшебник, а только учусь!
http://planetbsd.ru - RSS-агрегатор *BSD по Рунету

zg
полковник
Сообщения: 5845
Зарегистрирован: 2007-12-07 13:51:33
Откуда: Верх-Нейвинск

Re: CRUD perl реализация, есть ли ошибки

Непрочитанное сообщение zg » 2009-06-23 11:05:40

thefree писал(а):никто не сталкивался или возможно есть самопал у кого то?
шо-то там тихий ужос какой-то...
ProFTP писал(а):писать столько не собираюсь пока, разве что на пенсии...
рано или поздно всё равно придётся писать доку к своим проектам

Аватара пользователя
ProFTP
подполковник
Сообщения: 3388
Зарегистрирован: 2008-04-13 1:50:04
Откуда: %&й
Контактная информация:

Re: CRUD perl реализация, есть ли ошибки

Непрочитанное сообщение ProFTP » 2009-07-19 0:55:47

Pеrl FAQ
perl -e 'print join"",map $$_[rand@$_],([0..9,'a'..'z','A'..'Z'])x30'
ИзображениеИзображение