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