changeset 59:0f3e369553bd

Rewritten property implementation (probably become slower but more flexible) Configuration infrastructure in progress (in the aspect of the lazy activation) Initial concept for the code generator
author wizard
date Tue, 09 Mar 2010 02:50:45 +0300 (2010-03-08)
parents a35b60b16a99
children b0c068da93ac
files Lib/DOM/Providers/Headlines.pm Lib/IMPL/Class/MemberInfo.pm Lib/IMPL/Class/Property.pm Lib/IMPL/Class/Property/Base.pm Lib/IMPL/Class/Property/Direct.pm Lib/IMPL/Code/Generator.pm Lib/IMPL/Code/MethodFactory.pm Lib/IMPL/Config/Activator.pm Lib/IMPL/Config/Container.pm Lib/IMPL/Config/Link.pm Lib/IMPL/Web/Application.pm Lib/IMPL/Web/Application/Response.pm Lib/IMPL/Web/Response.pm _test/wmi.pl
diffstat 14 files changed, 537 insertions(+), 473 deletions(-) [+]
line wrap: on
line diff
--- a/Lib/DOM/Providers/Headlines.pm	Fri Mar 05 20:14:45 2010 +0300
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,128 +0,0 @@
-package DOM::Providers::Headlines::Headline;
-use Common;
-use Time::Local;
-our @ISA = qw(Object);
-
-BEGIN {
-    DeclareProperty(Id => ACCESS_READ);
-    DeclareProperty(DateModify => ACCESS_READ);
-    DeclareProperty(DateExpire => ACCESS_READ);
-    DeclareProperty(URL => ACCESS_READ);
-    DeclareProperty(Text => ACCESS_READ);
-    DeclareProperty(Channel => ACCESS_READ);
-}
-
-sub str2time {
-    my $str = shift;
-    
-    if ($str =~ /^(\d{4})-(\d{2})-(\d{2})(?:\s(\d{2}):(\d{2}):(\d{2}))?$/) {
-        my ($year,$month,$day,$hh,$mm,$ss) = ($1,$2-1,$3,(defined $4 ? $4 : 0),(defined $5 ? $5 : 0),(defined $6 ? $6 : 0));
-        return timelocal($ss,$mm,$hh,$day,$month,$year);
-    } else {
-        die new Exception("A string '$str' isn't an ISO standard time");
-    }
-}
-
-sub IsActive {
-    my ($this) = @_;
-    my $timeExpire = str2time($this->{$DateExpire});
-
-    return ($timeExpire > time());
-}
-
-package DOM::Providers::Headlines::Collection;
-use Common;
-our @ISA = qw (Object);
-
-BEGIN {
-    DeclareProperty(Items => ACCESS_READ);
-}
-
-sub CTOR {
-    my ($this,%args) = @_;
-
-    foreach my $headline (@{$args{'Items'}}) {
-        $this->{$Items}->{$headline->Id()} = $headline if ($headline->IsActive)
-    }
-}
-
-sub as_list {
-    my $this = shift;
-
-    return [ map { $this->{$Items}->{$_} } sort keys %{$this->{$Items}} ];
-}
-
-sub GenerateRandomSequence {
-    my ($count,$max) = @_;
-
-    my %hash;
-    $hash{rand()} = $_ foreach (0 .. $max - 1);
-    my @sequence = map { $hash{$_} } sort keys %hash;
-    return splice @sequence,0,$count;
-}
-
-sub Random {
-    my ($this,$count) = @_;
-
-    my $list = $this->as_list();
-    
-    return [map { $list->[$_] } GenerateRandomSequence($count,scalar(@$list))];
-}
-
-sub Recent {
-    my ($this,$count) = @_;
-    
-    my @result = sort { $b->DateModify() cmp $a->DateModify() } values %{$this->{$Items}};
-    splice @result,$count;
-    
-    return \@result;
-}
-
-sub AddItem {
-    my ($this,$newItem) = @_;
-    
-    $this->{$Items}->{$newItem->Id()} = $newItem;
-}
-
-package DOM::Providers::Headlines;
-use Common;
-use ObjectStore::Headlines;
-
-our $DBPath;
-our $Encoding;
-
-my %Channels;
-
-eval {
-    LoadHeadlines();
-};
-
-if ($@) {
-    my $err = $@;
-    if (ref $err eq 'Exception') {
-        die $err->ToString();
-    } else {
-        die $err;
-    }
-}
-
-
-sub GetProviderInfo {
-    return {
-        Name => 'Headlines',
-        Host => 'DOM::Site',
-        Objects => \%Channels
-    }
-}
-
-sub LoadHeadlines {
-    my $dsHeadlines = new ObjectStore::Headlines(DBPath => $DBPath, HeadlineClass => 'DOM::Providers::Headlines::Headline', Encoding => $Encoding);
-    
-    foreach my $headline (@{$dsHeadlines->Search(Filter => sub { return $_[0]->IsActive(); } )}) {
-        my $channel = $headline->Channel() || 'main';
-        $Channels{$channel} = new DOM::Providers::Headlines::Collection() if not exists $Channels{$channel};
-        $Channels{$channel}->AddItem($headline);
-    }
-}
-
-1;
--- a/Lib/IMPL/Class/MemberInfo.pm	Fri Mar 05 20:14:45 2010 +0300
+++ b/Lib/IMPL/Class/MemberInfo.pm	Tue Mar 09 02:50:45 2010 +0300
@@ -24,6 +24,7 @@
     die new IMPL::Exception('The name is required for the member') unless $this->Name;
     die new IMPL::Exception('The class is required for the member') unless $this->Class;
     
