view Lib/IMPL/template.pm @ 165:76515373dac0

Added Class::Template, Rewritten SQL::Schema 'use parent' directive instead of 'use base'
author wizard
date Sat, 23 Apr 2011 23:06:48 +0400
parents
children 1f7a6d762394
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 /\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 ) );
}

=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