Perl / Обработка веб форм с сохранением результатов в MongoDB

в 8:23, , рубрики: mongodb, perl, формы, метки: , ,

Эта публикация родилась на основе ведущейся разработки, поэтому комментарии вида «надо было делать не так, а эдак» или «почему вы не взяли готовое решение А» неуместны; так было необходимо исходя из поставленной задачи. Описание задачи выходит за рамки сегодняшней темы, поэтому рассматривайте все, что находится под катом как иллюстрацию, как пример способа обработки веб форм.
ВНИМАНИЕ! Под катом много кода!

Что хочется получить в итоге:

  • Генерацию HTML представления формы
  • Валидацию результатов на сервере
  • Превалидацию на клиенте
  • Сохранение данных в MongoDB

ООП в Perl ругают, но нам на это наплевать, да будут объекты:)

package MCM::Form; use utf8; use MCM::FormTools; use MCM::DataStore;  sub new{     my ($class,$attrs,$fields,$params) = @_;     my $self = {new => 1, valid=>1, form_valid=>1, datastore=>$MCM::DataStore::user_collection};     # Предустановки для всех форм     $self->{attrs} = {caption=>"",action=>"",method=>"post",valid=>0,submit_text=>"Отправить",%$attrs};     $self->{fields} = $fields;     $self->{exclude} = []; # Какие-то поля формы не требуется сохранять в базу, их перечисляем тут     if(defined $params){     # Если в форму переданы данные, надо заполнить ими поля формы 	$self->{new} = 0; 	eval {map { $self->{fields}->{$_}->setValue( $params->{ $_ } ) } keys $self->{fields};};     }     bless $self, $class;     return $self; }  # Этот метод вызывается при сохранении данных в базу sub onsave {     my ($self) = @_; }  # Самая ужасная часть:) Можно сделать это все гораздо изящнее, но и сейчас это работает sub toHTML{ my $template =<< '--template--'; <form method="[% method %]" action="[% action %]" class="form" onSubmit="return CheckForm(this);">     <legend>[% caption %]</legend>     <!--error-->     [% fields %] 	    <div class="form-actions"> 		<input type="submit" class="btn btn-primary" value="[% submit_text %]"/> 	    </div> </form> --template--      my ($self) = @_;     my $fieldsHTML = "";     map { $template =~ s/[% ($_) %]/$self->{attrs}->{$_}/sg; } keys $self->{attrs};     # Каждое поле формы - отдельный объект, который возвращает свое HTML представление     # Получаем это представление в порядке объявления полей в форме     eval{ map { $fieldsHTML .= $self->{fields}->{$_}->toHTML($self->{new}) } sort {$self->{fields}->{$a}->{order}<=>$self->{fields}->{$b}->{order}} keys $self->{fields}; };     $template =~ s/[% fields %]/$fieldsHTML/s;     $template =~ s|<!--error-->|<div class="alert alert-danger">$self->{err_msg}</div>|s unless $self->{form_valid};          return $template; }  # Валидация формы в целом производится здесь sub form_valid {     my ($self) = @_;     return $self->{form_valid}; }  # Валидация каждого поля и затем формы в целом sub valid {     my ($self) = @_;     for (keys $self->{fields}){ 	$self->{valid} = 0 if not $self->{fields}->{$_}->valid;     }     return ($self->{valid}&&$self->form_valid); }  # А тут собираем данные из полей формы в хэш sub data {     my ($self) = @_;     return undef if not ($self->{valid}&&$self->{form_valid});     my %ret;     for my $key(keys $self->{fields}){ 	$ret{$key} = $self->{fields}->{$key}->getAttr('value') unless grep {$key eq $_} @{$self->{exclude}};     }     return %ret; }  # Сохраняем данные в базу sub save {     my ($self) = @_;     return undef if not ($self->{valid}&&$self->{form_valid});     my $ds = $self->{datastore};     my $ret = eval{db->$ds->insert($self->data('save'),{ safe=>1 });};     $self->onsave( db->$ds->find_one({ _id=>$ret }) );          return !$@; }  # Обновляем данные в базе sub update {     my ($self,$key) = @_;     return undef if not ($self->{valid}&&$self->{form_valid});     my $ds = $self->{datastore};     my $data = $self->data;     my $ret = eval{db->$ds->update($key,{'$set'=>$data},{ safe=>1 });};          return !$@; }  # Удаляем данные из базы sub remove {     my ($self,$key) = @_;     return undef if not ($self->{valid}&&$self->{form_valid});     my $ds = $self->{datastore};     my $data = $self->data;     my $ret = eval{db->$ds->remove($key, { safe=>1 });};          return !$@; }  1; 

Ого, немало здесь всякого! :) Давайте посмотрим на реализацию одного из полей формы.

