line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Sub::Talisman::Struct; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
91258
|
use 5.012; |
|
2
|
|
|
|
|
7
|
|
|
2
|
|
|
|
|
65
|
|
4
|
2
|
|
|
2
|
|
11
|
use strict; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
57
|
|
5
|
2
|
|
|
2
|
|
10
|
use warnings; |
|
2
|
|
|
|
|
7
|
|
|
2
|
|
|
|
|
103
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
BEGIN { |
8
|
2
|
|
|
2
|
|
5
|
$Sub::Talisman::Struct::AUTHORITY = 'cpan:TOBYINK'; |
9
|
2
|
|
|
|
|
33
|
$Sub::Talisman::Struct::VERSION = '0.005'; |
10
|
|
|
|
|
|
|
} |
11
|
|
|
|
|
|
|
|
12
|
2
|
|
|
2
|
|
11
|
use base qw( Sub::Talisman ); |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
1876
|
|
13
|
2
|
|
|
2
|
|
337667
|
use MooX::Struct (); |
|
2
|
|
|
|
|
160279
|
|
|
2
|
|
|
|
|
56
|
|
14
|
2
|
|
|
2
|
|
21
|
use Carp qw( confess ); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
115
|
|
15
|
2
|
|
|
2
|
|
9
|
use Data::OptList (); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
29
|
|
16
|
2
|
|
|
2
|
|
8
|
use namespace::clean; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
15
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
sub import |
19
|
|
|
|
|
|
|
{ |
20
|
4
|
|
|
4
|
|
267
|
my $class = shift; |
21
|
4
|
|
|
|
|
7
|
my $caller = caller; |
22
|
|
|
|
|
|
|
|
23
|
4
|
|
|
|
|
5
|
foreach my $arg (@{ Data::OptList::mkopt(\@_) }) |
|
4
|
|
|
|
|
19
|
|
24
|
|
|
|
|
|
|
{ |
25
|
7
|
|
|
|
|
153
|
my ($atr, $str) = @$arg; |
26
|
7
|
|
|
|
|
30
|
$class->setup_for($caller => { |
27
|
|
|
|
|
|
|
attribute => $atr, |
28
|
|
|
|
|
|
|
struct => $str, |
29
|
|
|
|
|
|
|
}); |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
my %PROCESSORS; |
34
|
|
|
|
|
|
|
my %STRUCTS; |
35
|
|
|
|
|
|
|
sub setup_for |
36
|
|
|
|
|
|
|
{ |
37
|
7
|
|
|
7
|
1
|
13
|
my ($class, $caller, $opts) = @_; |
38
|
7
|
|
|
|
|
36
|
$class->SUPER::setup_for($caller, $opts); |
39
|
7
|
|
66
|
|
|
2633
|
my $proc = $PROCESSORS{$caller} //= 'MooX::Struct::Processor'->new; |
40
|
7
|
|
100
|
|
|
6212
|
my $struct = $proc->make_sub( |
41
|
|
|
|
|
|
|
$opts->{attribute}, |
42
|
|
|
|
|
|
|
$opts->{struct} || [], |
43
|
|
|
|
|
|
|
); |
44
|
7
|
|
|
|
|
358
|
$STRUCTS{"$caller\::$opts->{attribute}"} = $struct; |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
sub _process_params |
48
|
|
|
|
|
|
|
{ |
49
|
15
|
|
|
15
|
|
18060
|
my ($class, $attr, $params) = @_; |
50
|
|
|
|
|
|
|
|
51
|
15
|
|
|
|
|
20
|
my %new; |
52
|
15
|
100
|
|
|
|
17
|
my @p = @{ $params || [] }; |
|
15
|
|
|
|
|
68
|
|
53
|
15
|
|
|
|
|
57
|
my @f = $STRUCTS{$attr}->()->FIELDS; |
54
|
15
|
100
|
|
|
|
7183
|
confess "Too many parameters for attribute $attr" if @p > @f; |
55
|
14
|
|
|
|
|
36
|
for my $i ( 0 .. $#p ) |
56
|
|
|
|
|
|
|
{ |
57
|
8
|
|
|
|
|
27
|
$new{ $f[$i] } = $p[$i]; |
58
|
|
|
|
|
|
|
} |
59
|
14
|
|
|
|
|
19
|
my $obj = eval { $STRUCTS{$attr}->()->new(%new) }; |
|
14
|
|
|
|
|
36
|
|
60
|
14
|
100
|
|
|
|
6342
|
return $obj if $obj; |
61
|
3
|
|
|
|
|
8
|
chomp(my $msg = $@); |
62
|
3
|
|
|
|
|
5
|
$msg =~ s{ at \(.+?\) line \d+\.?}{}; |
63
|
3
|
|
|
|
|
577
|
confess $msg; |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
1; |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
__END__ |