1package FEAR::API::Closure;
2
3use Spiffy -base;
4use FEAR::API::SourceFilter;
5
6use strict;
7no warnings 'redefine';
8our @EXPORT = qw(
9		 _field
10		 _chain
11		 _alias
12
13		 @field_subs
14		 @chain_subs
15
16		 _init
17		 _init_field_subs
18		 _init_chain_subs
19		);
20
21our @field_subs;
22our @chain_subs;
23
24
25use FEAR::API::Translate;
26
27#================================================================================
28# Closure generation
29#================================================================================
30
31sub _field() {
32    my $package = caller;
33    my ($field, $default) = @_;
34    no strict 'refs';
35    push @field_subs, $field;
36#    print "field '$field' => $default\n";
37    push @{$package.'::EXPORT_BASE'}, $field;
38
39    *{;no strict 'refs';
40      \*{"${package}::$field"}} =
41	sub {
42	    &__know_myself__;
43	    $__this_field__ = $field;
44	    &__translate_and_return__;
45	    $self->{$field} = shift if defined $_[0];
46	    if( not defined $self->{$field} ){
47	      $self->{$field} = $default;
48	    }
49	    return $self->{$field};
50	};
51
52}
53
54
55sub _chain() {
56    my $package = caller;
57    my ($field, $default) = @_;
58
59    no strict 'refs';
60    push @chain_subs, $field;
61    push @{$package.'::EXPORT_BASE'}, $field;
62#    print "chain '$field' => $default\n";
63
64    *{;no strict 'refs';
65      \*{"${package}::$field"}} =
66	sub {
67	    &__know_myself__;
68	    $__this_field__ = $field;
69	    &__translate_and_return_self__;
70	    $self->{$field} = shift if defined $_[0];
71	    if( not defined $self->{$field} ){
72	      $self->{$field} = $default;
73	    }
74	    return $self;
75	};
76}
77
78
79# Aliases are created for commonly-used subs that are tedious in name
80sub _alias($$) {
81    my $package = caller;
82    my ($alias, $sub) = @_;
83    no strict 'refs';
84    *{;no strict 'refs';
85      $package.'::'.$alias} = \&{$package.'::'.$sub};
86    push @{$package.'::EXPORT_BASE'}, $alias;
87}
88
89sub _init {
90    foreach my $s (@{$_[0]}){
91      $self->$s();
92    }
93}
94
95sub _init_field_subs {
96    $self->_init(\@field_subs);
97    $self;
98}
99
100sub _init_chain_subs {
101    $self->_init(\@chain_subs);
102    $self;
103}
104
105
1061;
107__END__
108