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