diff 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 diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/template.pm	Sat Apr 23 23:06:48 2011 +0400
@@ -0,0 +1,146 @@
+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
\ No newline at end of file