+    $this->Attributes({}) unless defined $this->Attributes;
     $this->Frozen(0);
     $this->Virtual(0) unless defined $this->Virtual;
     $this->Access(3) unless $this->Access;
@@ -40,7 +41,7 @@
 sub set {
     my $this = shift;
     if ($this->Frozen) {
-        die new IMPL::Exception('The member information can\'t be modified', $this->Name);
+        die new IMPL::Exception('The member information is frozen', $this->Name);
     }
     $this->SUPER::set(@_);
 }
--- a/Lib/IMPL/Class/Property.pm	Fri Mar 05 20:14:45 2010 +0300
+++ b/Lib/IMPL/Class/Property.pm	Tue Mar 09 02:50:45 2010 +0300
@@ -15,7 +15,7 @@
 
 sub prop_get { 1 };
 sub prop_set { 2 };
-sub owner_set { 2 };
+sub owner_set { 10 };
 sub prop_none { 0 };
 sub prop_all { 3 };
 sub prop_list { 4 };
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Class/Property/Base.pm	Tue Mar 09 02:50:45 2010 +0300
@@ -0,0 +1,190 @@
+package IMPL::Class::Property::Base;
+use strict;
+
+use IMPL::Class::Property;
+
+require IMPL::Class::Member;
+
+our @factoryParams = qw($class $name $set $get $validator);
+
+my %factoryCache;
+
+my $accessor_get_no = 'die new IMPL::Exception(\'The property is write only\',$name,$class) unless $get;';
+my $accessor_set_no = 'die new IMPL::Exception(\'The property is read only\',$name,$class) unless $set;';
+
+my $custom_accessor_get = 'unshift @_, $this and goto &$get;';
+my $custom_accessor_set = 'unshift @_, $this and goto &$set;';
+
+my $validator_code = '$this->$validator(@_);'; 
+
+my %access_code = (
+	IMPL::Class::Member::MOD_PUBLIC , "",
+	IMPL::Class::Member::MOD_PROTECTED, "die new IMPL::Exception('Can\\'t access the protected member',\$name,\$class,scalar caller) unless UNIVERSAL::isa(scalar caller,\$class);",
+	IMPL::Class::Member::MOD_PRIVATE, "die new IMPL::Exception('Can\\'t access the private member',\$name,\$class,scalar caller) unless caller eq \$class;" 
+);
+
+my $virtual_call = q(
+		my $method = $this->can($name);
+        return $this->$method(@_) unless $method == $accessor or caller->isa($class);
+);
+
+my $owner_check = "die new IMPL::Exception('Set accessor is restricted to the owner',\$name,\$class,scalar caller) unless caller eq \$class;";
+
+sub GenerateAccessors {
+	my ($self,$param,@params) = @_;
+	
+	my %accessors;
+	
+	if (not ref $param) {
+		if ($param & prop_list) {
+			$accessors{get} = ($param & prop_get) ? $self->GenerateGetList(@params) : $accessor_get_no;
+			$accessors{set} = ($param & prop_set) ? $self->GenerateSetList(@params) : $accessor_set_no;
+		} else {
+			$accessors{get} = ($param & prop_get) ? $self->GenerateGet(@params) : $accessor_get_no;
+			$accessors{set} = ($param & prop_set) ? $self->GenerateSet(@params) : $accessor_set_no;
+		}
+		$accessors{owner} = (($param & owner_set) == owner_set) ? $owner_check : "";
+	} elsif (UNIVERSAL::isa($param,'HASH')) {
+		$accessors{get} = $param->{get} ? $custom_accessor_get : $accessor_get_no;
+		$accessors{set} = $param->{set} ? $custom_accessor_set : $accessor_set_no;
+		$accessors{owner} = "";
+	} else {
+		die new IMPL::Exception('The unsupported accessor/mutators supplied',$param);
+	}
+	
+	return \%accessors;
+}
+
+sub GenerateSet {
+	die new IMPL::Exception("Standard accessors not supported");
+}
+	
+sub GenerateGet {
+	die new IMPL::Exception("Standard accessors not supported");
+}
+
+sub GenerateGetList {
+	die new IMPL::Exception("Standard accessors not supported");
+}
+
+sub GenerateSetList {
+	my ($self) = @_;
+	die new IMPL::Exception("Standard accessors not supported");
+}
+
+sub Make {
+	my ($self,$propInfo) = @_;
+	
+	my $key = $self->MakeFactoryKey($propInfo);
+	
+	my $factory = $factoryCache{$key};
+	
+	unless ($factory) {
+		my $mutators = $self->GenerateAccessors($propInfo->Mutators);
+		$factory = $self->CreateFactory(
+			$access_code{ $propInfo->Access },
+			$propInfo->Attributes->{validator} ? $validator_code : "",
+			$mutators->{owner},
+			$mutators->{get},
+			$mutators->{set}
+		);
+		$factoryCache{$key} = $factory; 
+	}
+	
+	{
+		no strict 'refs';
+		*{ $propInfo->Class.'::'.$propInfo->Name } = &$factory($self->RemapFactoryParams($propInfo));
+	}
+	
+	my $mutators = $propInfo->Mutators;
+	
+	if (ref $mutators) {
+		$propInfo->canGet( $mutators->{get} ? 1 : 0 );
+		$propInfo->canSet( $mutators->{set} ? 1 : 0 );
+	} else {
+		$propInfo->canGet( $mutators & prop_get );
+		$propInfo->canSet( $mutators & prop_set );
+	}
+}
+
+# extract from property info: class, name, get_accessor, set_accessor, validator
+sub RemapFactoryParams {
+	my ($self,$propInfo) = @_;
+	
+	my $mutators = $propInfo->Mutators;
+	my $class = $propInfo->Class;
+	my $validator = $propInfo->Attributes->{validator};
+	
+	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 (
+		$propInfo->get(qw(Class Name)),
+		(ref $mutators?
+			($mutators->{set},$mutators->{get})
+			:
+			(undef,undef)
+		),
+		$validator
+	);
+}
+
+sub MakeFactoryKey {
+	my ($self,$propInfo) = @_;
+	
+	my ($access,$mutators,$validator) = ($propInfo->get(qw(Access Mutators)),$propInfo->Attributes->{validator});
+	
+	return join ('',
+		$access,
+		$validator ? 'v' : 'n',
+		ref $mutators ?
+			('c' , $mutators->{get} ? 1 : 0, $mutators->{set} ? 1 : 0)
+			:
+			(($mutators & prop_list) ? 'l' : 's' , ($mutators & prop_get) ? 1 : 0, ($mutators & prop_set) ? ((($mutators & owner_set) == owner_set) ? 2 : 1 ) : 0 ) 
+	); 
+}
+
+sub CreateFactory {
+	my ($self,$codeAccessCheck,$codeValidator,$codeOwnerCheck,$codeGet,$codeSet) = @_;
+	
+	my $strParams = join(',',@factoryParams);
+	
+	my $factory = <<FACTORY;
+	
+sub {
+    my ($strParams) = \@_;
+    my \$accessor;
+    \$accessor = sub {
+        my \$this = shift;
+        $codeAccessCheck
+        $codeValidator
+        if (\@_) {
+        	$codeOwnerCheck
+        	$codeSet
+        } else {
+        	$codeGet
+        }
+    }
+}
+FACTORY
+
+	return ( eval $factory or die new IMPL::Exception("Syntax error due compiling the factory","$@") );
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 DESCRIPTION
+
+������� ����� ��� ���������� �������.
+
+�� �������� �������� ������� �� ���� ������� ��� ��������� � ��������� ��������. �����
+���������� ��������� ��������� ������� � ��������, � ����� ����������� ��������. ���
+�������� ����� ���� ������������.
+
+��� �������� ����������� ������� ���������� ������������ �� ����� ������ � �������
+������ ��� ��������� ���� ��������� � ��������� ��������. 
+
+=cut
\ No newline at end of file
--- a/Lib/IMPL/Class/Property/Direct.pm	Fri Mar 05 20:14:45 2010 +0300
+++ b/Lib/IMPL/Class/Property/Direct.pm	Tue Mar 09 02:50:45 2010 +0300
@@ -1,7 +1,7 @@
 package IMPL::Class::Property::Direct;
 use strict;
 
-use base qw(IMPL::Object::Accessor Exporter);
+use base qw(IMPL::Object::Accessor IMPL::Class::Property::Base Exporter);
 our @EXPORT = qw(_direct);
 
 require IMPL::Object::List;
@@ -10,123 +10,67 @@
 
 __PACKAGE__->mk_accessors qw(ExportField);
 
+push @IMPL::Class::Property::Base::factoryParams, qw($field);
+
 sub _direct($) {
     my ($prop_info) = @_;
     $prop_info->Implementor( IMPL::Class::Property::Direct->new({ExportField => 1}) );
     return $prop_info;
 }
 
-my $access_private = "die new IMPL::Exception('Can\\'t access the private member',\$name,\$class,scalar caller) unless caller eq \$class;";
-my $access_protected = "die new IMPL::Exception('Can\\'t access the protected member',\$name,\$class,scalar caller) unless caller eq \$class;";
 
-my $accessor_get_no = 'die new IMPL::Exception(\'The property is write only\',$name,$class) unless $get;';
-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(
-	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;';
+sub GenerateGet {
+	'return ($this->{$field});';
+}
+
+sub GenerateSet {
+	'return ($this->{$field} = $_[0])';
+}
 
-my %accessor_cache;
-sub mk_acessor {
-    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')), $validator ? 1 : 0 ;
-    my $factory = $accessor_cache{$key};
-    if (not $factory) {
-        my $code =
-<<BEGIN;
-sub {
-    my (\$class,\$name,\$set,\$get,\$field) = \@_;
-    my \$accessor;
-    \$accessor = sub {
-        my \$this = shift;
-BEGIN
-        $code .= <<VCALL if $virtual;
-        my \$method = \$this->can(\$name);
-        return \$this->\$method(\@_) unless \$method == \$accessor or caller->isa(\$class);
-VCALL
-        $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;
-            $codeSet = $set ? $custom_accessor_set : $accessor_set_no;
-        } else {
-            if ($mutators & prop_list) {
-                $codeGet = $get ? $list_accessor_get : $accessor_get_no;
-                $codeSet = $set ? $list_accessor_set : $accessor_set_no;
-            } else {
-                $codeGet = $get ? $accessor_get : $accessor_get_no;
-                $codeSet = $set ? $accessor_set : $accessor_set_no;
-            }
-        }
-        $code .=
-<<END;
-        if (\@_) {
-            $codeSet    
-        } else {
-            $codeGet
-        }
-    }
+sub GenerateSetList {
+	'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] : [@_]  
+		))
+	);';
 }
-END
-		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;
-    }
-    
-    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 GenerateGetList {
+	'return(
+		wantarray ?
+		@{ $this->{$field} ?
+			$this->{$field} :
+			( $this->{$field} = IMPL::Object::List->new() )
+		} :
+		( $this->{$field} ?
+			$this->{$field} :
+			( $this->{$field} = IMPL::Object::List->new() )
+		)
+	);';
+}
+
+sub RemapFactoryParams {
+	my ($self,$propInfo) = @_;
+	
+	return $self->SUPER::RemapFactoryParams($propInfo),$self->FieldName($propInfo);
 }
 
 sub Make {
-    my ($self,$propInfo) = @_;
-    
-    my $isExportField = ref $self ? ($self->ExportField || 0) : 0;
-    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,$attr->{validator});
-    *$propGlob = \$field if $isExportField;
-    
-    if (ref $mutators) {
-        $propInfo->canGet( $mutators->{get} ? 1 : 0);
-        $propInfo->canSet( $mutators->{set} ? 1 : 0);
-    } else {
-        $propInfo->canGet( ($mutators & prop_get) ? 1 : 0);
-        $propInfo->canSet( ($mutators & prop_set) ? 1 : 0);
-    }
+	my ($self,$propInfo) = @_;
+	
+	$self->SUPER::Make($propInfo);
+	
+	{
+		no strict 'refs';
+		if (ref $self and $self->ExportField) {
+			my $field = $self->FieldName($propInfo);
+			*{$propInfo->Class.'::'.$propInfo->Name} = \$field;
+		}
+	}
 }
 
 sub FieldName {
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Code/Generator.pm	Tue Mar 09 02:50:45 2010 +0300
@@ -0,0 +1,4 @@
+package IMPL::Code::Generator;
+use strict;
+
+1;
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Code/MethodFactory.pm	Tue Mar 09 02:50:45 2010 +0300
@@ -0,0 +1,4 @@
+package IMPL::Code::MethodFactory;
+use strict;
+
+1;
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Config/Activator.pm	Tue Mar 09 02:50:45 2010 +0300
@@ -0,0 +1,43 @@
+package IMPL::Config::Activator;
+use strict;
+
+use base qw(IMPL::Object IMPL::Object::Autofill);
+use IMPL::Class::Property;
+
+BEGIN {
+	public property factory => prop_all;
+	public property args => prop_all;
+	private property _object => prop_all;
+}
+
+__PACKAGE__->PassThroughArgs;
+
+sub CTOR {
+    my $this = shift;
+    
+    die new IMPL::Exception("A Type parameter is required") unless $this->Type;
+    
+}
+
+sub _is_class {
+    no strict 'refs';
+    scalar keys %{"$_[0]::"} ? 1 : 0;
+}
+
+sub instance {
+    my $this = shift;
+    
+    my $factory = $this->fatory;
+    
+    if (my $obj = $this->_object) {
+        return $obj;
+    } else {
+        my %args = (%{$this->args || {}},@_);
+        eval "require $factory" unless not ref $factory and _is_class($factory);
+        my $inst = $factory->new(%args);
+        $this->_object($inst);
+        return $inst;
+    }
+}
+
+1;
\ No newline at end of file
--- a/Lib/IMPL/Config/Container.pm	Fri Mar 05 20:14:45 2010 +0300
+++ b/Lib/IMPL/Config/Container.pm	Tue Mar 09 02:50:45 2010 +0300
@@ -30,7 +30,7 @@
     (my $prop = $AUTOLOAD) =~ s/.*?(\w+)$/$1/;
     
     my $child = $this->Chidren->{$prop};
-    if (ref $child and $child->isa('IMPL::Config::Class')) {
+    if (UNIVERSAL::isa($child,'IMPL::Config::Class')) {
         return $child->instance(@_);
     } else {
         return $child;
--- a/Lib/IMPL/Config/Link.pm	Fri Mar 05 20:14:45 2010 +0300
+++ b/Lib/IMPL/Config/Link.pm	Tue Mar 09 02:50:45 2010 +0300
@@ -11,12 +11,17 @@
 	return ${$_[0]} = ${$_[0]}->instance() if UNIVERSAL::isa(${$_[0]},'IMPL::Config::Activator');
 }
 
+sub surrogate {
+	die new IMPL::Exception("You can't create a forward declarations of the link");
+}
+
 sub restore {
 	my ($self,$data,$surrogate) = @_;
-	
+
 	my %args = @$data;
 	
 	die new IMPL::Exception('A target is required for the link') unless exists $args{target};
-	
-	return $self->new($args{target});
+	my $val;
+	tie $val, $self, $args{target};
+	return $val;
 }
\ No newline at end of file
--- a/Lib/IMPL/Web/Application.pm	Fri Mar 05 20:14:45 2010 +0300
+++ b/Lib/IMPL/Web/Application.pm	Tue Mar 09 02:50:45 2010 +0300
@@ -13,7 +13,7 @@
 BEGIN {
     public property handlerError => prop_all;
     public property factoryAction => prop_all;
-    public property handlersQuery => prop_all;
+    public property handlersQuery => prop_all | prop_list;
 }
 
 # custom factory
@@ -60,7 +60,7 @@
 =head1 SYNOPSIS
 
 require MyApp;
-MyApp->instance('app.config')->Run();
+MyApp->spawn('app.config')->Run();
 
 =head1 DESCRIPTION
 
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Web/Application/Response.pm	Tue Mar 09 02:50:45 2010 +0300
@@ -0,0 +1,230 @@
+package IMPL::Web::Application::Response;
+use strict;
+
+use base qw(IMPL::Object IMPL::Object::Autofill);
+
+require IMPL::Exception;
+require CGI;
+require CGI::Cookie;
+
+use Carp;
+use IMPL::Class::Property;
+
+BEGIN {
+	public property query => prop_get | owner_set; # cgi query
+	public property status => prop_all, { validator => \&_checkHeaderPrinted };
+	public property contentType => prop_all, { validator => \&_checkHeaderPrinted }; # String
+	public property charset => { get => \&_charset, set => \&_charset }, { validator => \&_checkHeaderPrinted };
+	public property expires => prop_all, { validator => \&_checkHeaderPrinted };
+	public property cookies => prop_all, { validator => \&_checkHeaderPrinted }; # Hash
+	
+	public property buffered => prop_all, { validator => \&_canChangeBuffer }; # Boolean
+	public property streamOut => prop_get | owner_set; # stream
+	public property streamBody => {get => \&getStreamBody }; # stream
+	public property isHeaderPrinted => prop_get | owner_set; # Boolean 
+	
+	private property _bufferBody => prop_all;
+	private property _streamBody => prop_all;
+}
+
+__PACKAGE__->PassThroughArgs;
+
+sub CTOR {
+	my ($this,%args) = @_;
+	
+	$this->query(CGI->new($this->query() | {})) unless $this->query;
+	$this->charset($this->query->charset) unless $this->charset;
+	
+	$this->streamOut(*STDOUT) unless $this->streamOut;
+}
+
+sub _checkHeaderPrinted {
+	my ($this,$value) = @_;
+	
+	die new IMPL::InvalidOperationException() if $this->isHeaderPrinted;
+}
+
+sub _canChangeBuffer {
+	my ($this,$value) = @_;
+	
+	die new IMPL::InvalidOperationException() if $this->isHeaderPrinted or $this->_streamBody;
+}
+
+sub _charset {
+	my $this = shift;
+	
+	return $this->query->charset(@_);
+}
+
+sub _PrintHeader {
+	my ($this) = @_;
+	
+	unless ($this->isHeaderPrinted) {
+		$this->isHeaderPrinted(1);
+		
+		my %opt;
+		
+		$opt{-type} = $this->contentType if $this->contentType;
+		$opt{-status} = $this->status if $this->status;
+		$opt{-expires} = $this->expires if $this->expires;
+		
+		my $refCookies = $this->cookies;
+		$opt{-cookie} = [map CGI::Cookie->new(-name => $_, $refCookies->{$_} ), keys %$refCookies] if $refCookies;
+		
+		my $hOut = $this->streamOut;
+		
+		print $hOut $this->query->header(
+			%opt
+		);
+	}
+}
+
+sub getStreamBody {
+	my ($this) = @_;
+	
+	return undef unless $this->streamOut;
+	
+	unless ($this->_streamBody) {
+		if ($this->buffered) {
+			my $buffer = "";
+			$this->_bufferBody(\$buffer);
+				
+			open my $hBody, ">", \$buffer or die new IMPL::Exception("Failed to create buffer",$!);
+				
+			$this->_streamBody($hBody);
+		} else {
+			$this->_PrintHeader();
+			$this->_streamBody($this->streamOut);
+		}
+	}
+		
+	return $this->_streamBody;
+}
+
+sub Complete {
+	my ($this) = @_;
+	
+	return 0 unless $this->streamOut;
+	
+	my $hOut = $this->streamOut;
+	
+	$this->_PrintHeader();
+	
+	if ($this->buffered) {
+		print $hOut ${$this->_bufferBody};	
+	}
+	
+	$this->_streamBody(undef);
+	$this->_bufferBody(undef);
+	$this->streamOut(undef);
+	
+	return 1;
+}
+
+sub Discard {
+	my ($this) = @_;
+	
+	carp "Discarding sent response" if $this->isHeaderPrinted;
+	
+	$this->_streamBody(undef);
+	$this->_bufferBody(undef);
+	$this->streamOut(undef);
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 DESCRIPTION
+
+����� ������� �� CGI ������, ��������� ������������ �������� �������� ��������� � ���� �������.
+
+������ ��������� ��������������� ����� � ���� ������, ��� ��������� �������� ��� ��������
+����� � ��������� ������.
+
+�������� C< isHeaderPrinted > ����� ������������ ��� ����������� ���� �� ���������� �����-������
+������ �������. 
+
+=head1 PROPERTIES
+
+=head2 HTTP Header
+
+�������� ���������� �� ��������� HTTP ������. ��� ������� ����� ���� �������� �� ��� ��� ����
+�� ����� ��������� ���������. � ��������� ������ �������� ���������� C< IMPL::InvalidOperationException >.
+
+=over
+
+=item C< query >
+
+CGI ������, ������� ������������ ��� ������ ������, ��������� � ��. ���������� ������.
+
+=item C< status >
+
+��� ������ HTTP. ��������, '200 OK'. �� ��������� �� ����������, ��� �������� ������� ���� ��������� '200 ��'.
+
+=item C< contentType >
+
+��� MIME. �� ��������� �� ����������, ��������������� 'text/html'.
+
+=item C< charset >
+
+���������, ������� �������� query->charset.
+
+=item C< expires >
+
+���������� ����� ����� ��������, �������� '+10m'. �� ��������� �� ������ � �� ����������.
+
+=item C< cookies >
+
+��� ������ � cookies, �������� C< { cart => ['foo','bar'], display => 'list' } >.
+
+=back
+
+=head2 Response behaviour
+
+�������� ���������� �� ��������� ������.
+
+=over
+
+=item C< buffered >
+
+C< True > - �� ���� ������ ������� � ������ � ����� ���������� ��� ������ ������ C< Complete >,
+��������� ����� ����� ��������� ����� ������ ������ C< Complete >. 
+
+C< False > - ���� ������ ������� ��������������� � ����� � �������, ��� ���� ���������
+����� ��������� ��� ������ ��������� � �������� C< streamBody >
+
+��� �������� ����� ������ �� ������� ��������� � ������ ��� ������ � ���� ������.
+
+=item C< streamOut >
+
+����������� ����� CGI ����������.
+
+=item C< streamBody >
+
+����� ��� ������ � ���� ������.
+
+=item C< isHeadPrinted >
+
+������� ����, ��� ��������� ��� ��� ��������� �������.
+
+=back
+
+=head1 METHODS
+
+=over
+
+=item C< Complete >
+
+��������� �������� ������.
+
+=item C< Discard >
+
+�������� �������� ������, ��� ���� ���� ����� ������ (��������, ���������)
+��� ���� ����������, ������ �������������� � STDERR.
+
+=back
+
+=cut
\ No newline at end of file
--- a/Lib/IMPL/Web/Response.pm	Fri Mar 05 20:14:45 2010 +0300
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,230 +0,0 @@
-package IMPL::Web::Response;
-use strict;
-
-use base qw(IMPL::Object IMPL::Object::Autofill);
-
-require IMPL::Exception;
-require CGI;
-require CGI::Cookie;
-
-use Carp;
-use IMPL::Class::Property;
-
-BEGIN {
-	public property query => prop_get | owner_set; # cgi query
-	public property status => prop_all, { validator => \&_checkHeaderPrinted };
-	public property contentType => prop_all, { validator => \&_checkHeaderPrinted }; # String
-	public property charset => { get => \&_charset, set => \&_charset }, { validator => \&_checkHeaderPrinted };
-	public property expires => prop_all, { validator => \&_checkHeaderPrinted };
-	public property cookies => prop_all, { validator => \&_checkHeaderPrinted }; # Hash
-	
-	public property buffered => prop_all, { validator => \&_canChangeBuffer }; # Boolean
-	public property streamOut => prop_get | owner_set; # stream
-	public property streamBody => {get => \&getStreamBody }; # stream
-	public property isHeaderPrinted => prop_get | owner_set; # Boolean 
-	
-	private property _bufferBody => prop_all;
-	private property _streamBody => prop_all;
-}
-
-__PACKAGE__->PassThroughArgs;
-
-sub CTOR {
-	my ($this,%args) = @_;
-	
-	$this->query(CGI->new($this->query() | {})) unless $this->query;
-	$this->charset($this->query->charset) unless $this->charset;
-	
-	$this->streamOut(*STDOUT) unless $this->streamOut;
-}
-
-sub _checkHeaderPrinted {
-	my ($this,$value) = @_;
-	
-	die new IMPL::InvalidOperationException() if $this->isHeaderPrinted;
-}
-
-sub _canChangeBuffer {
-	my ($this,$value) = @_;
-	
-	die new IMPL::InvalidOperationException() if $this->isHeaderPrinted or $this->_streamBody;
-}
-
-sub _charset {
-	my $this = shift;
-	
-	return $this->query->charset(@_);
-}
-
-sub _PrintHeader {
-	my ($this) = @_;
-	
-	unless ($this->isHeaderPrinted) {
-		$this->isHeaderPrinted(1);
-		
-		my %opt;
-		
-		$opt{-type} = $this->contentType if $this->contentType;
-		$opt{-status} = $this->status if $this->status;
-		$opt{-expires} = $this->expires if $this->expires;
-		
-		my $refCookies = $this->cookies;
-		$opt{-cookie} = [map CGI::Cookie->new(-name => $_, $refCookies->{$_} ), keys %$refCookies] if $refCookies;
-		
-		my $hOut = $this->streamOut;
-		
-		print $hOut $this->query->header(
-			%opt
-		);
-	}
-}
-
-sub getStreamBody {
-	my ($this) = @_;
-	
-	return undef unless $this->streamOut;
-	
-	unless ($this->_streamBody) {
-		if ($this->buffered) {
-			my $buffer = "";
-			$this->_bufferBody(\$buffer);
-				
-			open my $hBody, ">", \$buffer or die new IMPL::Exception("Failed to create buffer",$!);
-				
-			$this->_streamBody($hBody);
-		} else {
-			$this->_PrintHeader();
-			$this->_streamBody($this->streamOut);
-		}
-	}
-		
-	return $this->_streamBody;
-}
-
-sub Complete {
-	my ($this) = @_;
-	
-	return 0 unless $this->streamOut;
-	
-	my $hOut = $this->streamOut;
-	
-	$this->_PrintHeader();
-	
-	if ($this->buffered) {
-		print $hOut ${$this->_bufferBody};	
-	}
-	
-	$this->_streamBody(undef);
-	$this->_bufferBody(undef);
-	$this->streamOut(undef);
-	
-	return 1;
-}
-
-sub Discard {
-	my ($this) = @_;
-	
-	carp "Discarding sent response" if $this->isHeaderPrinted;
-	
-	$this->_streamBody(undef);
-	$this->_bufferBody(undef);
-	$this->streamOut(undef);
-}
-
-1;
-
-__END__
-
-=pod
-
-=head1 DESCRIPTION
-
-����� ������� �� CGI ������, ��������� ������������ �������� �������� ��������� � ���� �������.
-
-������ ��������� ��������������� ����� � ���� ������, ��� ��������� �������� ��� ��������
-����� � ��������� ������.
-
-�������� C< isHeaderPrinted > ����� ������������ ��� ����������� ���� �� ���������� �����-������
-������ �������. 
-
-=head1 PROPERTIES
-
-=head2 HTTP Header
-
-�������� ���������� �� ��������� HTTP ������. ��� ������� ����� ���� �������� �� ��� ��� ����
-�� ����� ��������� ���������. � ��������� ������ �������� ���������� C< IMPL::InvalidOperationException >.
-
-=over
-
-=item C< query >
-
-CGI ������, ������� ������������ ��� ������ ������, ��������� � ��. ���������� ������.
-
-=item C< status >
-
-��� ������ HTTP. ��������, '200 OK'. �� ��������� �� ����������, ��� �������� ������� ���� ��������� '200 ��'.
-
-=item C< contentType >
-
-��� MIME. �� ��������� �� ����������, ��������������� 'text/html'.
-
-=item C< charset >
-
-���������, ������� �������� query->charset.
-
-=item C< expires >
-
-���������� ����� ����� ��������, �������� '+10m'. �� ��������� �� ������ � �� ����������.
-
-=item C< cookies >
-
-��� ������ � cookies, �������� C< { cart => ['foo','bar'], display => 'list' } >.
-
-=back
-
-=head2 Response behaviour
-
-�������� ���������� �� ��������� ������.
-
-=over
-
-=item C< buffered >
-
-C< True > - �� ���� ������ ������� � ������ � ����� ���������� ��� ������ ������ C< Complete >,
-��������� ����� ����� ��������� ����� ������ ������ C< Complete >. 
-
-C< False > - ���� ������ ������� ��������������� � ����� � �������, ��� ���� ���������
-����� ��������� ��� ������ ��������� � �������� C< streamBody >
-
-��� �������� ����� ������ �� ������� ��������� � ������ ��� ������ � ���� ������.
-
-=item C< streamOut >
-
-����������� ����� CGI ����������.
-
-=item C< streamBody >
-
-����� ��� ������ � ���� ������.
-
-=item C< isHeadPrinted >
-
-������� ����, ��� ��������� ��� ��� ��������� �������.
-
-=back
-
-=head1 METHODS
-
-=over
-
-=item C< Complete >
-
-��������� �������� ������.
-
-=item C< Discard >
-
-�������� �������� ������, ��� ���� ���� ����� ������ (��������, ���������)
-��� ���� ����������, ������ �������������� � STDERR.
-
-=back
-
-=cut
\ No newline at end of file
--- a/_test/wmi.pl	Fri Mar 05 20:14:45 2010 +0300
+++ b/_test/wmi.pl	Tue Mar 09 02:50:45 2010 +0300
@@ -1,7 +1,8 @@
 #!/usr/bin/perl -w
 use strict;
 
-use Win32::OLE;
+
+eval "use Win32::OLE; 1;" if $^ =~ /win/;
 
 my $wmi = Win32::OLE->GetObject("winmgmts:{impersonationLevel=impersonate}!\\\\.\\root\\cimv2");