Mercurial > pub > Impl
changeset 274:8d36073411b1
+Added AutoDispose class
*code cleanups
| author | cin |
|---|---|
| date | Wed, 30 Jan 2013 03:30:28 +0400 |
| parents | ad93c9f4dd93 |
| children | 6253872024a4 |
| files | Lib/IMPL/Class/PropertyInfo.pm Lib/IMPL/Code/Binding.pm Lib/IMPL/Code/Loader.pm Lib/IMPL/Object/AutoDispose.pm Lib/IMPL/lang.pm _test/Test/SQL/Diff.pm _test/temp.pl |
| diffstat | 7 files changed, 105 insertions(+), 106 deletions(-) [+] |
line wrap: on
line diff
--- a/Lib/IMPL/Class/PropertyInfo.pm Tue Jan 29 17:19:10 2013 +0400 +++ b/Lib/IMPL/Class/PropertyInfo.pm Wed Jan 30 03:30:28 2013 +0400 @@ -5,7 +5,7 @@ our %CTOR = ( 'IMPL::Class::MemberInfo' => '@_' ); -__PACKAGE__->mk_accessors(qw(Type Mutators canGet canSet ownerSet)); +__PACKAGE__->mk_accessors(qw(Type Mutators canGet canSet ownerSet isList)); my %LoadedModules; @@ -39,6 +39,10 @@ eval {$_[0]->Class->_PropertyImplementor} or die new IMPL::Exception('Can\'t find a property implementor for the specified class',$_[0]->Class); } +sub type { + goto &Type; +} + 1; __END__
--- a/Lib/IMPL/Code/Binding.pm Tue Jan 29 17:19:10 2013 +0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,83 +0,0 @@ -package IMPL::Code::Binding; -use strict; - -use IMPL::require { - Exception => 'IMPL::Exception', - ArgumentException => '-IMPL::ArgumentException' -}; - -sub new { - my ($self,$expr,$vars) = @_; - - $vars ||= []; - - die ArgumentException->new( vars => 'A reference to an array is required') - unless ref $vars eq 'ARRAY'; - - m/^\w+$/ or die ArgumentException->new( vars => 'A valid variable name is required', $_ ) - foreach @$vars; - - my $varnames = join (',', map { "\$$_" } @$vars); - - my $code = <<CODE; - sub { - my ($varnames) = \@_; - $text - } -CODE - my $method = eval $code; #$compiler_env->reval($code,'strict'); - - return $method; -} - -1; - -__END__ - -=pod - -=head1 NAME - -C<IMPL::Code::Binding> - превращает выражения в процедуру. - -=head1 SYNOPSIS - -=begin code - -use IMPL::require { - Binding => 'IMPL::Code::Binding' -} - -my $person = DB->SearchPerson({name => 'Peter'})->First; - -my $bind = Binding->new( - [qw(obj)] => - q{ $obj->addresses->[0]->country->code } -); - -print $bind->($person); - -=end - -=head1 DESCRIPTION - -Позвоялет преобразовать выражение в функцию, которую можно будет многократно -использовать для получения значения выражения. - -Выражение параметризуется произвольным количеством именованных параметров, -которые будут доступны внутри выражения как переменные. При создании связывателя -в конструктор передается выражение связывания, ссылка насписок из параметров. - -При создания связывателя будет проверен синтаксис, и если в выражении допущена -ошибка, возникнет исключение. - -Данный класс не является безопасным при создании связывателей из ненадежных -источников, поскольку внутри будет выполнен C<eval>. - -=head1 MEMBERS - -=head2 C<new(\@vars,$expression)> - -Возвращает ссылку на процедуру. - -=cut \ No newline at end of file
--- a/Lib/IMPL/Code/Loader.pm Tue Jan 29 17:19:10 2013 +0400 +++ b/Lib/IMPL/Code/Loader.pm Wed Jan 30 03:30:28 2013 +0400 @@ -3,7 +3,7 @@ use warnings; use IMPL::Const qw(:prop); - +use File::Spec; use IMPL::declare { require => { Exception => 'IMPL::Exception', @@ -53,6 +53,16 @@ return $package; } +sub ModuleExists { + my ($this,$package) = @_; + + my $file = join('/', split(/::/,$this->GetFullName($package))) . ".pm"; + + -f File::Spec->catfile($_,$file) and return 1 foreach @INC; + + return 0; +} + sub GetFullName { my ($this,$package) = @_;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/IMPL/Object/AutoDispose.pm Wed Jan 30 03:30:28 2013 +0400 @@ -0,0 +1,52 @@ +package IMPL::Object::AutoDispose; +use strict; + +use IMPL::declare { + base => [ + 'IMPL::Object::Abstract' => undef + ] +}; + +sub new { + my $self = shift; + + if (ref $self) { + return ${$self}->new(@_); + } else { + my $obj = shift; + return bless \$obj, $self; + } +} + +sub isa { + ${shift(@_)}->isa(@_); +} + +sub can { + ${shift(@_)}->can(@_); +} + +sub DTOR { + ${shift(@_)}->Dispose(); +} + +sub typeof { + ${shift(@_)}->typeof(@_); +} + +sub toString { + ${shift(@_)}->toString(@_); +} + +sub AUTOLOAD { + our $AUTOLOAD; + my ($method) = ($AUTOLOAD =~ m/(\w+)$/); + + no strict 'refs'; + + goto &{*{$AUTOLOAD} = sub { + ${shift(@_)}->$method(@_); + }}; +} + +1; \ No newline at end of file
--- a/Lib/IMPL/lang.pm Tue Jan 29 17:19:10 2013 +0400 +++ b/Lib/IMPL/lang.pm Wed Jan 30 03:30:28 2013 +0400 @@ -5,16 +5,18 @@ use parent qw(Exporter); use IMPL::_core::version; use IMPL::clone qw(clone); +use Scalar::Util qw(blessed); require IMPL::Class::PropertyInfo; -our @EXPORT = qw(&is &isclass); +our @EXPORT = qw(&is &isclass &typeof); our %EXPORT_TAGS = ( base => [ qw( &is &clone &isclass + &typeof ) ], @@ -70,6 +72,10 @@ eval {not ref $_[0] and $_[0]->isa( $_[1] ) }; } +sub typeof(*) { + eval { $_[0]->typeof } || blessed($_[0]); +} + sub virtual($) { $_[0]->Virtual(1); $_[0];
--- a/_test/Test/SQL/Diff.pm Tue Jan 29 17:19:10 2013 +0400 +++ b/_test/Test/SQL/Diff.pm Wed Jan 30 03:30:28 2013 +0400 @@ -52,9 +52,6 @@ my $processor = MySQLProcessor->new($schemaSrc); $processor->ProcessBatch($diff); - warn Dumper($diff); - warn Dumper($processor->sqlBatch); - $schemaSrc->Dispose; $schemaDst->Dispose;
--- a/_test/temp.pl Tue Jan 29 17:19:10 2013 +0400 +++ b/_test/temp.pl Wed Jan 30 03:30:28 2013 +0400 @@ -1,29 +1,42 @@ #!/usr/bin/perl use strict; -use XML::Compile::Schema; -use XML::Compile::Util qw(pack_type pack_id); -use Data::Dumper; +{ + package Foo; + use IMPL::declare { + base => [ + 'IMPL::Object::Disposable' => undef + ] + }; +} + use Time::HiRes qw(gettimeofday tv_interval); - -my $schema = XML::Compile::Schema->new('Resources/resources.xsd'); -$schema->printIndex(); -my $type = pack_type 'http://implab.org/schemas/resources', 'resources'; -my $reader = $schema->compile( - READER => $type, - xsi_type => { - pack_type('http://implab.org/schemas/resources','AbstractResult') => 'AUTO' - } -); +use IMPL::lang; +use IMPL::require { + AutoDispose => 'IMPL::Object::AutoDispose', + DBSchema => 'IMPL::SQL::Schema' +}; + +my $real = DBSchema->new( name => 'simple', version => 1); +my $proxy = AutoDispose->new($real); + +print typeof($proxy),"\n"; my $t = [gettimeofday]; -my $obj = $reader->('Resources/sample.xml'); +for (1..1000000) { + $proxy->name; +} -print "Parsing small Xml file: ",tv_interval($t,[gettimeofday]),"\n"; +print "proxy: ",tv_interval($t,[gettimeofday]),"\n"; -print Dumper( $obj ); +$t = [gettimeofday]; + +for (1..1000000) { + $real->name; +} + +print "real: ",tv_interval($t,[gettimeofday]),"\n"; -