line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Package::FromData; |
2
|
8
|
|
|
8
|
|
218652
|
use strict; |
|
8
|
|
|
|
|
21
|
|
|
8
|
|
|
|
|
306
|
|
3
|
8
|
|
|
8
|
|
41
|
use warnings; |
|
8
|
|
|
|
|
15
|
|
|
8
|
|
|
|
|
221
|
|
4
|
8
|
|
|
8
|
|
194
|
use 5.010; |
|
8
|
|
|
|
|
38
|
|
|
8
|
|
|
|
|
326
|
|
5
|
|
|
|
|
|
|
|
6
|
8
|
|
|
8
|
|
39
|
use base 'Exporter'; |
|
8
|
|
|
|
|
16
|
|
|
8
|
|
|
|
|
1335
|
|
7
|
|
|
|
|
|
|
our @EXPORT = qw/create_package_from_data/; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
our $VERSION = '0.01'; |
10
|
|
|
|
|
|
|
|
11
|
8
|
|
|
8
|
|
10513
|
use Readonly; |
|
8
|
|
|
|
|
27495
|
|
|
8
|
|
|
|
|
505
|
|
12
|
8
|
|
|
8
|
|
55
|
use Carp; |
|
8
|
|
|
|
|
14
|
|
|
8
|
|
|
|
|
682
|
|
13
|
8
|
|
|
8
|
|
46
|
use Scalar::Util qw(blessed); |
|
8
|
|
|
|
|
18
|
|
|
8
|
|
|
|
|
1041
|
|
14
|
8
|
|
|
8
|
|
7521
|
use Test::Deep::NoTest qw(eq_deeply); |
|
8
|
|
|
|
|
333384
|
|
|
8
|
|
|
|
|
66
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
Readonly my %SIGIL_TYPE_MAP => ( |
17
|
|
|
|
|
|
|
'$' => 'SCALAR', |
18
|
|
|
|
|
|
|
'@' => 'ARRAY', |
19
|
|
|
|
|
|
|
'%' => 'HASH', |
20
|
|
|
|
|
|
|
'*' => 'GLOB', |
21
|
|
|
|
|
|
|
); |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
sub _must_be($$$) { |
24
|
29
|
100
|
100
|
29
|
|
441
|
croak $_[0] unless ref $_[1] && ref $_[1] eq $_[2]; |
25
|
|
|
|
|
|
|
} |
26
|
|
|
|
|
|
|
|
27
|
23
|
|
|
23
|
|
418
|
sub _must_be_hash($$) { &_must_be(@_[0,1], 'HASH' ) } |
28
|
0
|
|
|
0
|
|
0
|
sub _must_be_array($$) { &_must_be(@_[0,1], 'ARRAY') } |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
sub create_package_from_data { |
31
|
11
|
|
|
11
|
1
|
8291
|
my $packages = shift; |
32
|
11
|
|
|
|
|
43
|
_must_be_hash 'please pass create_package_from_data a hashref', $packages; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
_must_be_hash 'definition for package must be a hashref', $_ |
35
|
9
|
|
|
|
|
50
|
for values %$packages; |
36
|
|
|
|
|
|
|
|
37
|
8
|
|
|
|
|
32
|
foreach my $package (keys %$packages){ |
38
|
11
|
|
|
|
|
25
|
my $def = $packages->{$package}; |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
# create package |
41
|
11
|
|
|
|
|
52
|
_create_package($package); |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
# add constructors |
44
|
10
|
100
|
|
|
|
28
|
foreach my $const (@{$def->{constructors}||[]}){ |
|
10
|
|
|
|
|
57
|
|
45
|
8
|
|
|
|
|
29
|
_add_constructor($package, $const); |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
# add variables |
49
|
10
|
|
|
|
|
83
|
my $sigils = '['. (join '', keys %SIGIL_TYPE_MAP). ']'; |
50
|
10
|
100
|
|
|
|
286
|
foreach my $variable (keys %{$def->{variables}||{}}){ |
|
10
|
|
|
|
|
90
|
|
51
|
6
|
50
|
|
|
|
121
|
if($variable !~ /^(?<sigil>$sigils)(?<varname>\w+)$/o){ |
52
|
0
|
|
|
|
|
0
|
die "'$variable' doesn't look like a variable name"; |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
8
|
|
|
8
|
|
11450
|
my $sigil = $+{sigil}; # XXX infer from reftype? |
|
8
|
|
|
|
|
4570
|
|
|
8
|
|
|
|
|
11967
|
|
|
6
|
|
|
|
|
43
|
|
56
|
6
|
|
|
|
|
30
|
my $varname = $+{varname}; |
57
|
6
|
|
|
|
|
19
|
my $value = $def->{variables}{$variable}; |
58
|
6
|
100
|
|
|
|
19
|
$value = \"$value" if !ref $value; # make scalar a SCALAR |
59
|
|
|
|
|
|
|
|
60
|
6
|
|
|
|
|
32
|
_must_be "value for '$variable' must be a ". |
61
|
|
|
|
|
|
|
$SIGIL_TYPE_MAP{$sigil}. ' reference', |
62
|
|
|
|
|
|
|
$value, $SIGIL_TYPE_MAP{$sigil}; |
63
|
6
|
|
|
|
|
58
|
_add_variable_to($package, $varname, $value); |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
# add functions |
67
|
10
|
100
|
|
|
|
99
|
foreach my $function (keys %{$def->{functions}||{}}){ |
|
10
|
|
|
|
|
76
|
|
68
|
9
|
|
|
|
|
174
|
_add_function_from_definition($package, $function, |
69
|
|
|
|
|
|
|
$def->{functions}{$function}); |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
# add methods |
74
|
10
|
100
|
|
|
|
28
|
foreach my $method (keys %{$def->{methods}||{}}){ |
|
10
|
|
|
|
|
70
|
|
75
|
|
|
|
|
|
|
_add_function_from_definition( |
76
|
|
|
|
|
|
|
$package, $method, |
77
|
|
|
|
|
|
|
$def->{methods}{$method}, |
78
|
|
|
|
|
|
|
1, |
79
|
20
|
100
|
|
20
|
|
136
|
sub { croak 'must be called as a method' unless blessed $_[0] }, |
80
|
9
|
|
|
|
|
44
|
); |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
# add static methods |
84
|
10
|
100
|
|
|
|
24
|
foreach my $method (keys %{$def->{static_methods}||{}}){ |
|
10
|
|
|
|
|
89
|
|
85
|
9
|
|
|
|
|
27
|
_add_function_from_definition( |
86
|
|
|
|
|
|
|
$package, $method, |
87
|
|
|
|
|
|
|
$def->{static_methods}{$method}, |
88
|
|
|
|
|
|
|
1 |
89
|
|
|
|
|
|
|
); |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
sub _create_package { |
95
|
11
|
|
|
11
|
|
30
|
my $name = shift; |
96
|
11
|
100
|
|
|
|
304
|
die "invalid package name '$name'" |
97
|
|
|
|
|
|
|
unless $name =~ /^\w(?:\w|::)+\w$/; |
98
|
10
|
|
|
|
|
459
|
eval "package $name"; |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
sub _add_constructor { |
102
|
8
|
|
|
8
|
|
24
|
my ($package, $name) = @_; |
103
|
|
|
|
|
|
|
_add_function_to($package, $name, sub { |
104
|
10
|
|
|
10
|
|
2381
|
my $class = shift; |
105
|
10
|
|
|
|
|
55
|
return bless {}, $class |
106
|
8
|
|
|
|
|
50
|
}); |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
sub _mk_sub { |
110
|
23
|
|
|
23
|
|
38
|
my ($body, $shift, $precondition) = @_; |
111
|
|
|
|
|
|
|
return sub { |
112
|
57
|
100
|
|
57
|
|
1332
|
$precondition->(@_) if $precondition; |
113
|
56
|
100
|
|
|
|
127
|
do { shift for (1..$shift) } if $shift; # kill unnecessary args |
|
38
|
|
|
|
|
123
|
|
114
|
56
|
50
|
|
|
|
196
|
return $body->(@_) if $body; |
115
|
|
|
|
|
|
|
} |
116
|
23
|
|
|
|
|
137
|
} |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
sub _add_function_from_definition { |
119
|
27
|
|
|
27
|
|
57
|
my ($package, $function, $fdef, $shift, $precondition) = @_; |
120
|
27
|
|
|
|
|
44
|
given(ref $fdef){ |
121
|
27
|
|
|
|
|
86
|
when('ARRAY'){ |
122
|
23
|
|
|
|
|
102
|
my @fdef = @$fdef; |
123
|
23
|
|
|
|
|
26
|
my $func; |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
# determine default |
126
|
|
|
|
|
|
|
my $default; |
127
|
23
|
100
|
|
|
|
91
|
$default = pop @fdef if @fdef % 2 == 1; |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
# def is of the form { method => 'Class' } |
130
|
23
|
100
|
100
|
|
|
128
|
if(!@fdef && ref $default eq 'HASH' && |
|
|
|
66
|
|
|
|
|
131
|
|
|
|
|
|
|
scalar keys %$default == 1){ |
132
|
4
|
|
|
|
|
13
|
my ($method, $class) = %$default; |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
$func = _mk_sub( sub { |
135
|
4
|
|
|
4
|
|
26
|
return $class->$method; |
136
|
4
|
|
|
|
|
39
|
}, $shift, $precondition); |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
# def is a [ [expected @_] => output, ... ] seq |
140
|
|
|
|
|
|
|
else { |
141
|
19
|
|
|
|
|
23
|
my @rules; |
142
|
19
|
|
|
|
|
53
|
for(my $i = 0; $i < @fdef; $i+=2){ |
143
|
29
|
|
|
|
|
53
|
my ($in, $out) = @fdef[$i,$i+1]; |
144
|
29
|
|
|
|
|
60
|
push @rules, _mk_matcher($in, $out); |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
$func = _mk_sub( sub { |
148
|
52
|
|
|
52
|
|
109
|
for(@rules){ |
149
|
72
|
|
|
|
|
174
|
my @result = $_->(wantarray, @_); |
150
|
72
|
100
|
|
|
|
241
|
if(@result){ |
151
|
33
|
100
|
|
|
|
134
|
return @result if(wantarray); |
152
|
27
|
|
|
|
|
158
|
return $result[0]; |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
} |
155
|
19
|
100
|
|
|
|
65
|
if (ref $default eq 'ARRAY'){ |
156
|
6
|
100
|
|
|
|
18
|
if(wantarray){ |
157
|
3
|
|
|
|
|
18
|
return @$default; |
158
|
|
|
|
|
|
|
} |
159
|
3
|
|
|
|
|
17
|
return $default->[0]; |
160
|
|
|
|
|
|
|
} |
161
|
13
|
|
100
|
|
|
122
|
return $default || |
162
|
|
|
|
|
|
|
die "$function cannot handle [@_] as input"; |
163
|
19
|
|
|
|
|
106
|
}, $shift, $precondition); |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
|
166
|
23
|
|
|
|
|
62
|
_add_function_to($package, $function, $func); |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
} |
169
|
4
|
|
|
|
|
9
|
default { |
170
|
|
|
|
|
|
|
# constant function |
171
|
4
|
|
|
|
|
23
|
_add_constant_function_to($package, $function, $fdef); |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
sub _mk_matcher { |
177
|
29
|
|
|
29
|
|
38
|
my ($in, $out) = @_; |
178
|
29
|
|
|
|
|
55
|
my @in = @$in; |
179
|
29
|
|
|
|
|
52
|
my @out = ($out); |
180
|
29
|
100
|
|
|
|
71
|
@out = @$out if ref $out eq 'ARRAY'; |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
return sub { |
183
|
72
|
|
|
72
|
|
99
|
my $wantarray = shift; |
184
|
72
|
100
|
|
|
|
318
|
if (eq_deeply [@_], [@in]){ |
185
|
33
|
100
|
|
|
|
110513
|
if(ref $out eq 'HASH'){ |
186
|
6
|
100
|
|
|
|
21
|
if($wantarray){ |
187
|
3
|
50
|
|
|
|
16
|
return @{$out->{list}||$out->{array}}; |
|
3
|
|
|
|
|
22
|
|
188
|
|
|
|
|
|
|
} |
189
|
3
|
|
|
|
|
14
|
return $out->{scalar}; |
190
|
|
|
|
|
|
|
} |
191
|
27
|
|
|
|
|
95
|
return @out; |
192
|
|
|
|
|
|
|
} |
193
|
39
|
|
|
|
|
30309
|
return; |
194
|
|
|
|
|
|
|
} |
195
|
29
|
|
|
|
|
209
|
} |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
sub _add_constant_function_to { |
198
|
4
|
|
|
4
|
|
9
|
my ($package, $function, $value) = @_; |
199
|
4
|
|
|
6
|
|
23
|
_add_function_to($package, $function, sub { $value }); |
|
6
|
|
|
|
|
494
|
|
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
sub _add_function_to { # package, subname, coderef |
203
|
35
|
|
|
35
|
|
76
|
_fuck_with_glob(@_); |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
sub _add_variable_to { # package, varname, value |
207
|
6
|
|
|
6
|
|
15
|
_fuck_with_glob(@_); |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
sub _fuck_with_glob { |
211
|
41
|
|
|
41
|
|
93
|
my ($package, $variable_name, $value) = @_; |
212
|
41
|
50
|
|
|
|
109
|
die "WHOA THERE, '$value' isn't a ref" unless ref $value; |
213
|
8
|
|
|
8
|
|
149
|
no strict 'refs'; |
|
8
|
|
|
|
|
16
|
|
|
8
|
|
|
|
|
539
|
|
214
|
41
|
|
|
|
|
50
|
*{"${package}::${variable_name}"} = $value; |
|
41
|
|
|
|
|
333
|
|
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
1; |
218
|
|
|
|
|
|
|
__END__ |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
=head1 NAME |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
Package::FromData - generate a package with methods and variables from |
223
|
|
|
|
|
|
|
a data structure |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
=head1 SYNOPSIS |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
Given a data structure like this: |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
my $packages = { |
230
|
|
|
|
|
|
|
'Foo::Bar' => { |
231
|
|
|
|
|
|
|
constructors => ['new'], # my $foo_bar = Foo::Bar->new |
232
|
|
|
|
|
|
|
static_methods => { # Foo::Bar->method |
233
|
|
|
|
|
|
|
next_word => [ # Foo::Bar->next_word |
234
|
|
|
|
|
|
|
['foo'] => 'bar', # Foo::Bar->next_word('foo') = bar |
235
|
|
|
|
|
|
|
['hello'] => 'world', |
236
|
|
|
|
|
|
|
[qw/bar baz/] => 'baz', # Foo::Bar->next_word(qw/foo bar/) |
237
|
|
|
|
|
|
|
# = baz |
238
|
|
|
|
|
|
|
'default_value' |
239
|
|
|
|
|
|
|
], |
240
|
|
|
|
|
|
|
one => [ 1 ], # Foo::Bar->one = 1 |
241
|
|
|
|
|
|
|
}, |
242
|
|
|
|
|
|
|
methods => { |
243
|
|
|
|
|
|
|
wordify => [ '...' ], # $foo_bar->wordify = '...' |
244
|
|
|
|
|
|
|
# Foo::Bar->wordify = <exception> |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
# baz always returns Foo::Bar::Baz->new |
247
|
|
|
|
|
|
|
baz => [ { new => 'Foo::Bar::Baz' } ], |
248
|
|
|
|
|
|
|
}, |
249
|
|
|
|
|
|
|
functions => { |
250
|
|
|
|
|
|
|
map_foo_bar => [ 'foo' => 'bar', 'bar' => 'foo' ], |
251
|
|
|
|
|
|
|
context => { |
252
|
|
|
|
|
|
|
scalar => 'called in scalar context', |
253
|
|
|
|
|
|
|
list => [qw/called in list context/], |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
}, |
256
|
|
|
|
|
|
|
variables => { |
257
|
|
|
|
|
|
|
'$VERSION' => '42', # $Foo::Bar::VERSION |
258
|
|
|
|
|
|
|
'@ISA' => ['Foo'], # @Foo::Bar::ISA |
259
|
|
|
|
|
|
|
'%FOO' => {Foo => 'Bar'}, # %Foo::Bar::FOO |
260
|
|
|
|
|
|
|
}, |
261
|
|
|
|
|
|
|
}, |
262
|
|
|
|
|
|
|
}; |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
and some code like this: |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
use Package::FromData; |
267
|
|
|
|
|
|
|
create_package_from_data($packages); |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
create the package C<Foo::Bar> and the functions as specified above. |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
After you C<create_package_from_data>, you can use C<Foo::Bar> as though |
272
|
|
|
|
|
|
|
it were a module you wrote: |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
my $fb = Foo::Bar->new # blessed hash reference |
275
|
|
|
|
|
|
|
$fb->baz # a new Foo::Bar::Baz |
276
|
|
|
|
|
|
|
$fb->wordify # '...' |
277
|
|
|
|
|
|
|
$fb->next_word('foo') # 'bar' |
278
|
|
|
|
|
|
|
Foo::Bar->next_word('foo') # 'bar' |
279
|
|
|
|
|
|
|
Foo::Bar->baz # <exception>, it's an instance method |
280
|
|
|
|
|
|
|
Foo::Bar::map_foo_bar('foo') # 'bar' |
281
|
|
|
|
|
|
|
$Foo::Bar::VERSION # '42' |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
Not a very useful package, but you get the idea. |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
=head1 DESCRIPTION |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
This module creates a package with predefined methods, functions, and |
288
|
|
|
|
|
|
|
variables from a data structure. It's used for testing (mock objects) |
289
|
|
|
|
|
|
|
or experimenting. The idea is that you define a package containing |
290
|
|
|
|
|
|
|
functions that return values based on keys, and the rest of your app |
291
|
|
|
|
|
|
|
uses this somehow. (I use it so that C<< Jifty->... >> or |
292
|
|
|
|
|
|
|
C<< Catalyst.uri_for >> will work in templates being served via |
293
|
|
|
|
|
|
|
L<App::TemplateServer|App::TemplateServer>.) |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
=head2 THE TOP |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
The top level data structure is a hash of package names / package |
298
|
|
|
|
|
|
|
definition hash pairs. |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
=head2 PACKAGE DEFINITION HASHES |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
Each package is defined by a package definition hash. This can contain |
303
|
|
|
|
|
|
|
a few keys: |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
=head3 constructors |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
An arrayref of constructors to be generated. The generated code looks like: |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
sub <the name> { |
310
|
|
|
|
|
|
|
my $class = shift; |
311
|
|
|
|
|
|
|
return bless {}, $class; |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
=head3 functions |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
The functions key should point to a hash of function names / function |
317
|
|
|
|
|
|
|
definiton array pairs. |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
=head4 FUNCTION DEFINITION ARRAYS |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
The function definition array is a list of pairs followed by an |
322
|
|
|
|
|
|
|
optional single value. The pairs are treated like a @_ => result of |
323
|
|
|
|
|
|
|
function hash, and the optional single element is used as a default |
324
|
|
|
|
|
|
|
return value. The expected input (@_) can be deep Perl data |
325
|
|
|
|
|
|
|
structures; an input => output pair matches if the C<\@_> in the |
326
|
|
|
|
|
|
|
program C<Test::Deep::NoTest::eq_deeply>s the input rule you specify. |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
The pairs are of the form ARRAYREF => SCALAR|ARRAYREF|SEPECIAL. To make |
329
|
|
|
|
|
|
|
C<function('foo','bar')> return C<baz>, you would add a pair like C<[ |
330
|
|
|
|
|
|
|
'foo', 'bar' ] => 'baz'> to the definition hash. To return a bare list, |
331
|
|
|
|
|
|
|
use a arrayref; C<['foo','bar'] => ['foo','bar']>. To return a |
332
|
|
|
|
|
|
|
reference to a list, nest an arrayrf in the arrayref; C<foo('bar') = |
333
|
|
|
|
|
|
|
['baz']>. |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
To return different values in scalar or list context, pass a hash as |
336
|
|
|
|
|
|
|
the output definition: |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
[ [input] => { scalar => '42', list => [qw/contents of the list/] }, |
339
|
|
|
|
|
|
|
... ] |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
To return a hashref, just say C<< [{ ... }] >>. |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
Finally, the function definition array may be a single hash containing |
344
|
|
|
|
|
|
|
a C<method => package> pair, which means to always call C<< |
345
|
|
|
|
|
|
|
package->method >> and return the result. This makes it possible for |
346
|
|
|
|
|
|
|
packages defined with C<Package::FromData> to be nested. |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
=head3 methods |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
Like functions, but the first argument (<$self>) is ignored. |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
=head3 static_methods |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
Like methods, but can be invoked against the class name instead of |
355
|
|
|
|
|
|
|
and instance of the class. |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
=head3 variables |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
A hash of variable name (including sigil) / value pairs. Keys |
360
|
|
|
|
|
|
|
starting with @ or % must point to the appropriate reference type. |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
=head1 EXPORTS |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
C<create_package_from_data> |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
=head1 FUNCTIONS |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
=head2 create_package_from_data |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
See L</DESCRIPTION> above. |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
=head1 BUGS |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
Probably. Report them to RT. |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
=head1 CODE REPOSITORY |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
The git repository is at L<http://git.jrock.us/> and can be cloned with: |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
git clone git://git.jrock.us/Package-FromData |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
=head1 AUTHOR |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
Jonathan Rockway C<< <jrockway@cpan.org> >> |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
=head1 COPYRIGHT |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
Copyright (c) 2007, Jonathan Rockway. This module free software. You may |
389
|
|
|
|
|
|
|
redistribute it under the same terms as Perl itself. |