line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Data::DEC::Declaration; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
7
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
52
|
|
4
|
1
|
|
|
1
|
|
6
|
use Parse::Highlife::Utils qw(params); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
50
|
|
5
|
1
|
|
|
1
|
|
1337
|
use Data::Dumper; |
|
1
|
|
|
|
|
8862
|
|
|
1
|
|
|
|
|
1129
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
our $UnnamedCounter = 0; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
sub new |
10
|
|
|
|
|
|
|
{ |
11
|
0
|
|
|
0
|
0
|
|
my( $class, @args ) = @_; |
12
|
0
|
|
|
|
|
|
my $self = bless {}, $class; |
13
|
0
|
|
|
|
|
|
return $self -> _init( @args ); |
14
|
|
|
|
|
|
|
} |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
sub _init |
17
|
|
|
|
|
|
|
{ |
18
|
|
|
|
|
|
|
# type: identifier | string | number | real | map |
19
|
|
|
|
|
|
|
# valuetype: name of the map declaration |
20
|
0
|
|
|
0
|
|
|
my( $self, $name, $type, $value, $valuetype ) = @_; |
21
|
0
|
0
|
|
|
|
|
$valuetype = '' unless defined $valuetype; |
22
|
0
|
0
|
0
|
|
|
|
if( ! defined $name || ! length $name ) { |
23
|
0
|
|
|
|
|
|
$name = $UnnamedCounter; |
24
|
0
|
|
|
|
|
|
$UnnamedCounter ++; |
25
|
|
|
|
|
|
|
} |
26
|
0
|
|
|
|
|
|
$self->{'name'} = $name; |
27
|
0
|
|
|
|
|
|
$self->{'type'} = $type; |
28
|
0
|
|
|
|
|
|
$self->{'value'} = $value; |
29
|
0
|
|
|
|
|
|
$self->{'value-type'} = $valuetype; |
30
|
0
|
|
|
|
|
|
return $self; |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
sub name |
34
|
|
|
|
|
|
|
{ |
35
|
0
|
|
|
0
|
0
|
|
my( $self ) = @_; |
36
|
0
|
|
|
|
|
|
return $self->{'name'}; |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
sub type |
40
|
|
|
|
|
|
|
{ |
41
|
0
|
|
|
0
|
0
|
|
my( $self ) = @_; |
42
|
0
|
|
|
|
|
|
return $self->{'type'}; |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
sub value |
46
|
|
|
|
|
|
|
{ |
47
|
0
|
|
|
0
|
0
|
|
my( $self ) = @_; |
48
|
0
|
|
|
|
|
|
return $self->{'value'}; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub valuetype |
52
|
|
|
|
|
|
|
{ |
53
|
0
|
|
|
0
|
0
|
|
my( $self ) = @_; |
54
|
0
|
|
|
|
|
|
return $self->{'value-type'}; |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub subvalue |
58
|
|
|
|
|
|
|
{ |
59
|
0
|
|
|
0
|
0
|
|
my( $self, @args ) = @_; |
60
|
0
|
|
|
|
|
|
return $self->subvalues( @args ); |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sub subvalues |
64
|
|
|
|
|
|
|
{ |
65
|
0
|
|
|
0
|
0
|
|
my( $self, $subvalue_key_name ) = @_; |
66
|
0
|
0
|
|
|
|
|
return () if ref $self->{'value'} ne 'ARRAY'; |
67
|
0
|
|
|
|
|
|
my @subvalues; |
68
|
0
|
|
|
|
|
|
foreach my $pair ( @{ $self->{'value'} } ) { |
|
0
|
|
|
|
|
|
|
69
|
0
|
|
|
|
|
|
my( $name, $value ) = @{$pair}; |
|
0
|
|
|
|
|
|
|
70
|
0
|
0
|
0
|
|
|
|
push @subvalues, $value |
71
|
|
|
|
|
|
|
if ! defined $subvalue_key_name || $name eq $subvalue_key_name; |
72
|
|
|
|
|
|
|
} |
73
|
0
|
0
|
|
|
|
|
return (wantarray() ? @subvalues : shift @subvalues); |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
sub unique_subvalues |
77
|
|
|
|
|
|
|
{ |
78
|
0
|
|
|
0
|
0
|
|
my( $self ) = @_; |
79
|
0
|
0
|
|
|
|
|
return () if ref $self->{'value'} ne 'ARRAY'; |
80
|
0
|
|
|
|
|
|
my %subvalues; |
81
|
0
|
|
|
|
|
|
foreach my $pair ( @{ $self->{'value'} } ) { |
|
0
|
|
|
|
|
|
|
82
|
0
|
|
|
|
|
|
my( $name, $value ) = @{$pair}; |
|
0
|
|
|
|
|
|
|
83
|
0
|
|
|
|
|
|
$subvalues{ $name } = $value; |
84
|
|
|
|
|
|
|
} |
85
|
0
|
|
|
|
|
|
return %subvalues; |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub dump |
89
|
|
|
|
|
|
|
{ |
90
|
0
|
|
|
0
|
0
|
|
my( $self ) = @_; |
91
|
0
|
|
|
|
|
|
my $w = 16; |
92
|
0
|
|
|
|
|
|
print sprintf('%-'.$w.'s', '#'.$self->{'name'}.' '); |
93
|
0
|
0
|
|
|
|
|
print $self->{'value-type'}.' ' if length $self->{'value-type'}; |
94
|
0
|
0
|
|
|
|
|
if( $self->{'type'} eq 'map' ) { |
|
|
0
|
|
|
|
|
|
95
|
0
|
|
|
|
|
|
print "{\n"; |
96
|
0
|
|
|
|
|
|
map { |
97
|
0
|
|
|
|
|
|
my( $name, $value ) = @{$_}; |
|
0
|
|
|
|
|
|
|
98
|
0
|
|
|
|
|
|
print ''.(' ' x $w)." $name: #".$value->{'name'}."\n"; |
99
|
0
|
|
|
|
|
|
} @{$self->{'value'}}; |
100
|
0
|
|
|
|
|
|
print ''.(' ' x $w)."}"; |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
elsif( $self->{'type'} eq 'string' ) { |
103
|
0
|
|
|
|
|
|
my $s = $self->{'value'}; |
104
|
0
|
|
|
|
|
|
$s =~ s/\n/\\n/g; |
105
|
0
|
|
|
|
|
|
$s =~ s/\r/\\r/g; |
106
|
0
|
|
|
|
|
|
$s =~ s/"/\\"/g; |
107
|
0
|
|
|
|
|
|
print "\"$s\""; |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
else { |
110
|
0
|
|
|
|
|
|
print $self->{'value'}; |
111
|
|
|
|
|
|
|
} |
112
|
0
|
|
|
|
|
|
print "\n"; |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
1; |
116
|
|
|
|
|
|
|
|