Mercurial > pub > Impl
diff lib/IMPL/template.pm @ 407:c6e90e02dd17 ref20150831
renamed Lib->lib
author | cin |
---|---|
date | Fri, 04 Sep 2015 19:40:23 +0300 |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib/IMPL/template.pm Fri Sep 04 19:40:23 2015 +0300 @@ -0,0 +1,155 @@ +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