view Lib/Schema/Form.pm @ 84:e568c7c8b743

Minor changes to the test infrastructure
author wizard
date Wed, 14 Apr 2010 17:38:11 +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;