--- 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");