line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Constructor::Sugar; |
2
|
|
|
|
|
|
|
|
3
|
4
|
|
|
4
|
|
103374
|
use strictures 2; |
|
4
|
|
|
|
|
33
|
|
|
4
|
|
|
|
|
162
|
|
4
|
|
|
|
|
|
|
|
5
|
4
|
|
|
4
|
|
3159
|
use String::CamelCase 'decamelize'; |
|
4
|
|
|
|
|
2687
|
|
|
4
|
|
|
|
|
328
|
|
6
|
4
|
|
|
4
|
|
1812
|
use Throwable::SugarFactory::Utils '_getglob'; |
|
4
|
|
|
|
|
12
|
|
|
4
|
|
|
|
|
1470
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
our $VERSION = '0.213360'; # VERSION |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
# ABSTRACT: export constructor syntax sugar |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
# |
13
|
|
|
|
|
|
|
# This file is part of Throwable-SugarFactory |
14
|
|
|
|
|
|
|
# |
15
|
|
|
|
|
|
|
# |
16
|
|
|
|
|
|
|
# Christian Walde has dedicated the work to the Commons by waiving all of his |
17
|
|
|
|
|
|
|
# or her rights to the work worldwide under copyright law and all related or |
18
|
|
|
|
|
|
|
# neighboring legal rights he or she had in the work, to the extent allowable by |
19
|
|
|
|
|
|
|
# law. |
20
|
|
|
|
|
|
|
# |
21
|
|
|
|
|
|
|
# Works under CC0 do not require attribution. When citing the work, you should |
22
|
|
|
|
|
|
|
# not imply endorsement by the author. |
23
|
|
|
|
|
|
|
# |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
sub _export { |
27
|
23
|
|
|
23
|
|
71
|
my ( $pkg, $func, $code ) = @_; |
28
|
23
|
|
|
|
|
62
|
*{ _getglob $pkg, $func } = $code; |
|
23
|
|
|
|
|
66
|
|
29
|
22
|
|
|
|
|
79
|
return $func; |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
sub import { |
33
|
13
|
|
|
13
|
|
2831
|
my ( undef, @specs ) = @_; |
34
|
13
|
|
|
|
|
38
|
my $target = caller; |
35
|
13
|
|
|
|
|
28
|
my ( @constructors, @iders ); |
36
|
|
|
|
|
|
|
|
37
|
13
|
|
|
|
|
36
|
for my $spec ( @specs ) { |
38
|
13
|
|
|
|
|
54
|
my ( $class, $method ) = split /->/, $spec; |
39
|
13
|
|
100
|
|
|
70
|
$method ||= "new"; |
40
|
13
|
|
|
|
|
44
|
my $id = ( reverse split /::/, $class )[0]; |
41
|
13
|
|
|
|
|
48
|
my $ct = decamelize $id; |
42
|
13
|
100
|
|
|
|
509
|
die "Converting '$id' into a snake_case constructor did not result in" |
43
|
|
|
|
|
|
|
. " a different string." |
44
|
|
|
|
|
|
|
if $ct eq $id; |
45
|
|
|
|
|
|
|
|
46
|
12
|
|
|
10
|
|
75
|
push @constructors, _export $target, $ct, sub { $class->$method( @_ ) }; |
|
10
|
|
|
|
|
31252
|
|
47
|
11
|
|
|
21
|
|
49
|
push @iders, _export $target, $id, sub { $class }; |
|
21
|
|
|
|
|
18369
|
|
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
11
|
|
|
|
|
2048
|
return ( \@constructors, \@iders ); |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
1; |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
__END__ |