Mercurial > pub > Impl

comparison Lib/IMPL/template.pm @ 194:4d0e1962161c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Replaced tabs with spaces IMPL::Web::View - fixed document model, new features (control classes, document constructor parameters)
author cin
date Tue, 10 Apr 2012 20:08:29 +0400
parents ae8072f2f2a3
children
comparison
equal deleted inserted replaced
193:8e8401c0aea4 194:4d0e1962161c
3 use warnings; 3 use warnings;
4 4
5 use IMPL::Class::Template(); 5 use IMPL::Class::Template();
6 6
7 sub import { 7 sub import {
8 shift; 8 shift;
9 my %args = @_; 9 my %args = @_;
10 10
11 my $class = caller; 11 my $class = caller;
12 12
13 my @paramNames = grep m/\w+/, @{$args{parameters} || []}; 13 my @paramNames = grep m/\w+/, @{$args{parameters} || []};
14 my $declare = $args{declare}; 14 my $declare = $args{declare};
15 my @isa = (@{$args{base} || []}, $class); 15 my @isa = (@{$args{base} || []}, $class);
16 my %instances; 16 my %instances;
17 17
18 no strict 'refs'; 18 no strict 'refs';
19 19
20 push @{"${class}::ISA"}, 'IMPL::Class::Template'; 20 push @{"${class}::ISA"}, 'IMPL::Class::Template';
21 21
22 *{"${class}::$_"} = sub { die IMPL::InvalidOperationException("A template parameter isn't available here") } 22 *{"${class}::$_"} = sub { die IMPL::InvalidOperationException("A template parameter isn't available here") }
23 foreach @paramNames; 23 foreach @paramNames;
24 24
25 *{"${class}::spec"} = sub { 25 *{"${class}::spec"} = sub {
26 my ($self,@params) = @_; 26 my ($self,@params) = @_;
27 27
28 my $specClass = $self->makeName(@params); 28 my $specClass = $self->makeName(@params);
29 29
30 return $specClass if $instances{$specClass}; 30 return $specClass if $instances{$specClass};
31 31
32 $instances{$specClass} = 1; 32 $instances{$specClass} = 1;
33 33
34 for (my $i=0; $i < @paramNames; $i++) { 34 for (my $i=0; $i < @paramNames; $i++) {
35 my $param = $params[$i]; 35 my $param = $params[$i];
36 *{"${specClass}::$paramNames[$i]"} = sub { $param }; 36 *{"${specClass}::$paramNames[$i]"} = sub { $param };
37 } 37 }
38 38
39 @{"${specClass}::ISA"} = @isa; 39 @{"${specClass}::ISA"} = @isa;
40 40
41 &$declare($specClass) if $declare; 41 &$declare($specClass) if $declare;
42 return $specClass; 42 return $specClass;
43 }; 43 };
44 } 44 }
45 45
46 1; 46 1;
47 47
48 __END__ 48 __END__
60 package KeyValuePair; 60 package KeyValuePair;
61 61
62 use IMPL::Class::Property; 62 use IMPL::Class::Property;
63 63
64 use IMPL::template ( 64 use IMPL::template (
65 parameters => [qw(TKey TValue))], 65 parameters => [qw(TKey TValue))],
66 base => [qw(IMPL::Object IMPL::Object::Autofill)], 66 base => [qw(IMPL::Object IMPL::Object::Autofill)],
67 declare => sub { 67 declare => sub {
68 my ($class) = @_; 68 my ($class) = @_;
69 public $class->CreateProperty(key => prop_get | owner_set, { type => $class->TKey } ); 69 public $class->CreateProperty(key => prop_get | owner_set, { type => $class->TKey } );
70 public $class->CreateProperty(value => prop_all, { type => $class->TValue} ); 70 public $class->CreateProperty(value => prop_all, { type => $class->TValue} );
71 71
72 $class->PassThroughArgs; 72 $class->PassThroughArgs;
73 } 73 }
74 ); 74 );
75 75
76 BEGIN { 76 BEGIN {
77 public property id => prop_get | owner_set, { type => 'integer'}; 77 public property id => prop_get | owner_set, { type => 'integer'};
78 } 78 }
79 79
80 __PACKAGE__->PassThroughArgs; 80 __PACKAGE__->PassThroughArgs;
81 81
82 package MyCollection; 82 package MyCollection;
83 83
84 use IMPL::Class::Property; 84 use IMPL::Class::Property;
85 85
86 use IMPL::lang; 86 use IMPL::lang;
87 use IMPL::template( 87 use IMPL::template(
88 parameters => [qw(TKey TValue)], 88 parameters => [qw(TKey TValue)],
89 base => [qw(IMPL::Object)], 89 base => [qw(IMPL::Object)],
90 declare => sub { 90 declare => sub {
91 my ($class) = @_; 91 my ($class) = @_;
92 my $item_t = spec KeyValuePair($class->TKey,$class->TValue); 92 my $item_t = spec KeyValuePair($class->TKey,$class->TValue);
93 93
94 public $class->CreateProperty(items => prop_get | prop_list, { type => $item_t } ); 94 public $class->CreateProperty(items => prop_get | prop_list, { type => $item_t } );
95 95
96 $class->static_accessor( ItemType => $item_t ); 96 $class->static_accessor( ItemType => $item_t );
97 } 97 }
98 ) 98 )
99 99
100 sub Add { 100 sub Add {
101 my ($this,$key,$value) = @_; 101 my ($this,$key,$value) = @_;
102 102
103 die new IMPL::ArgumentException( key => "Invalid argument type" ) unless is $key, $this->TKey; 103 die new IMPL::ArgumentException( key => "Invalid argument type" ) unless is $key, $this->TKey;
104 die new IMPL::ArgumentException( value => "Invalid argument type" ) unless is $value, $this->TValue; 104 die new IMPL::ArgumentException( value => "Invalid argument type" ) unless is $value, $this->TValue;
105 105
106 $this->items->AddLast( $this->ItemType->new( key => $key, value => $value ) ); 106 $this->items->AddLast( $this->ItemType->new( key => $key, value => $value ) );
107 } 107 }
108 108
109 package main; 109 package main;
110 110
111 use IMPL::require { 111 use IMPL::require {
112 TFoo => 'Some::Package::Foo', 112 TFoo => 'Some::Package::Foo',
113 TBar => 'Some::Package::Bar' 113 TBar => 'Some::Package::Bar'
114 }; 114 };
115 115
116 my $TCol = spec MyCollection(TFoo, TBar); 116 my $TCol = spec MyCollection(TFoo, TBar);
117 117
118 =end code 118 =end code