package MCM::FormElements::Textarea;  use base 'MCM::FormElements::Abstract';  sub new{     my ($class,$name,$params) = @_;     $params->{size}//=1;     my $self  = $class->SUPER::new($name,$params);     return $self; }  sub toHTML{     my ($self) = @_;     $template = sprintf qq{ 	    <div class="control-group"> 		<label class="control-label">%s</label> 		<div class="controls"> 		    <div class="input"> 			<textarea name="%s" id="id_%s"/>%s</textarea> 		    </div> 		    <div> 			<!--error--> 		    </div> 		</div> 	    </div>     }, 	$self->getAttr('label'),  	$self->getAttr('name'),  	$self->getAttr('name'), 	$self->getAttr('value'); 	     return $template; } 

Осталось посмотреть на валидаторы и можно будет посмотреть как выглядит непосредственно рабочая форма.

# # Валидатор для полей, заполнение которых обязательно # package MCM::Validators::required; use base 'MCM::Validators::Abstract'; use MCM::FormTools;  sub new{     my ($class,$params) = @_;     my $self = $class->SUPER::new($params);     $self->{msg} = sprintf 'Необходимо указать %s', lc noun('i',$params->{name},'v');     return $self; }  sub execute{     my ($class,$value) = @_;     return $value ne '';     } 

А теперь пример реальной формы.

package Forms::Login;  use utf8; use base 'MCM::Form'; use MCM::FormElements; use MCM::FormTools; use MCM::DataStore; use Dancer ':syntax';  sub new {     my ($class,$attrs,$params) = @_;     my $fields = fields( 	new MCM::FormElements::TextField('login',{label=>'Имя',validators=>'required dotcom'}), 	new MCM::FormElements::PasswordField('passwd',{label=>'Пароль',validators=>'required'})     );     my $self  = $class->SUPER::new($attrs,$fields,$params);     return $self; }  sub form_valid{     my ($self) = @_;     $self->{form_valid} = 1;          my ($login,$domain) = split /@/,$self->{fields}->{login}->getAttr('value');     unless (defined $login and defined $domain){ 	$self->{form_valid} = 0; 	$self->{err_msg} = 'Не удалось выполнить вход. Проверьте ваши учетные данные.';     }          my $ds = $self->{datastore};     my $obj = db->$ds->find_one({login=>$login,domain=>$domain,passwd=>$self->{fields}->{passwd}->getAttr('value')});          unless($obj){     my $master = db->$ds->find_one({domain=>$domain});     $obj = db->$ds->find_one({login=>$login,master=>$master->{_id},passwd=>$self->{fields}->{passwd}->getAttr('value'),enabled=>1});     $obj->{domain} = $master->{domain} if $obj;      }          unless ($obj){ 	$self->{form_valid} = 0; 	$self->{err_msg} = 'Не удалось выполнить вход. Проверьте ваши учетные данные.';     }     else { 	session user => {source =>'local', %$obj};     }     return $self->{form_valid}; }  

И кусочек превалидации на клиенте

function CheckForm(form){ var alertShown = false; $(form).find('input.required').each(     function(idx,el){         var label = $(el).parentsUntil('control-group')                          .find('span.required')                          .html();         var val = $(el).val();         if($(el).hasClass('ckeditor')){             ed = CKEDITOR.instances[$(el).attr('id')];             val = ed.getData();         }         if(!alertShown&&val==""){             ShowAbsAlert(form,label);             alertShown = true;         }     }); return !alertShown; } 

Может быть, когда-нибудь весь этот код станет частью какого-нибудь фреймворка, а пока это лишь вектор для мыслей тех, кто программирует на Perl для веб.
Если вы дочитали до этого места, спасибо вам за долготерпение при разборе моего кода:)

Автор: Rumka

* - обязательные к заполнению поля


https://ajax.googleapis.com/ajax/libs/jquery/3.4.1/jquery.min.js