# HG changeset patch # User wizard # Date 1267627218 -10800 # Node ID 609b59c9f03c373ded4b11df61648f06cfe9de94 # Parent f4e045e47770278303f97a611d76f752db7f7ee3 Web application rewrote prop_list implementation to support IMPL::Object::List diff -r f4e045e47770 -r 609b59c9f03c Lib/IMPL/Class/Property/Direct.pm --- a/Lib/IMPL/Class/Property/Direct.pm Tue Mar 02 20:15:57 2010 +0300 +++ b/Lib/IMPL/Class/Property/Direct.pm Wed Mar 03 17:40:18 2010 +0300 @@ -4,6 +4,7 @@ use base qw(IMPL::Object::Accessor Exporter); our @EXPORT = qw(_direct); +require IMPL::Object::List; use IMPL::Class::Property; require IMPL::Exception; @@ -22,17 +23,35 @@ my $accessor_set_no = 'die new IMPL::Exception(\'The property is read only\',$name,$class) unless $set;'; my $accessor_set = 'return( $this->{$field} = @_ == 1 ? $_[0] : [@_] );'; my $accessor_get = 'return( $this->{$field} );'; -my $list_accessor_set = 'return( @{ ($this->{$field} = IMPL::Object::List->new( ( (@_ == 1 and ref $_[0] eq \'ARRAY\') ? $_[0] : [@_] ) || [] ) } );'; -my $list_accessor_get = 'return( @{ $this->{$field} ? $this->{$field} : $this->{$field} = IMPL::Object::List->new() } );'; +my $list_accessor_set = 'return( + wantarray ? + @{ $this->{$field} = IMPL::Object::List->new( + (@_ == 1 and UNIVERSAL::isa($_[0], \'ARRAY\') ) ? $_[0] : [@_] + )} : + ($this->{$field} = IMPL::Object::List->new( + (@_ == 1 and UNIVERSAL::isa($_[0], \'ARRAY\') ) ? $_[0] : [@_] + )) +);'; +my $list_accessor_get = 'return( + wantarray ? + @{ $this->{$field} ? + $this->{$field} : + ( $this->{$field} = IMPL::Object::List->new() ) + } : + ( $this->{$field} ? + $this->{$field} : + ( $this->{$field} = IMPL::Object::List->new() ) + ) +);'; my $custom_accessor_get = 'unshift @_, $this and goto &$get;'; my $custom_accessor_set = 'unshift @_, $this and goto &$set;'; my %accessor_cache; sub mk_acessor { - my ($virtual,$access,$class,$name,$mutators,$field) = @_; + my ($virtual,$access,$class,$name,$mutators,$field,$validator) = @_; my ($get,$set) = ref $mutators ? ( $mutators->{get}, $mutators->{set}) : ($mutators & prop_get, $mutators & prop_set); - my $key = join '',$virtual,$access,$get ? 1 : 0,$set ? 1 : 0, (ref $mutators ? 'c' : ($mutators & prop_list() ? 'l' : 's')); + my $key = join '',$virtual,$access,$get ? 1 : 0,$set ? 1 : 0, (ref $mutators ? 'c' : ($mutators & prop_list() ? 'l' : 's')), $validator ? 1 : 0 ; my $factory = $accessor_cache{$key}; if (not $factory) { my $code = @@ -47,8 +66,10 @@ my \$method = \$this->can(\$name); return \$this->\$method(\@_) unless \$method == \$accessor or caller->isa(\$class); VCALL - $code .= "$access_private\n" if $access == IMPL::Class::Member::MOD_PRIVATE; - $code .= "$access_protected\n" if $access == IMPL::Class::Member::MOD_PROTECTED; + $code .= ' 'x8 . "$access_private\n" if $access == IMPL::Class::Member::MOD_PRIVATE; + $code .= ' 'x8 . "$access_protected\n" if $access == IMPL::Class::Member::MOD_PROTECTED; + $code .= ' 'x8 . '$this->$validator(@_);'."\n" if $validator; + my ($codeGet,$codeSet); if (ref $mutators) { $codeGet = $get ? $custom_accessor_get : $accessor_get_no; @@ -72,23 +93,31 @@ } } END - $factory = eval $code or die new IMPL::Exception('Failed to generate the accessor',$@); + warn $code; + $factory = eval $code; + if (not $factory) { + my $err = $@; + die new IMPL::Exception('Failed to generate the accessor factory',$err); + } $accessor_cache{$key} = $factory; } - return $factory->($class,$name,$set,$get, $field); + + die new IMPL::Exception('Can\'t find the specified validator',$class,$validator) if $validator and ref $validator ne 'CODE' and not $class->can($validator); + + return $factory->($class,$name,$set,$get, $field, $validator); } sub Make { my ($self,$propInfo) = @_; my $isExportField = ref $self ? ($self->ExportField || 0) : 0; - my ($class,$name,$virt,$access,$mutators) = $propInfo->get qw(Class Name Virtual Access Mutators); + my ($class,$name,$virt,$access,$mutators,$attr) = $propInfo->get qw(Class Name Virtual Access Mutators Attributes); (my $field = "${class}_$name") =~ s/::/_/g; my $propGlob = $class.'::'.$name; no strict 'refs'; - *$propGlob = mk_acessor($virt,$access,$class,$name,$mutators,$field); + *$propGlob = mk_acessor($virt,$access,$class,$name,$mutators,$field,$attr->{validator}); *$propGlob = \$field if $isExportField; if (ref $mutators) { diff -r f4e045e47770 -r 609b59c9f03c Lib/IMPL/Web/Application/Action.pm --- a/Lib/IMPL/Web/Application/Action.pm Tue Mar 02 20:15:57 2010 +0300 +++ b/Lib/IMPL/Web/Application/Action.pm Wed Mar 03 17:40:18 2010 +0300 @@ -1,4 +1,5 @@ package IMPL::Web::Application::Action; +use strict; use base qw(IMPL::Object); @@ -8,8 +9,39 @@ public property application => prop_get | owner_set; public property request => prop_get | owner_set; public property response => prop_get | owner_set; - public property code => prop_get | owner_set; - public property chainHandlers => prop_get | owner_set | prop_list; + + private property _entryPoint => prop_all; +} + +sub Invoke { + my ($this) = @_; + + if ($this->_entryPoint) { + $this->_entryPoint->(); + } else { + die new IMPL::InvalidOperationException("At least one handler is required"); + } +} + +sub ChainHandler { + my ($this,$handler) = @_; + + my $delegate; + + my $delegateNext = $this->_entryPoint(); + + if (ref $handler eq 'CODE') { + $delegate = sub { + $handler->($this,$delegateNext); + }; + } elsif (UNIVERSAL::isa($handler,'IMPL::Web::Application::QueryHandler')) { + $delegate = sub { + $handler->Invoke($this,$delegateNext); + } + } else { + die new IMPL::InvalidArgumentException("An invalid handler supplied"); + } + } 1; diff -r f4e045e47770 -r 609b59c9f03c Lib/IMPL/Web/Response.pm --- a/Lib/IMPL/Web/Response.pm Tue Mar 02 20:15:57 2010 +0300 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,58 +0,0 @@ -package IMPL::Web::Response; - -use base qw(IMPL::Object); - -require IMPL::Exception; - -use IMPL::Class::Property; -use HTTP::Response; - -BEGIN { - public property request => prop_get; # cgi query - public property contentType => prop_all, { validator => \&_checkHeaderPrinted }; # String - public property buffered => prop_get; # Boolean - public property cookies => prop_all, { validator => \&_checkHeaderPrinted }; # Hash - public property streamBody => { get => \&getStreamBody }; # stream - - private property _streamBody => prop_all; # stream - private property _streamOut => prop_all; # stream - private property _isHeaderPrinted => prop_all; # Boolean -} - -sub _checkHeaderPrinted { - my ($this,$value) = @_; - - die new IMPL::InvalidOperationException() if $this->_isHeaderPrinted; -} - -sub getStreamBody { - my ($this) = @_; - - return $this->_streamBody if $this->buffered; - - -} - -sub _PrintHeader { - my ($this) = @_; - - unless ($this->_isHeaderPrinted) { - $this->_isHeaderPrinted(1); - - - } -} - -sub Send { - -} - -1; - -__END__ - -=pod - - - -=cut \ No newline at end of file