Mercurial > pub > Impl
view Lib/Schema/Form.pm @ 81:077357224bec
IMPL::Web::Security alpha version
IMPL::Security improovements
author | Sergey |
---|---|
date | Wed, 07 Apr 2010 14:45:34 +0400 |
parents | 16ada169ca75 |
children |
line wrap: on
line source
package Configuration; our $DataDir; package Schema::Form; use strict; use Storable; use Common; use URI::file; use BNFCompiler; use Schema::Form::Container; use Schema::Form::Field; use Schema::Form::Filter; use Schema::Form::Format; our @ISA = qw(Object); BEGIN { DeclareProperty Name => ACCESS_READ; DeclareProperty Body => ACCESS_READ; } sub CTOR { my ($this,%args) = @_; $this->{$Name} = $args{Name}; } sub SetBody { my ($this, $containerBody) = @_; $this->{$Body} = $containerBody; } sub list { return( map { UNIVERSAL::isa($_,'ARRAY') ? @{$_} : defined $_ ? $_ : () } @_ ); } sub LoadForms { my ($class,$File,$CacheDir,$Encoding) = @_; $Encoding or die new Exception('An encoding must be specified for forms'); my $Compiler = new BNFCompiler(SchemaCache => "${DataDir}Cache/",Transform => sub { BNFCompiler::DOM::TransformDOMToHash(@_,{skip_spaces => 1})} ); $Compiler->LoadBNFSchema(file => 'Schema/form.def'); my %Context = (Compiler => $Compiler, Encoding => $Encoding); $class->ProcessFile(URI::file->new_abs($File),URI::file->new_abs($CacheDir),\%Context); $Compiler->Dispose; return $Context{Forms}; } sub ProcessFile { my ($class,$uriFile,$uriCacheDir,$refContext) = @_; return 1 if $refContext->{'Processed'}{$uriFile->as_string}; $refContext->{'Processed'}{$uriFile->as_string} = 1; my $Data; my $file = $uriFile->file; my $fnameCached = $file; $fnameCached =~ s/[\\\/:]+/_/g; $fnameCached .= '.cfm'; $fnameCached = URI::file->new($fnameCached)->abs($uriCacheDir)->file; if ( -e $fnameCached && -f $fnameCached && ( -M $file >= -M $fnameCached ) ) { $Data = retrieve($fnameCached); } else { my $Compiler = $refContext->{'Compiler'}; local $/ = undef; open my $hfile,"<:encoding($refContext->{Encoding})",$file or die new Exception('Failed to open file',$file); $Data = $Compiler->Parse(<$hfile>); store($Data,$fnameCached); } my $uriDir = URI::file->new('./')->abs($uriFile); my $needRebuild = 0; foreach my $inc (list $Data->{_include}) { $needRebuild ||= $class->ProcessFile(URI::file->new($inc->{file_name})->abs($uriDir),$uriCacheDir,$refContext); } foreach my $use (list $Data->{_use}) { $refContext->{Filters}{$use->{alias}} = { Class => join '', list $use->{mod_name} }; $refContext->{Require}{$use->{mod_name}} = 1; } foreach my $container (list $Data->{container}) { if ($container->{type} eq 'Form') { $class->ConstructForm($container,$refContext); } elsif ($container->{type} eq 'Format') { $class->ConstructFormat($container,$refContext); } elsif ($container->{type} eq 'Filter') { $class->ConstructFilter($container,$refContext); } } } sub ProcessContainer { my ($class,$container,$refContext) = @_; } sub ConstructForm { my ($class,$container,$refContext) = @_; $container->{type} eq 'Form' or die new Exception("Unexpected container type"); not $refContext->{Forms}{$container->{name}} or die new Exception('The form is already exists',$container->{name}); my $Form = new Schema::Form(Name => $container->{name}); $Form->SetBody($class->ConstructGroup($container,$refContext)); $refContext->{Forms}{$Form->Name} = $Form; } sub ConstructGroup { my($class,$container,$refContext) = @_; my $Group = new Schema::Form::Container( Name => $container->{name}, isMulti => ($container->{multi} ? 1 : 0) ); foreach my $child (list $container->{body}{container}) { my $obj; if ($child->{type} eq 'Group') { $obj = $class->ConstructGroup($child,$refContext); } else { $obj = $class->ConstructField($child,$refContext); } $Group->AddChild($obj); } foreach my $filter (list $container->{expression}) { $Group->AddFilter($class->FilterInstance($filter,$refContext,$container->{name})); } foreach my $attr (list $container->{body}{body_property}) { $Group->Attributes->{$attr->{complex_name}} = $class->ScalarExpression($attr->{expression},$container->{name}); } return $Group; } sub ConstructField { my ($class,$container,$refContext) = @_; my $Format = $refContext->{Formats}{$container->{type}} or die new Exception('An undefined format name', $container->{type}); my $Field = Schema::Form::Field->new( Name => $container->{name}, isMulti => ($container->{multi} ? 1 : 0), Format => $Format ); foreach my $filter (list $container->{expression}) { $Field->AddFilter($class->FilterInstance($filter,$refContext,$container->{name})); } foreach my $attr (list $container->{body}{body_property}) { $Field->Attributes->{ref $attr->{complex_name} ? join '', @{$attr->{complex_name}} : $attr->{complex_name}} = $class->ScalarExpression($attr->{expression},$container->{name}); } return $Field; } sub FilterInstance { my ($class,$expr,$refContext,$where) = @_; my $filter = $expr->{instance} or die new Exception('Invalid filter syntax',$where); my $filterClass = $refContext->{Filters}{$filter->{name}}{Class} or die new Exception('Using undefined filter name',$filter->{name},$where); my @Args = map { $class->ScalarExpression($_,$where) } list $filter->{expression}; my $Filter = Schema::Form::Filter->new( Name => $filter->{name}, Class => $filterClass, Args => \@Args ); if ($refContext->{Filters}{$filter->{name}}{Attributes}) { while (my ($name,$value) = each %{$refContext->{Filters}{$filter->{name}}{Attributes}}) { $Filter->Attributes->{$name} = $value; } } return $Filter; } sub ScalarExpression { my ($class,$expr,$where) = @_; my $val; if ($expr->{instance}) { $val = $expr->{instance}{name}; } elsif ($expr->{string}) { $val = join '', list $expr->{string}; $val =~ s/\\(.)/ if ($1 eq '"' or $1 eq '\\') { $1; } else { "\\$1"; } /ge; } elsif ($expr->{number}) { $val = join '', list $expr->{number}; } else { die new Exception('Scalar expression required'); } return $val; } sub ConstructFormat { my ($class,$container,$refContext) = @_; my $Format = Schema::Form::Format->new ( Name => $container->{name} ); foreach my $filter (list $container->{expression}) { $Format->AddFilter($class->FilterInstance($filter,$refContext,$container->{name})); } foreach my $attr (list $container->{body}{body_property}) { $Format->Attributes->{ref $attr->{complex_name} ? join '', @{$attr->{complex_name}} : $attr->{complex_name}} = $class->ScalarExpression($attr->{expression},$container->{name}); } $refContext->{Formats}{$Format->Name} = $Format; } sub ConstructFilter { my ($class,$container,$refContext) = @_; foreach my $attr (list $container->{body}{body_property}) { $refContext->{Filters}{$container->{name}}{Attributes}{ref $attr->{complex_name} ? join '', @{$attr->{complex_name}} : $attr->{complex_name}} = $class->ScalarExpression($attr->{expression},$container->{name}); } } =pod Form schema - описание формы ввода и правила контроля Form instance - значения элементов формы =cut 1;