| 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 | Config::INI::Serializer::deserialize |
| 3 | 1 | 1 | 317µs | 317µs | Config::INI::Serializer::new |
| 3 | 1 | 1 | 181µs | 186µs | Config::INI::Serializer::_set |
| 15 | 5 | 1 | 159µs | 159µs | Config::INI::Serializer::CORE:match (opcode) |
| 1 | 1 | 1 | 67µs | 84µs | main::BEGIN@1.5 |
| 1 | 1 | 1 | 56µs | 119µs | Config::INI::Serializer::BEGIN@130 |
| 1 | 1 | 1 | 37µs | 66µs | main::BEGIN@2.6 |
| 0 | 0 | 0 | 0s | 0s | Config::INI::Serializer::_get_branch |
| 0 | 0 | 0 | 0s | 0s | Config::INI::Serializer::_serialize |
| 0 | 0 | 0 | 0s | 0s | Config::INI::Serializer::serialize |
| 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 | 21 | 193µs | my ($self, $property_name, $property_value, $ref) = @_; | ||
| 79 | #$ref = $self if (!defined $ref); | ||||
| 80 | |||||
| 81 | my ($branch_name, $attrib, $type, $branch, $cache_ok); | ||||
| 82 | 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 | $branch = $ref; | ||||
| 92 | $attrib = $property_name; | ||||
| 93 | } | ||||
| 94 | |||||
| 95 | if (ref($branch) eq "ARRAY") { | ||||
| 96 | $branch->[$attrib] = $property_value; | ||||
| 97 | } | ||||
| 98 | else { | ||||
| 99 | $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 | 39 | 758µs | my ($self, $inidata) = @_; | ||
| 148 | my ($data, $r, $line, $attrib_base, $attrib, $value); | ||||
| 149 | |||||
| 150 | $data = {}; | ||||
| 151 | |||||
| 152 | $attrib_base = ""; | ||||
| 153 | foreach $line (split(/\n/, $inidata)) { | ||||
| 154 | 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 | 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 | 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 | 93µs | if ($line =~ /^ *([^ =]+) *= *(.*)$/) { # spent 93µs making 3 calls to Config::INI::Serializer::CORE:match, avg 31µs/call | ||
| 160 | $attrib = $attrib_base ? "$attrib_base.$1" : $1; | ||||
| 161 | $value = $2; | ||||
| 162 | 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 | 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 |