Filename | /home/ss5/perl5/perlbrew/perls/perl-5.14.1/lib/site_perl/5.14.1/Config/INI/Serializer.pm |
Statements | Executed 70 statements in 5.13ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
3 | 1 | 1 | 629µs | 969µs | deserialize | Config::INI::Serializer::
3 | 1 | 1 | 317µs | 317µs | new | Config::INI::Serializer::
3 | 1 | 1 | 181µs | 186µs | _set | Config::INI::Serializer::
15 | 5 | 1 | 159µs | 159µs | CORE:match (opcode) | Config::INI::Serializer::
1 | 1 | 1 | 67µs | 84µs | BEGIN@1.5 | main::
1 | 1 | 1 | 56µs | 119µs | BEGIN@130 | Config::INI::Serializer::
1 | 1 | 1 | 37µs | 66µs | BEGIN@2.6 | main::
0 | 0 | 0 | 0s | 0s | _get_branch | Config::INI::Serializer::
0 | 0 | 0 | 0s | 0s | _serialize | Config::INI::Serializer::
0 | 0 | 0 | 0s | 0s | serialize | Config::INI::Serializer::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | 2 | 106µs | 2 | 101µs | # spent 84µs (67+17) within main::BEGIN@1.5 which was called:
# once (67µs+17µs) by main::BEGIN@12 at line 1 # spent 84µs making 1 call to main::BEGIN@1.5
# spent 17µs making 1 call to strict::import |
2 | 2 | 2.62ms | 2 | 95µs | # spent 66µs (37+29) within main::BEGIN@2.6 which was called:
# once (37µs+29µs) by main::BEGIN@12 at line 2 # spent 66µs making 1 call to main::BEGIN@2.6
# spent 29µs making 1 call to warnings::import |
3 | package Config::INI::Serializer; | ||||
4 | |||||
5 | # ABSTRACT: non-standard round-trip INI serializer for nested data | ||||
6 | |||||
7 | |||||
8 | # lightweight OO to the extreme, as we really don't need more | ||||
9 | # spent 317µs within Config::INI::Serializer::new which was called 3 times, avg 106µs/call:
# 3 times (317µs+0s) by main::check at line 28 of t/app_dpath.t, avg 106µs/call | ||||
10 | 3 | 264µs | bless {}, shift; | ||
11 | } | ||||
12 | |||||
13 | ############################################################################# | ||||
14 | # _get_branch() | ||||
15 | ############################################################################# | ||||
16 | |||||
17 | # utility function, stolen from App::Reference, made internal here | ||||
18 | |||||
19 | sub _get_branch { | ||||
20 | my ($self, $branch_name, $create, $ref) = @_; | ||||
21 | my ($sub_branch_name, $branch_piece, $attrib, $type, $branch, $cache_ok); | ||||
22 | $ref = $self if (!defined $ref); | ||||
23 | |||||
24 | # check the cache quickly and return the branch if found | ||||
25 | $cache_ok = (ref($ref) ne "ARRAY" && $ref eq $self); # only cache from $self | ||||
26 | $branch = $ref->{_branch}{$branch_name} if ($cache_ok); | ||||
27 | return ($branch) if (defined $branch); | ||||
28 | |||||
29 | # not found, so we need to parse the $branch_name and walk the $ref tree | ||||
30 | $branch = $ref; | ||||
31 | $sub_branch_name = ""; | ||||
32 | |||||
33 | # these: "{field1}" "[3]" "field2." are all valid branch pieces | ||||
34 | while ($branch_name =~ s/^([\{\[]?)([^\.\[\]\{\}]+)([\.\]\}]?)//) { | ||||
35 | |||||
36 | $branch_piece = $2; | ||||
37 | $type = $3; | ||||
38 | $sub_branch_name .= ($3 eq ".") ? "$1$2" : "$1$2$3"; | ||||
39 | |||||
40 | if (ref($branch) eq "ARRAY") { | ||||
41 | if (! defined $branch->[$branch_piece]) { | ||||
42 | if ($create) { | ||||
43 | $branch->[$branch_piece] = ($type eq "]") ? [] : {}; | ||||
44 | $branch = $branch->[$branch_piece]; | ||||
45 | $ref->{_branch}{$sub_branch_name} = $branch if ($cache_ok); | ||||
46 | } | ||||
47 | else { | ||||
48 | return(undef); | ||||
49 | } | ||||
50 | } | ||||
51 | else { | ||||
52 | $branch = $branch->[$branch_piece]; | ||||
53 | $sub_branch_name .= "$1$2$3"; # accumulate the $sub_branch_name | ||||
54 | } | ||||
55 | } | ||||
56 | else { | ||||
57 | if (! defined $branch->{$branch_piece}) { | ||||
58 | if ($create) { | ||||
59 | $branch->{$branch_piece} = ($type eq "]") ? [] : {}; | ||||
60 | $branch = $branch->{$branch_piece}; | ||||
61 | $ref->{_branch}{$sub_branch_name} = $branch if ($cache_ok); | ||||
62 | } | ||||
63 | else { | ||||
64 | return(undef); | ||||
65 | } | ||||
66 | } | ||||
67 | else { | ||||
68 | $branch = $branch->{$branch_piece}; | ||||
69 | } | ||||
70 | } | ||||
71 | $sub_branch_name .= $type if ($type eq "."); | ||||
72 | } | ||||
73 | return $branch; | ||||
74 | } | ||||
75 | |||||
76 | # utility function, stolen from App::Reference, made internal here | ||||
77 | # spent 186µs (181+5) within Config::INI::Serializer::_set which was called 3 times, avg 62µs/call:
# 3 times (181µs+5µs) by Config::INI::Serializer::deserialize at line 162, avg 62µs/call | ||||
78 | 3 | 15µs | my ($self, $property_name, $property_value, $ref) = @_; | ||
79 | #$ref = $self if (!defined $ref); | ||||
80 | |||||
81 | 3 | 6µs | my ($branch_name, $attrib, $type, $branch, $cache_ok); | ||
82 | 3 | 39µs | 3 | 5µs | if ($property_name =~ /^(.*)([\.\{\[])([^\.\[\]\{\}]+)([\]\}]?)$/) { # spent 5µs making 3 calls to Config::INI::Serializer::CORE:match, avg 2µs/call |
83 | $branch_name = $1; | ||||
84 | $type = $2; | ||||
85 | $attrib = $3; | ||||
86 | $cache_ok = (ref($ref) ne "ARRAY" && $ref eq $self); | ||||
87 | $branch = $ref->{_branch}{$branch_name} if ($cache_ok); | ||||
88 | $branch = $self->_get_branch($1,1,$ref) if (!defined $branch); | ||||
89 | } | ||||
90 | else { | ||||
91 | 3 | 3µs | $branch = $ref; | ||
92 | 3 | 6µs | $attrib = $property_name; | ||
93 | } | ||||
94 | |||||
95 | 3 | 69µs | if (ref($branch) eq "ARRAY") { | ||
96 | $branch->[$attrib] = $property_value; | ||||
97 | } | ||||
98 | else { | ||||
99 | 3 | 54µs | $branch->{$attrib} = $property_value; | ||
100 | } | ||||
101 | } | ||||
102 | |||||
103 | sub serialize { | ||||
104 | my ($self, $data) = @_; | ||||
105 | $self->_serialize($data, ""); | ||||
106 | } | ||||
107 | |||||
108 | sub _serialize { | ||||
109 | my ($self, $data, $section) = @_; | ||||
110 | my ($section_data, $idx, $key, $elem); | ||||
111 | if (ref($data) eq "ARRAY") { | ||||
112 | for ($idx = 0; $idx <= $#$data; $idx++) { | ||||
113 | $elem = $data->[$idx]; | ||||
114 | if (!ref($elem)) { | ||||
115 | $section_data .= "[$section]\n" if (!$section_data && $section); | ||||
116 | $section_data .= "$idx = $elem\n"; | ||||
117 | } | ||||
118 | } | ||||
119 | for ($idx = 0; $idx <= $#$data; $idx++) { | ||||
120 | $elem = $data->[$idx]; | ||||
121 | if (ref($elem)) { | ||||
122 | $section_data .= $self->_serialize($elem, $section ? "$section.$idx" : $idx); | ||||
123 | } | ||||
124 | } | ||||
125 | } | ||||
126 | elsif (ref($data)) { | ||||
127 | foreach $key (sort keys %$data) { | ||||
128 | $elem = $data->{$key}; | ||||
129 | if (!ref($elem)) { | ||||
130 | 2 | 1.18ms | 2 | 183µs | # spent 119µs (56+63) within Config::INI::Serializer::BEGIN@130 which was called:
# once (56µs+63µs) by main::BEGIN@12 at line 130 # spent 119µs making 1 call to Config::INI::Serializer::BEGIN@130
# spent 63µs making 1 call to warnings::unimport |
131 | $section_data .= "[$section]\n" if (!$section_data && $section); | ||||
132 | $section_data .= "$key = $elem\n"; | ||||
133 | } | ||||
134 | } | ||||
135 | foreach $key (sort keys %$data) { | ||||
136 | $elem = $data->{$key}; | ||||
137 | if (ref($elem)) { | ||||
138 | $section_data .= $self->_serialize($elem, $section ? "$section.$key" : $key); | ||||
139 | } | ||||
140 | } | ||||
141 | } | ||||
142 | |||||
143 | return $section_data; | ||||
144 | } | ||||
145 | |||||
146 | # spent 969µs (629+340) within Config::INI::Serializer::deserialize which was called 3 times, avg 323µs/call:
# 3 times (629µs+340µs) by main::check at line 28 of t/app_dpath.t, avg 323µs/call | ||||
147 | 3 | 48µs | my ($self, $inidata) = @_; | ||
148 | 3 | 7µs | my ($data, $r, $line, $attrib_base, $attrib, $value); | ||
149 | |||||
150 | 3 | 15µs | $data = {}; | ||
151 | |||||
152 | 3 | 6µs | $attrib_base = ""; | ||
153 | 3 | 77µs | foreach $line (split(/\n/, $inidata)) { | ||
154 | 3 | 118µs | 3 | 44µs | next if ($line =~ /^;/); # ignore comments # spent 44µs making 3 calls to Config::INI::Serializer::CORE:match, avg 14µs/call |
155 | 3 | 49µs | 3 | 6µs | next if ($line =~ /^#/); # ignore comments # spent 6µs making 3 calls to Config::INI::Serializer::CORE:match, avg 2µs/call |
156 | 3 | 49µs | 3 | 12µs | if ($line =~ /^\[([^\[\]]+)\] *$/) { # i.e. [Repository.default] # spent 12µs making 3 calls to Config::INI::Serializer::CORE:match, avg 4µs/call |
157 | $attrib_base = $1; | ||||
158 | } | ||||
159 | 3 | 168µs | 3 | 93µs | if ($line =~ /^ *([^ =]+) *= *(.*)$/) { # spent 93µs making 3 calls to Config::INI::Serializer::CORE:match, avg 31µs/call |
160 | 3 | 78µs | $attrib = $attrib_base ? "$attrib_base.$1" : $1; | ||
161 | 3 | 38µs | $value = $2; | ||
162 | 3 | 53µs | 3 | 186µs | $self->_set($attrib, $value, $data); # spent 186µs making 3 calls to Config::INI::Serializer::_set, avg 62µs/call |
163 | } | ||||
164 | } | ||||
165 | 3 | 51µs | return $data; | ||
166 | } | ||||
167 | |||||
168 | # END stolen ::App::Serialize::Ini | ||||
169 | |||||
170 | 1 | 12µs | 1; | ||
171 | |||||
172 | __END__ | ||||
# spent 159µs within Config::INI::Serializer::CORE:match which was called 15 times, avg 11µs/call:
# 3 times (93µs+0s) by Config::INI::Serializer::deserialize at line 159, avg 31µs/call
# 3 times (44µs+0s) by Config::INI::Serializer::deserialize at line 154, avg 14µs/call
# 3 times (12µs+0s) by Config::INI::Serializer::deserialize at line 156, avg 4µs/call
# 3 times (6µs+0s) by Config::INI::Serializer::deserialize at line 155, avg 2µs/call
# 3 times (5µs+0s) by Config::INI::Serializer::_set at line 82, avg 2µs/call |