--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/Schema/Form.pm	Tue Jul 14 12:54:37 2009 +0400
@@ -0,0 +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;