Mercurial > pub > Impl

changeset 55:609b59c9f03c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Web application rewrote prop_list implementation to support IMPL::Object::List
author wizard
date Wed, 03 Mar 2010 17:40:18 +0300
parents f4e045e47770
children 117b6956d5a5
files Lib/IMPL/Class/Property/Direct.pm Lib/IMPL/Web/Application/Action.pm Lib/IMPL/Web/Response.pm
diffstat 3 files changed, 73 insertions(+), 70 deletions(-) [+]
line wrap: on
line diff
--- 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) {
--- 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;
--- 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