← Index
NYTProf Performance Profile   « line view »
For split.pl
  Run on Thu Apr 20 02:05:47 2023
Reported on Thu Apr 20 18:31:10 2023

Filename/home/hejohns/perl5/lib/perl5/Data/Printer/Config.pm
StatementsExecuted 89 statements in 1.58ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11143µs208µsData::Printer::Config::::_get_first_rc_file_availableData::Printer::Config::_get_first_rc_file_available
11121µs78µsData::Printer::Config::::_project_homeData::Printer::Config::_project_home
11121µs21µsData::Printer::Config::::CORE:globData::Printer::Config::CORE:glob (opcode)
92119µs19µsData::Printer::Config::::CORE:ftfileData::Printer::Config::CORE:ftfile (opcode)
1119µs11µsData::Printer::Config::::BEGIN@2Data::Printer::Config::BEGIN@2
1116µs27µsData::Printer::Config::::_my_homeData::Printer::Config::_my_home
1115µs6µsData::Printer::Config::::BEGIN@4Data::Printer::Config::BEGIN@4
1114µs10µsData::Printer::Config::::_my_cwdData::Printer::Config::_my_cwd
1113µs23µsData::Printer::Config::::BEGIN@3Data::Printer::Config::BEGIN@3
1113µs5µsData::Printer::Config::::load_rc_fileData::Printer::Config::load_rc_file
1112µs2µsData::Printer::Config::::CORE:ftisData::Printer::Config::CORE:ftis (opcode)
111300ns300nsData::Printer::Config::::__ANON__Data::Printer::Config::__ANON__ (xsub)
0000s0sData::Printer::Config::::__ANON__[:267]Data::Printer::Config::__ANON__[:267]
0000s0sData::Printer::Config::::__ANON__[:90]Data::Printer::Config::__ANON__[:90]
0000s0sData::Printer::Config::::_convertData::Printer::Config::_convert
0000s0sData::Printer::Config::::_expand_profileData::Printer::Config::_expand_profile
0000s0sData::Printer::Config::::_file_mode_is_restrictedData::Printer::Config::_file_mode_is_restricted
0000s0sData::Printer::Config::::_merge_optionsData::Printer::Config::_merge_options
0000s0sData::Printer::Config::::_str2dataData::Printer::Config::_str2data
0000s0sData::Printer::Config::::convertData::Printer::Config::convert
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package Data::Printer::Config;
2218µs214µs
# spent 11µs (9+3) within Data::Printer::Config::BEGIN@2 which was called: # once (9µs+3µs) by Data::Printer::BEGIN@6 at line 2
use strict;
# spent 11µs making 1 call to Data::Printer::Config::BEGIN@2 # spent 3µs making 1 call to strict::import
3213µs242µs
# spent 23µs (3+19) within Data::Printer::Config::BEGIN@3 which was called: # once (3µs+19µs) by Data::Printer::BEGIN@6 at line 3
use warnings;
# spent 23µs making 1 call to Data::Printer::Config::BEGIN@3 # spent 19µs making 1 call to warnings::import
421.37ms26µs
# spent 6µs (5+300ns) within Data::Printer::Config::BEGIN@4 which was called: # once (5µs+300ns) by Data::Printer::BEGIN@6 at line 4
use Data::Printer::Common;
# spent 6µs making 1 call to Data::Printer::Config::BEGIN@4 # spent 300ns making 1 call to Data::Printer::Config::__ANON__
5
6
# spent 5µs (3+2) within Data::Printer::Config::load_rc_file which was called: # once (3µs+2µs) by Data::Printer::_initialize at line 50 of Data/Printer.pm
sub load_rc_file {
71400ns my ($filename) = @_;
81200ns if (!$filename) {
9 $filename = _get_first_rc_file_available();
10 }
1115µs12µs return unless $filename && -e $filename && !-d $filename;
# spent 2µs making 1 call to Data::Printer::Config::CORE:ftis
12 if (open my $fh, '<', $filename) {
13
14 # slurp the file:
15 my $rc_data;
16 { local $/ = undef; $rc_data = <$fh> }
17 close $fh;
18 return _str2data($filename, $rc_data);
19 }
20 else {
21 Data::Printer::Common::_warn(undef, "error opening '$filename': $!");
22 return;
23 }
24}
25
26
# spent 208µs (43+165) within Data::Printer::Config::_get_first_rc_file_available which was called: # once (43µs+165µs) by Data::Printer::_initialize at line 49 of Data/Printer.pm
sub _get_first_rc_file_available {
271400ns return $ENV{DATAPRINTERRC} if exists $ENV{DATAPRINTERRC};
28
29 # look for a .dataprinter file on the project home up until we reach '/'
301500ns178µs my $dir = _project_home();
# spent 78µs making 1 call to Data::Printer::Config::_project_home
311200ns require File::Spec;
321200ns while (defined $dir) {
33833µs3239µs my $file = File::Spec->catfile($dir, '.dataprinter');
# spent 26µs making 8 calls to File::Spec::Unix::catfile, avg 3µs/call # spent 10µs making 8 calls to File::Spec::Unix::catdir, avg 1µs/call # spent 3µs making 16 calls to File::Spec::Unix::canonpath, avg 188ns/call
34818µs813µs return $file if -f $file;
# spent 13µs making 8 calls to Data::Printer::Config::CORE:ftfile, avg 2µs/call
3587µs86µs my @path = File::Spec->splitdir($dir);
# spent 6µs making 8 calls to File::Spec::Unix::splitdir, avg 725ns/call
368600ns last unless @path;
37821µs1613µs my $updir = File::Spec->catdir(@path[0..$#path-1]);
# spent 11µs making 8 calls to File::Spec::Unix::catdir, avg 1µs/call # spent 2µs making 8 calls to File::Spec::Unix::canonpath, avg 212ns/call
3882µs last if !defined $updir || $updir eq $dir;
3973µs $dir = $updir;
40 }
41 # still here? look for .dataprinter on the user's HOME:
4218µs535µs return File::Spec->catfile( _my_home(), '.dataprinter');
# spent 27µs making 1 call to Data::Printer::Config::_my_home # spent 5µs making 1 call to File::Spec::Unix::catfile # spent 2µs making 1 call to File::Spec::Unix::catdir # spent 400ns making 2 calls to File::Spec::Unix::canonpath, avg 200ns/call
43}
44
45
# spent 10µs (4+6) within Data::Printer::Config::_my_cwd which was called: # once (4µs+6µs) by Data::Printer::Config::_project_home at line 66
sub _my_cwd {
461200ns require Cwd;
4719µs16µs my $cwd = Cwd::getcwd();
# spent 6µs making 1 call to Cwd::getcwd
48 # try harder if we can't access the current dir.
491100ns $cwd = Cwd::cwd() unless defined $cwd;
5012µs return $cwd;
51}
52
53
# spent 78µs (21+56) within Data::Printer::Config::_project_home which was called: # once (21µs+56µs) by Data::Printer::Config::_get_first_rc_file_available at line 30
sub _project_home {
541700ns require Cwd;
551100ns my $path;
561800ns if ($0 eq '-e' || $0 eq '-') {
57 my $cwd = _my_cwd();
58 $path = Cwd::abs_path($cwd) if defined $cwd;
59 }
60 else {
611300ns my $script = $0;
62110µs16µs return unless -f $script;
# spent 6µs making 1 call to Data::Printer::Config::CORE:ftfile
631500ns require File::Spec;
641400ns require File::Basename;
65 # we need the full path if we have chdir'd:
66118µs627µs $script = File::Spec->catfile(_my_cwd(), $script)
# spent 10µs making 1 call to Data::Printer::Config::_my_cwd # spent 9µs making 1 call to File::Spec::Unix::catfile # spent 4µs making 1 call to File::Spec::Unix::file_name_is_absolute # spent 2µs making 1 call to File::Spec::Unix::catdir # spent 1µs making 2 calls to File::Spec::Unix::canonpath, avg 550ns/call
67 unless File::Spec->file_name_is_absolute($script);
6812µs114µs my (undef, $maybe_path) = File::Basename::fileparse($script);
# spent 14µs making 1 call to File::Basename::fileparse
69115µs113µs $path = Cwd::abs_path($maybe_path) if defined $maybe_path;
# spent 13µs making 1 call to Cwd::abs_path
70 }
7112µs return $path;
72}
73
74# adapted from File::HomeDir && File::HomeDir::Tiny
75
# spent 27µs (6+21) within Data::Printer::Config::_my_home which was called: # once (6µs+21µs) by Data::Printer::Config::_get_first_rc_file_available at line 42
sub _my_home {
761400ns my ($testing) = @_;
7712µs if ($testing) {
78 require File::Temp;
79 require File::Spec;
80 my $BASE = File::Temp::tempdir( CLEANUP => 1 );
81 my $home = File::Spec->catdir( $BASE, 'my_home' );
82 $ENV{HOME} = $home;
83 mkdir($home, 0755) unless -d $home;
84 return $home;
85 }
86 elsif ($^O eq 'MSWin32' and "$]" < 5.016) {
87 return $ENV{HOME} || $ENV{USERPROFILE};
88 }
89 elsif ($^O eq 'MacOS') {
90 my $error = _tryme(sub { require Mac::SystemDirectory; 1 });
91 return Mac::SystemDirectory::HomeDirectory() unless $error;
92 }
93 # this is the most common case, for most breeds of unix, as well as
94 # MSWin32 in more recent perls.
95124µs121µs my $home = (<~>)[0];
# spent 21µs making 1 call to Data::Printer::Config::CORE:glob
9612µs return $home if $home;
97
98 # desperate measures that should never be needed.
99 if (exists $ENV{LOGDIR} and $ENV{LOGDIR}) {
100 $home = $ENV{LOGDIR};
101 }
102 if (not $home and exists $ENV{HOME} and $ENV{HOME}) {
103 $home = $ENV{HOME};
104 }
105 # Light desperation on any (Unixish) platform
106 SCOPE: { $home = (getpwuid($<))[7] if not defined $home }
107 if (defined $home and ! -d $home ) {
108 $home = undef;
109 }
110 return $home;
111}
112
113sub _file_mode_is_restricted {
114 my ($filename) = @_;
115 my $mode_raw = (stat($filename))[2];
116 return 0 unless defined $mode_raw;
117 my $mode = sprintf('%04o', $mode_raw & 07777);
118 return (length($mode) == 4 && substr($mode, 2, 2) eq '00') ? 1 : 0;
119}
120
121sub _str2data {
122 my ($filename, $content) = @_;
123 my $config = { _ => {} };
124 my $counter = 0;
125 my $filter;
126 my $can_use_filters;
127 my $ns = '_';
128 # based on Config::Tiny
129 foreach ( split /(?:\015{1,2}\012|\015|\012)/, $content ) {
130 $counter++;
131 if (defined $filter) {
132 if ( /^end filter\s*$/ ) {
133 if (!defined $can_use_filters) {
134 $can_use_filters = _file_mode_is_restricted($filename);
135 }
136 if ($can_use_filters) {
137 my $sub_str = 'sub { my ($obj, $ddp) = @_; '
138 . $filter->{code_str}
139 . '}'
140 ;
141 push @{$config->{$ns}{filters}}, +{ $filter->{name} => eval $sub_str };
142 }
143 else {
144 Data::Printer::Common::_warn(undef, "ignored filter '$filter->{name}' from rc file '$filename': file is readable/writeable by others");
145 }
146 $filter = undef;
147 }
148 elsif ( /^begin\s+filter/ ) {
149 Data::Printer::Common::_warn(undef, "error reading rc file '$filename' line $counter: found 'begin filter' inside another filter definition ($filter->{name}). Are you missing an 'end filter' on line " . ($counter - 1) . '?');
150 return {};
151 }
152 else {
153 $filter->{code_str} .= $_;
154 }
155 }
156 elsif ( /^\s*(?:\#|\;|$)/ ) {
157 next # skip comments and empty lines
158 }
159 elsif ( /^\s*\[\s*(.+?)\s*\]\s*$/ ) {
160 # Create the sub-hash if it doesn't exist.
161 # Without this, sections without keys will not
162 # appear at all in the completed struct.
163 $config->{$ns = $1} ||= {};
164 }
165 elsif ( /^\s*([^=]+?)\s*=\s*(.*?)\s*$/ ) {
166 # Handle properties:
167 my ($path_str, $value) = ($1, $2);
168 # turn a.b.c.d into {a}{b}{c}{d}
169 my @subpath = split /\./, $path_str;
170 my $current = $config->{$ns};
171
172 # remove single/double (enclosing) quotes
173 $value =~ s/\A(['"])(.*)\1\z/$2/;
174
175 # the root "filters" key is a special case, because we want
176 # it to always be an arrayref. In other words:
177 # filters = abc,def --> filters => ['abc', 'def']
178 # filters = abc --> filters => ['abc']
179 # filters = --> filters => []
180 if (@subpath == 1 && $subpath[0] eq 'filters') {
181 $value = [ split /\s*,\s*/ => $value ];
182 }
183
184 while (my $subpath = shift @subpath) {
185 if (@subpath > 0) {
186 $current->{$subpath} ||= {};
187 $current = $current->{$subpath};
188 }
189 else {
190 $current->{$subpath} = $value;
191 }
192 }
193 }
194 elsif ( /^begin\s+filter\s+([^\s]+)\s*$/ ) {
195 my $filter_name = $1;
196 $filter = { name => $filter_name, code_str => '' };
197 }
198 else {
199 Data::Printer::Common::_warn(undef, "error reading rc file '$filename': syntax error at line $counter: $_");
200 if ($counter == 1 && /\A\s*\{/s) {
201 Data::Printer::Common::_warn(
202 undef,
203 "\nRC file format changed in 1.00. Usually all it takes is:\n"
204 . " cp $filename $filename.old && perl -MData::Printer::Config -E 'say Data::Printer::Config::convert(q($filename.old))' > $filename\n"
205 . "Please visit https://metacpan.org/pod/Data::Printer::Config for details.\n"
206 );
207 }
208 return {};
209 }
210 }
211 # now that we have loaded the config, we must expand
212 # all existing 'rc_file' and 'profile' statements and
213 # merge them together.
214 foreach my $ns (keys %$config) {
215 $config->{$ns} = _expand_profile($config->{$ns})
216 if exists $config->{$ns}{profile};
217 }
218 return $config;
219}
220
221sub _merge_options {
222 my ($old, $new) = @_;
223 if (ref $new eq 'HASH') {
224 my %merged;
225 my $to_merge = ref $old eq 'HASH' ? $old : {};
226 foreach my $k (keys %$new, keys %$to_merge) {
227 # if the key exists in $new, we recurse into it:
228 if (exists $new->{$k}) {
229 $merged{$k} = _merge_options($to_merge->{$k}, $new->{$k});
230 }
231 else {
232 # otherwise we keep the old version (recursing in case of refs)
233 $merged{$k} = _merge_options(undef, $to_merge->{$k});
234 }
235 }
236 return \%merged;
237 }
238 elsif (ref $new eq 'ARRAY') {
239 # we'll only use the array on $new, but we still need to recurse
240 # in case array elements contain other data structures.
241 my @merged;
242 foreach my $element (@$new) {
243 push @merged, _merge_options(undef, $element);
244 }
245 return \@merged;
246 }
247 else {
248 return $new;
249 }
250}
251
252
253sub _expand_profile {
254 my ($options, $ddp) = @_;
255 my $profile = delete $options->{profile};
256 if ($profile !~ /\A[a-zA-Z0-9:]+\z/) {
257 Data::Printer::Common::_warn($ddp,"invalid profile name '$profile'");
258 }
259 else {
260 my $class = 'Data::Printer::Profile::' . $profile;
261 my $error = Data::Printer::Common::_tryme(sub {
262 my $load_error = Data::Printer::Common::_tryme("use $class; 1;");
263 die $load_error if defined $load_error;
264 my $expanded = $class->profile();
265 die "profile $class did not return a HASH reference" unless ref $expanded eq 'HASH';
266 $options = Data::Printer::Config::_merge_options($expanded, $options);
267 });
268 if (defined $error) {
269 Data::Printer::Common::_warn($ddp, "unable to load profile '$profile': $error");
270 }
271 }
272 return $options;
273}
274
- -
278# converts the old format to the new one
279sub convert {
280 my ($filename) = @_;
281 Data::Printer::Common::_die("please provide a .dataprinter file path")
282 unless $filename;
283 Data::Printer::Common::_die("file '$filename' not found")
284 unless -e $filename && !-d $filename;
285 open my $fh, '<', $filename
286 or Data::Printer::Common::_die("error reading file '$filename': $!");
287
288 my $rc_data;
289 { local $/; $rc_data = <$fh> }
290 close $fh;
291
292 my $config = eval $rc_data;
293 if ( $@ ) {
294 Data::Printer::Common::_die("error loading file '$filename': $@");
295 }
296 elsif (!ref $config or ref $config ne 'HASH') {
297 Data::Printer::Common::_die("error loading file '$filename': config file must return a hash reference");
298 }
299 else {
300 return _convert('', $config);
301 }
302}
303
304sub _convert {
305 my ($key_str, $value) = @_;
306 if (ref $value eq 'HASH') {
307 $key_str = 'colors' if $key_str eq 'color';
308 my $str = '';
309 foreach my $k (sort keys %$value) {
310 $str .= _convert(($key_str ? "$key_str.$k" : $k), $value->{$k});
311 }
312 return $str;
313 }
314 if ($key_str && $key_str eq 'filters.-external' && ref $value eq 'ARRAY') {
315 return 'filters = ' . join(', ' => @$value) . "\n";
316 }
317 elsif (ref $value) {
318 Data::Printer::Common::_warn(
319 undef,
320 " [*] path '$key_str': expected scalar, found " . ref($value)
321 . ". Filters must be in their own class now, loaded with 'filter'.\n"
322 . "If you absolutely must put custom filters in, use the 'begin filter'"
323 . " / 'end filter' options manually, as explained in the documentation,"
324 . " making sure your .dataprinter file is not readable nor writeable to"
325 . " anyone other than your user."
326 );
327 return '';
328 }
329 else {
330 $value = "'$value'" if $value =~ /\s/;
331 return "$key_str = $value\n";
332 }
333}
334
33512µs1;
336__END__
 
# spent 19µs within Data::Printer::Config::CORE:ftfile which was called 9 times, avg 2µs/call: # 8 times (13µs+0s) by Data::Printer::Config::_get_first_rc_file_available at line 34, avg 2µs/call # once (6µs+0s) by Data::Printer::Config::_project_home at line 62
sub Data::Printer::Config::CORE:ftfile; # opcode
# spent 2µs within Data::Printer::Config::CORE:ftis which was called: # once (2µs+0s) by Data::Printer::Config::load_rc_file at line 11
sub Data::Printer::Config::CORE:ftis; # opcode
# spent 21µs within Data::Printer::Config::CORE:glob which was called: # once (21µs+0s) by Data::Printer::Config::_my_home at line 95
sub Data::Printer::Config::CORE:glob; # opcode
# spent 300ns within Data::Printer::Config::__ANON__ which was called: # once (300ns+0s) by Data::Printer::Config::BEGIN@4 at line 4
sub Data::Printer::Config::__ANON__; # xsub
Report produced by the NYTProf 6.12 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.