Mercurial > pub > Impl
view Lib/IMPL/template.pm @ 232:5c82eec23bb6
Fixed degradations due refactoring
author | sergey |
---|---|
date | Tue, 09 Oct 2012 20:12:47 +0400 |
parents | 4d0e1962161c |
children |
line wrap: on
line source
package IMPL::template; use strict; use warnings; use IMPL::Class::Template(); sub import { shift; my %args = @_; my $class = caller; my @paramNames = grep m/\w+/, @{$args{parameters} || []}; my $declare = $args{declare}; my @isa = (@{$args{base} || []}, $class); my %instances; no strict 'refs'; push @{"${class}::ISA"}, 'IMPL::Class::Template'; *{"${class}::$_"} = sub { die IMPL::InvalidOperationException("A template parameter isn't available here") } foreach @paramNames; *{"${class}::spec"} = sub { my ($self,@params) = @_; my $specClass = $self->makeName(@params); return $specClass if $instances{$specClass}; $instances{$specClass} = 1; for (my $i=0; $i < @paramNames; $i++) { my $param = $params[$i]; *{"${specClass}::$paramNames[$i]"} = sub { $param }; } @{"${specClass}::ISA"} = @isa; &$declare($specClass) if $declare; return $specClass; }; } 1; __END__ =pod =head1 NAME C<IMPL::template> директива для объявления шаблона. =head1 SYNPOSIS =begin code package KeyValuePair; use IMPL::Class::Property; use IMPL::template ( parameters => [qw(TKey TValue))], base => [qw(IMPL::Object IMPL::Object::Autofill)], declare => sub { my ($class) = @_; public $class->CreateProperty(key => prop_get | owner_set, { type => $class->TKey } ); public $class->CreateProperty(value => prop_all, { type => $class->TValue} ); $class->PassThroughArgs; } ); BEGIN { public property id => prop_get | owner_set, { type => 'integer'}; } __PACKAGE__->PassThroughArgs; package MyCollection; use IMPL::Class::Property; use IMPL::lang; use IMPL::template( parameters => [qw(TKey TValue)], base => [qw(IMPL::Object)], declare => sub { my ($class) = @_; my $item_t = spec KeyValuePair($class->TKey,$class->TValue); public $class->CreateProperty(items => prop_get | prop_list, { type => $item_t } ); $class->static_accessor( ItemType => $item_t ); } ) sub Add { my ($this,$key,$value) = @_; die new IMPL::ArgumentException( key => "Invalid argument type" ) unless is $key, $this->TKey; die new IMPL::ArgumentException( value => "Invalid argument type" ) unless is $value, $this->TValue; $this->items->AddLast( $this->ItemType->new( key => $key, value => $value ) ); } package main; use IMPL::require { TFoo => 'Some::Package::Foo', TBar => 'Some::Package::Bar' }; my $TCol = spec MyCollection(TFoo, TBar); =end code =head1 DESCRIPTION Шаблоны используются для динамической генерации классов. Процесс создания класса по шаблону называется специализацией, при этом создается новый класс: =over =item 1 Обявляется новый пакет с именем, вычисленным из имени и параметров шаблона =item 2 Формируется массив C<@ISA> для созаднного класса, в который добавляется имя шаблона =item 3 Формируются методы с именами параметров шаблона, возвращающие реальные значения параметров =item 4 Вызывается метод для конструирования специализиции =back =head1 MEMBERS =over =item C<spec(@params)> Метод, создающий специализацию шаблона. Может быть вызван как оператор. =back =cut