line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Data::Printer::Config; |
2
|
12
|
|
|
12
|
|
680697
|
use strict; |
|
12
|
|
|
|
|
100
|
|
|
12
|
|
|
|
|
329
|
|
3
|
12
|
|
|
12
|
|
55
|
use warnings; |
|
12
|
|
|
|
|
20
|
|
|
12
|
|
|
|
|
338
|
|
4
|
12
|
|
|
12
|
|
4383
|
use Data::Printer::Common; |
|
12
|
|
|
|
|
29
|
|
|
12
|
|
|
|
|
26404
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
sub load_rc_file { |
7
|
4
|
|
|
4
|
1
|
12125
|
my ($filename) = @_; |
8
|
4
|
100
|
|
|
|
89
|
if (!$filename) { |
9
|
3
|
|
|
|
|
11
|
$filename = _get_first_rc_file_available(); |
10
|
|
|
|
|
|
|
} |
11
|
4
|
50
|
33
|
|
|
225
|
return unless $filename && -e $filename && !-d $filename; |
|
|
|
33
|
|
|
|
|
12
|
4
|
50
|
|
|
|
215
|
if (open my $fh, '<', $filename) { |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
# slurp the file: |
15
|
4
|
|
|
|
|
11
|
my $rc_data; |
16
|
4
|
|
|
|
|
5
|
{ local $/ = undef; $rc_data = <$fh> } |
|
4
|
|
|
|
|
27
|
|
|
4
|
|
|
|
|
180
|
|
17
|
4
|
|
|
|
|
54
|
close $fh; |
18
|
4
|
|
|
|
|
22
|
return _str2data($filename, $rc_data); |
19
|
|
|
|
|
|
|
} |
20
|
|
|
|
|
|
|
else { |
21
|
0
|
|
|
|
|
|
Data::Printer::Common::_warn(undef, "error opening '$filename': $!"); |
22
|
0
|
|
|
|
|
|
return; |
23
|
|
|
|
|
|
|
} |
24
|
|
|
|
|
|
|
} |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
sub _get_first_rc_file_available { |
27
|
3
|
100
|
|
3
|
|
13
|
return $ENV{DATAPRINTERRC} if exists $ENV{DATAPRINTERRC}; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# look for a .dataprinter file on the project home up until we reach '/' |
30
|
2
|
|
|
|
|
6
|
my $dir = _project_home(); |
31
|
2
|
|
|
|
|
45
|
require File::Spec; |
32
|
2
|
|
|
|
|
8
|
while (defined $dir) { |
33
|
2
|
|
|
|
|
14
|
my $file = File::Spec->catfile($dir, '.dataprinter'); |
34
|
2
|
100
|
|
|
|
82
|
return $file if -f $file; |
35
|
1
|
|
|
|
|
11
|
my @path = File::Spec->splitdir($dir); |
36
|
1
|
50
|
|
|
|
4
|
last unless @path; |
37
|
1
|
|
|
|
|
10
|
my $updir = File::Spec->catdir(@path[0..$#path-1]); |
38
|
1
|
50
|
33
|
|
|
10
|
last if !defined $updir || $updir eq $dir; |
39
|
1
|
|
|
|
|
4
|
$dir = $updir; |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
# still here? look for .dataprinter on the user's HOME: |
42
|
1
|
|
|
|
|
4
|
return File::Spec->catfile( _my_home(), '.dataprinter'); |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
sub _my_cwd { |
46
|
2
|
|
|
2
|
|
8
|
require Cwd; |
47
|
2
|
|
|
|
|
20
|
my $cwd = Cwd::getcwd(); |
48
|
|
|
|
|
|
|
# try harder if we can't access the current dir. |
49
|
2
|
50
|
|
|
|
20
|
$cwd = Cwd::cwd() unless defined $cwd; |
50
|
2
|
|
|
|
|
25
|
return $cwd; |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
sub _project_home { |
54
|
2
|
|
|
2
|
|
15
|
require Cwd; |
55
|
2
|
|
|
|
|
5
|
my $path; |
56
|
2
|
100
|
66
|
|
|
15
|
if ($0 eq '-e' || $0 eq '-') { |
57
|
1
|
|
|
|
|
4
|
my $cwd = _my_cwd(); |
58
|
1
|
50
|
|
|
|
39
|
$path = Cwd::abs_path($cwd) if defined $cwd; |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
else { |
61
|
1
|
|
|
|
|
3
|
my $script = $0; |
62
|
1
|
50
|
|
|
|
22
|
return unless -f $script; |
63
|
1
|
|
|
|
|
6
|
require File::Spec; |
64
|
1
|
|
|
|
|
4
|
require File::Basename; |
65
|
|
|
|
|
|
|
# we need the full path if we have chdir'd: |
66
|
1
|
50
|
|
|
|
16
|
$script = File::Spec->catfile(_my_cwd(), $script) |
67
|
|
|
|
|
|
|
unless File::Spec->file_name_is_absolute($script); |
68
|
1
|
|
|
|
|
41
|
my (undef, $maybe_path) = File::Basename::fileparse($script); |
69
|
1
|
50
|
|
|
|
61
|
$path = Cwd::abs_path($maybe_path) if defined $maybe_path; |
70
|
|
|
|
|
|
|
} |
71
|
2
|
|
|
|
|
18
|
return $path; |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
# adapted from File::HomeDir && File::HomeDir::Tiny |
75
|
|
|
|
|
|
|
sub _my_home { |
76
|
5
|
|
|
5
|
|
1068
|
my ($testing) = @_; |
77
|
5
|
100
|
33
|
|
|
32
|
if ($testing) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
78
|
3
|
|
|
|
|
2119
|
require File::Temp; |
79
|
3
|
|
|
|
|
45567
|
require File::Spec; |
80
|
3
|
|
|
|
|
14
|
my $BASE = File::Temp::tempdir( CLEANUP => 1 ); |
81
|
3
|
|
|
|
|
1896
|
my $home = File::Spec->catdir( $BASE, 'my_home' ); |
82
|
3
|
|
|
|
|
22
|
$ENV{HOME} = $home; |
83
|
3
|
50
|
|
|
|
174
|
mkdir($home, 0755) unless -d $home; |
84
|
3
|
|
|
|
|
46
|
return $home; |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
elsif ($^O eq 'MSWin32' and "$]" < 5.016) { |
87
|
0
|
|
0
|
|
|
0
|
return $ENV{HOME} || $ENV{USERPROFILE}; |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
elsif ($^O eq 'MacOS') { |
90
|
0
|
|
|
0
|
|
0
|
my $error = _tryme(sub { require Mac::SystemDirectory; 1 }); |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
91
|
0
|
0
|
|
|
|
0
|
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. |
95
|
2
|
|
|
|
|
919
|
my $home = (<~>)[0]; |
96
|
2
|
50
|
|
|
|
25
|
return $home if $home; |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
# desperate measures that should never be needed. |
99
|
0
|
0
|
0
|
|
|
0
|
if (exists $ENV{LOGDIR} and $ENV{LOGDIR}) { |
100
|
0
|
|
|
|
|
0
|
$home = $ENV{LOGDIR}; |
101
|
|
|
|
|
|
|
} |
102
|
0
|
0
|
0
|
|
|
0
|
if (not $home and exists $ENV{HOME} and $ENV{HOME}) { |
|
|
|
0
|
|
|
|
|
103
|
0
|
|
|
|
|
0
|
$home = $ENV{HOME}; |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
# Light desperation on any (Unixish) platform |
106
|
0
|
0
|
|
|
|
0
|
SCOPE: { $home = (getpwuid($<))[7] if not defined $home } |
|
0
|
|
|
|
|
0
|
|
107
|
0
|
0
|
0
|
|
|
0
|
if (defined $home and ! -d $home ) { |
108
|
0
|
|
|
|
|
0
|
$home = undef; |
109
|
|
|
|
|
|
|
} |
110
|
0
|
|
|
|
|
0
|
return $home; |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
sub _file_mode_is_restricted { |
114
|
1
|
|
|
1
|
|
4
|
my ($filename) = @_; |
115
|
1
|
|
|
|
|
36
|
my $mode_raw = (stat($filename))[2]; |
116
|
1
|
50
|
|
|
|
7
|
return 0 unless defined $mode_raw; |
117
|
0
|
|
|
|
|
0
|
my $mode = sprintf('%04o', $mode_raw & 07777); |
118
|
0
|
0
|
0
|
|
|
0
|
return (length($mode) == 4 && substr($mode, 2, 2) eq '00') ? 1 : 0; |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
sub _str2data { |
122
|
8
|
|
|
8
|
|
3843
|
my ($filename, $content) = @_; |
123
|
8
|
|
|
|
|
28
|
my $config = { _ => {} }; |
124
|
8
|
|
|
|
|
20
|
my $counter = 0; |
125
|
8
|
|
|
|
|
16
|
my $filter; |
126
|
|
|
|
|
|
|
my $can_use_filters; |
127
|
8
|
|
|
|
|
18
|
my $ns = '_'; |
128
|
|
|
|
|
|
|
# based on Config::Tiny |
129
|
8
|
|
|
|
|
493
|
foreach ( split /(?:\015{1,2}\012|\015|\012)/, $content ) { |
130
|
183
|
|
|
|
|
232
|
$counter++; |
131
|
183
|
100
|
|
|
|
776
|
if (defined $filter) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
132
|
13
|
100
|
|
|
|
44
|
if ( /^end filter\s*$/ ) { |
|
|
100
|
|
|
|
|
|
133
|
6
|
50
|
|
|
|
23
|
if (!defined $can_use_filters) { |
134
|
6
|
|
|
|
|
37
|
$can_use_filters = _file_mode_is_restricted($filename); |
135
|
|
|
|
|
|
|
} |
136
|
6
|
100
|
|
|
|
24
|
if ($can_use_filters) { |
137
|
|
|
|
|
|
|
my $sub_str = 'sub { my ($obj, $ddp) = @_; ' |
138
|
|
|
|
|
|
|
. $filter->{code_str} |
139
|
5
|
|
|
|
|
21
|
. '}' |
140
|
|
|
|
|
|
|
; |
141
|
5
|
|
|
|
|
13
|
push @{$config->{$ns}{filters}}, +{ $filter->{name} => eval $sub_str }; |
|
5
|
|
|
|
|
764
|
|
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
else { |
144
|
1
|
|
|
|
|
7
|
Data::Printer::Common::_warn(undef, "ignored filter '$filter->{name}' from rc file '$filename': file is readable/writeable by others"); |
145
|
|
|
|
|
|
|
} |
146
|
6
|
|
|
|
|
853
|
$filter = undef; |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
elsif ( /^begin\s+filter/ ) { |
149
|
1
|
|
|
|
|
9
|
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
|
1
|
|
|
|
|
550
|
return {}; |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
else { |
153
|
6
|
|
|
|
|
20
|
$filter->{code_str} .= $_; |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
elsif ( /^\s*(?:\#|\;|$)/ ) { |
157
|
|
|
|
|
|
|
next # skip comments and empty lines |
158
|
54
|
|
|
|
|
72
|
} |
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
|
18
|
|
50
|
|
|
81
|
$config->{$ns = $1} ||= {}; |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
elsif ( /^\s*([^=]+?)\s*=\s*(.*?)\s*$/ ) { |
166
|
|
|
|
|
|
|
# Handle properties: |
167
|
90
|
|
|
|
|
204
|
my ($path_str, $value) = ($1, $2); |
168
|
|
|
|
|
|
|
# turn a.b.c.d into {a}{b}{c}{d} |
169
|
90
|
|
|
|
|
167
|
my @subpath = split /\./, $path_str; |
170
|
90
|
|
|
|
|
157
|
my $current = $config->{$ns}; |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
# remove single/double (enclosing) quotes |
173
|
90
|
|
|
|
|
177
|
$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
|
90
|
100
|
100
|
|
|
279
|
if (@subpath == 1 && $subpath[0] eq 'filters') { |
181
|
18
|
|
|
|
|
54
|
$value = [ split /\s*,\s*/ => $value ]; |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
|
184
|
90
|
|
|
|
|
179
|
while (my $subpath = shift @subpath) { |
185
|
144
|
100
|
|
|
|
218
|
if (@subpath > 0) { |
186
|
54
|
|
100
|
|
|
145
|
$current->{$subpath} ||= {}; |
187
|
54
|
|
|
|
|
93
|
$current = $current->{$subpath}; |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
else { |
190
|
90
|
|
|
|
|
249
|
$current->{$subpath} = $value; |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
elsif ( /^begin\s+filter\s+([^\s]+)\s*$/ ) { |
195
|
7
|
|
|
|
|
17
|
my $filter_name = $1; |
196
|
7
|
|
|
|
|
26
|
$filter = { name => $filter_name, code_str => '' }; |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
else { |
199
|
1
|
|
|
|
|
6
|
Data::Printer::Common::_warn(undef, "error reading rc file '$filename': syntax error at line $counter: $_"); |
200
|
1
|
50
|
33
|
|
|
571
|
if ($counter == 1 && /\A\s*\{/s) { |
201
|
1
|
|
|
|
|
8
|
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
|
1
|
|
|
|
|
478
|
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
|
6
|
|
|
|
|
38
|
foreach my $ns (keys %$config) { |
215
|
|
|
|
|
|
|
$config->{$ns} = _expand_profile($config->{$ns}) |
216
|
24
|
50
|
|
|
|
50
|
if exists $config->{$ns}{profile}; |
217
|
|
|
|
|
|
|
} |
218
|
6
|
|
|
|
|
36
|
return $config; |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
sub _merge_options { |
222
|
804
|
|
|
804
|
|
4491
|
my ($old, $new) = @_; |
223
|
804
|
100
|
|
|
|
1796
|
if (ref $new eq 'HASH') { |
|
|
100
|
|
|
|
|
|
224
|
206
|
|
|
|
|
268
|
my %merged; |
225
|
206
|
100
|
|
|
|
375
|
my $to_merge = ref $old eq 'HASH' ? $old : {}; |
226
|
206
|
|
|
|
|
579
|
foreach my $k (keys %$new, keys %$to_merge) { |
227
|
|
|
|
|
|
|
# if the key exists in $new, we recurse into it: |
228
|
602
|
100
|
|
|
|
977
|
if (exists $new->{$k}) { |
229
|
437
|
|
|
|
|
887
|
$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
|
165
|
|
|
|
|
239
|
$merged{$k} = _merge_options(undef, $to_merge->{$k}); |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
} |
236
|
206
|
|
|
|
|
701
|
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
|
35
|
|
|
|
|
50
|
my @merged; |
242
|
35
|
|
|
|
|
56
|
foreach my $element (@$new) { |
243
|
56
|
|
|
|
|
79
|
push @merged, _merge_options(undef, $element); |
244
|
|
|
|
|
|
|
} |
245
|
35
|
|
|
|
|
76
|
return \@merged; |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
else { |
248
|
563
|
|
|
|
|
1295
|
return $new; |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
sub _expand_profile { |
254
|
7
|
|
|
7
|
|
11745
|
my ($options, $ddp) = @_; |
255
|
7
|
|
|
|
|
17
|
my $profile = delete $options->{profile}; |
256
|
7
|
100
|
|
|
|
39
|
if ($profile !~ /\A[a-zA-Z0-9:]+\z/) { |
257
|
2
|
|
|
|
|
8
|
Data::Printer::Common::_warn($ddp,"invalid profile name '$profile'"); |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
else { |
260
|
5
|
|
|
|
|
13
|
my $class = 'Data::Printer::Profile::' . $profile; |
261
|
|
|
|
|
|
|
my $error = Data::Printer::Common::_tryme(sub { |
262
|
5
|
|
|
5
|
|
18
|
my $load_error = Data::Printer::Common::_tryme("use $class; 1;"); |
263
|
5
|
100
|
|
|
|
16
|
die $load_error if defined $load_error; |
264
|
4
|
|
|
|
|
10
|
my $expanded = $class->profile(); |
265
|
4
|
50
|
|
|
|
15
|
die "profile $class did not return a HASH reference" unless ref $expanded eq 'HASH'; |
266
|
4
|
|
|
|
|
12
|
$options = Data::Printer::Config::_merge_options($expanded, $options); |
267
|
5
|
|
|
|
|
33
|
}); |
268
|
5
|
100
|
|
|
|
30
|
if (defined $error) { |
269
|
1
|
|
|
|
|
5
|
Data::Printer::Common::_warn($ddp, "unable to load profile '$profile': $error"); |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
} |
272
|
7
|
|
|
|
|
35
|
return $options; |
273
|
|
|
|
|
|
|
} |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
# converts the old format to the new one |
279
|
|
|
|
|
|
|
sub convert { |
280
|
4
|
|
|
4
|
1
|
21
|
my ($filename) = @_; |
281
|
4
|
100
|
|
|
|
18
|
Data::Printer::Common::_die("please provide a .dataprinter file path") |
282
|
|
|
|
|
|
|
unless $filename; |
283
|
3
|
100
|
66
|
|
|
106
|
Data::Printer::Common::_die("file '$filename' not found") |
284
|
|
|
|
|
|
|
unless -e $filename && !-d $filename; |
285
|
2
|
50
|
|
|
|
69
|
open my $fh, '<', $filename |
286
|
|
|
|
|
|
|
or Data::Printer::Common::_die("error reading file '$filename': $!"); |
287
|
|
|
|
|
|
|
|
288
|
2
|
|
|
|
|
7
|
my $rc_data; |
289
|
2
|
|
|
|
|
2
|
{ local $/; $rc_data = <$fh> } |
|
2
|
|
|
|
|
13
|
|
|
2
|
|
|
|
|
53
|
|
290
|
2
|
|
|
|
|
20
|
close $fh; |
291
|
|
|
|
|
|
|
|
292
|
2
|
|
|
|
|
232
|
my $config = eval $rc_data; |
293
|
2
|
50
|
66
|
|
|
17
|
if ( $@ ) { |
|
|
100
|
|
|
|
|
|
294
|
0
|
|
|
|
|
0
|
Data::Printer::Common::_die("error loading file '$filename': $@"); |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
elsif (!ref $config or ref $config ne 'HASH') { |
297
|
1
|
|
|
|
|
8
|
Data::Printer::Common::_die("error loading file '$filename': config file must return a hash reference"); |
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
else { |
300
|
1
|
|
|
|
|
6
|
return _convert('', $config); |
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
sub _convert { |
305
|
13
|
|
|
13
|
|
25
|
my ($key_str, $value) = @_; |
306
|
13
|
100
|
|
|
|
24
|
if (ref $value eq 'HASH') { |
307
|
5
|
100
|
|
|
|
11
|
$key_str = 'colors' if $key_str eq 'color'; |
308
|
5
|
|
|
|
|
6
|
my $str = ''; |
309
|
5
|
|
|
|
|
20
|
foreach my $k (sort keys %$value) { |
310
|
12
|
100
|
|
|
|
36
|
$str .= _convert(($key_str ? "$key_str.$k" : $k), $value->{$k}); |
311
|
|
|
|
|
|
|
} |
312
|
5
|
|
|
|
|
23
|
return $str; |
313
|
|
|
|
|
|
|
} |
314
|
8
|
100
|
66
|
|
|
56
|
if ($key_str && $key_str eq 'filters.-external' && ref $value eq 'ARRAY') { |
|
|
100
|
66
|
|
|
|
|
315
|
1
|
|
|
|
|
5
|
return 'filters = ' . join(', ' => @$value) . "\n"; |
316
|
|
|
|
|
|
|
} |
317
|
|
|
|
|
|
|
elsif (ref $value) { |
318
|
2
|
|
|
|
|
14
|
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
|
2
|
|
|
|
|
8
|
return ''; |
328
|
|
|
|
|
|
|
} |
329
|
|
|
|
|
|
|
else { |
330
|
5
|
100
|
|
|
|
14
|
$value = "'$value'" if $value =~ /\s/; |
331
|
5
|
|
|
|
|
26
|
return "$key_str = $value\n"; |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
} |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
1; |
336
|
|
|
|
|
|
|
__END__ |