line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package ex::constant::vars; |
2
|
|
|
|
|
|
|
|
3
|
4
|
|
|
4
|
|
99876
|
use 5.006; |
|
4
|
|
|
|
|
15
|
|
|
4
|
|
|
|
|
143
|
|
4
|
4
|
|
|
4
|
|
20
|
use strict; |
|
4
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
130
|
|
5
|
4
|
|
|
4
|
|
24
|
use warnings; |
|
4
|
|
|
|
|
11
|
|
|
4
|
|
|
|
|
184
|
|
6
|
4
|
|
|
4
|
|
21
|
use Carp; |
|
4
|
|
|
|
|
5
|
|
|
4
|
|
|
|
|
2303
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
require Exporter; |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
our $VERSION = '0.05'; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our @ISA = qw( |
13
|
|
|
|
|
|
|
Exporter |
14
|
|
|
|
|
|
|
ex::constant::vars::scalar |
15
|
|
|
|
|
|
|
ex::constant::vars::array |
16
|
|
|
|
|
|
|
ex::constant::vars::hash |
17
|
|
|
|
|
|
|
); |
18
|
|
|
|
|
|
|
our @EXPORT_OK = qw( const SCALAR ARRAY HASH ); |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub const { |
21
|
14
|
|
|
14
|
1
|
20
|
my $type = shift; |
22
|
14
|
|
|
|
|
40
|
my @values = splice @_, 1; |
23
|
14
|
100
|
|
|
|
57
|
if ( $type eq 'scalar' ) { |
|
|
100
|
|
|
|
|
|
24
|
4
|
|
|
|
|
5
|
return tie ${$_[0]}, __PACKAGE__ . '::' . $type, @values; |
|
4
|
|
|
|
|
25
|
|
25
|
|
|
|
|
|
|
} elsif ( $type eq 'array' ) { |
26
|
5
|
|
|
|
|
8
|
return tie @{$_[0]}, __PACKAGE__ . '::' . $type, @values; |
|
5
|
|
|
|
|
137
|
|
27
|
|
|
|
|
|
|
} else { |
28
|
5
|
|
|
|
|
9
|
return tie %{$_[0]}, __PACKAGE__ . '::' . $type, @values; |
|
5
|
|
|
|
|
29
|
|
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
4
|
|
|
4
|
|
22
|
sub SCALAR (\$$) { 'scalar', @_ } |
33
|
5
|
|
|
5
|
0
|
438
|
sub ARRAY (\@@) { 'array', @_ } |
34
|
5
|
|
|
5
|
0
|
23
|
sub HASH (\%%) { 'hash', @_ } |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
sub import { |
37
|
6
|
|
|
6
|
|
51
|
my $self = shift; |
38
|
6
|
100
|
|
|
|
2246
|
return unless @_; |
39
|
4
|
100
|
66
|
|
|
30
|
if ( @_ == 1 && $_[0] eq 'const' ) { |
40
|
2
|
|
|
|
|
3881
|
$self->export_to_level( 1, $self, @EXPORT_OK ); |
41
|
|
|
|
|
|
|
} else { |
42
|
2
|
|
|
|
|
12
|
my %variables = @_; |
43
|
2
|
|
|
|
|
4
|
my $caller = caller( 0 ); |
44
|
2
|
|
|
|
|
14
|
while ( my( $var, $val ) = each %variables ) { |
45
|
7
|
|
|
|
|
17
|
my( $prefix, $name ) = split //, $var, 2; |
46
|
7
|
50
|
|
|
|
28
|
croak "'$var' not a valid variable name" unless $prefix =~ /^[\$\@\%]$/; |
47
|
7
|
100
|
|
|
|
23
|
if ( $prefix eq '$' ) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
48
|
4
|
|
|
4
|
|
22
|
no strict 'refs'; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
611
|
|
49
|
2
|
|
|
|
|
3
|
*{__PACKAGE__ . "::variables::$name"} = \$val; |
|
2
|
|
|
|
|
15
|
|
50
|
2
|
|
|
|
|
4
|
*{"${caller}::$name"} = \${__PACKAGE__ . "::variables::$name"}; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
8
|
|
51
|
2
|
|
|
|
|
4
|
const SCALAR ${"${caller}::$name"}, $val; |
|
2
|
|
|
|
|
6
|
|
52
|
|
|
|
|
|
|
} elsif ( $prefix eq '@' ) { |
53
|
4
|
|
|
4
|
|
21
|
no strict 'refs'; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
604
|
|
54
|
2
|
|
|
|
|
3
|
*{__PACKAGE__ . "::variables::$name"} = \@{$val}; |
|
2
|
|
|
|
|
9
|
|
|
2
|
|
|
|
|
2
|
|
55
|
2
|
|
|
|
|
3
|
*{"${caller}::$name"} = \@{__PACKAGE__ . "::variables::$name"}; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
5
|
|
56
|
2
|
|
|
|
|
2
|
const ARRAY @{"${caller}::$name"}, @{$val}; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
6
|
|
57
|
|
|
|
|
|
|
} elsif ( $prefix eq '%' ) { |
58
|
4
|
|
|
4
|
|
20
|
no strict 'refs'; |
|
4
|
|
|
|
|
5
|
|
|
4
|
|
|
|
|
524
|
|
59
|
3
|
|
|
|
|
3
|
*{__PACKAGE__ . "::variables::$name"} = \%{$val}; |
|
3
|
|
|
|
|
17
|
|
|
3
|
|
|
|
|
6
|
|
60
|
3
|
|
|
|
|
6
|
*{"${caller}::$name"} = \%{__PACKAGE__ . "::variables::$name"}; |
|
3
|
|
|
|
|
11
|
|
|
3
|
|
|
|
|
8
|
|
61
|
3
|
|
|
|
|
3
|
const HASH %{"${caller}::$name"}, %{$val}; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
9
|
|
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
package ex::constant::vars::scalar; |
69
|
4
|
|
|
4
|
|
63
|
use Carp; |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
606
|
|
70
|
|
|
|
|
|
|
$Carp::CarpLevel = 1; |
71
|
7
|
|
|
7
|
|
519
|
sub TIESCALAR { shift; bless \(my $scalar = shift), __PACKAGE__ } |
|
7
|
|
|
|
|
54
|
|
72
|
15
|
|
|
15
|
|
2950
|
sub FETCH { ${$_[0]} } |
|
15
|
|
|
|
|
82
|
|
73
|
8
|
|
|
8
|
|
1730
|
sub STORE { croak "Modification of a read-only value attempted" } |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
package ex::constant::vars::array; |
77
|
4
|
|
|
4
|
|
91
|
use Carp; |
|
4
|
|
|
|
|
4
|
|
|
4
|
|
|
|
|
868
|
|
78
|
|
|
|
|
|
|
$Carp::CarpLevel = 1; |
79
|
7
|
|
|
7
|
|
14
|
sub TIEARRAY { shift; bless $_=\@_, __PACKAGE__ } |
|
7
|
|
|
|
|
50
|
|
80
|
38
|
|
|
38
|
|
456
|
sub FETCH { $_[0]->[$_[1]] } |
81
|
15
|
|
|
15
|
|
3633
|
sub FETCHSIZE { @{$_[0]} } |
|
15
|
|
|
|
|
70
|
|
82
|
1
|
|
|
1
|
|
260
|
sub EXISTS { exists $_[0]->[$_[1]] } |
83
|
13
|
|
|
13
|
|
2499
|
sub STORE { croak "Modification of a read-only value attempted" } |
84
|
|
|
|
|
|
|
*CLEAR = *EXTEND = *POP = *PUSH = *SHIFT = |
85
|
|
|
|
|
|
|
*UNSHIFT = *SPLICE = *STORESIZE = *DELETE = \*STORE; |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
package ex::constant::vars::hash; |
89
|
4
|
|
|
4
|
|
55
|
use Carp; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
1079
|
|
90
|
|
|
|
|
|
|
$Carp::CarpLevel = 1; |
91
|
7
|
|
|
7
|
|
4686
|
sub TIEHASH { bless {@_[1...$#_]}, __PACKAGE__ } |
92
|
56
|
|
|
56
|
|
563
|
sub FETCH { $_[0]->{$_[1]} } |
93
|
19
|
|
|
19
|
|
4521
|
sub FIRSTKEY { keys %{$_[0]}; each %{$_[0]} } |
|
19
|
|
|
|
|
50
|
|
|
19
|
|
|
|
|
25
|
|
|
19
|
|
|
|
|
70
|
|
94
|
56
|
|
|
56
|
|
63
|
sub NEXTKEY { each %{$_[0]} } |
|
56
|
|
|
|
|
150
|
|
95
|
1
|
|
|
1
|
|
11
|
sub EXISTS { exists $_[0]->{$_[1]} } |
96
|
15
|
|
|
15
|
|
3250
|
sub STORE { croak "Modification of a read-only value attempted" } |
97
|
|
|
|
|
|
|
*CLEAR = *DELETE = \*STORE; |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
1; |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
__END__ |