Mercurial > pub > Impl
diff Lib/Schema/Form.pm @ 49:16ada169ca75
migrating to the Eclipse IDE
author | wizard@linux-odin.local |
---|---|
date | Fri, 26 Feb 2010 10:49:21 +0300 |
parents | 03e58a454b20 |
children |
line wrap: on
line diff
--- a/Lib/Schema/Form.pm Fri Feb 26 01:43:42 2010 +0300 +++ b/Lib/Schema/Form.pm Fri Feb 26 10:49:21 2010 +0300 @@ -1,252 +1,252 @@ -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; +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;