line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# ------------------------------------------------------------------------------ |
2
|
|
|
|
|
|
|
# Copyright © 2003 by Matt Luker. All rights reserved. |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# Revision: |
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
# $Header$ |
7
|
|
|
|
|
|
|
# |
8
|
|
|
|
|
|
|
# ------------------------------------------------------------------------------ |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
=head1 NAME |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
RSH::ConfigFile - Configuration File |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=head1 SYNOPSIS |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
use RSH::ConfigFile; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
my $config = new RSH::ConfigFile filename => 'foo.config'; |
19
|
|
|
|
|
|
|
$config->load(); |
20
|
|
|
|
|
|
|
my $setting = $config->{setting}; |
21
|
|
|
|
|
|
|
$config->{setting} = 'new value'; |
22
|
|
|
|
|
|
|
$config->save(); |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
=head1 ABSTRACT |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
RSH::ConfigFile is a configuration file that uses standard text |
27
|
|
|
|
|
|
|
'key = value' lines, where value can be a string, an array, or |
28
|
|
|
|
|
|
|
a hash. |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=head1 DESCRIPTION |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
While using XML and YAML are both possible solutions |
33
|
|
|
|
|
|
|
for a config file syntax, both suffer from having very specific syntax, |
34
|
|
|
|
|
|
|
punctuation, or whitespace requirements. This module seeks to |
35
|
|
|
|
|
|
|
use a simple, more robust config file syntax. In addition to |
36
|
|
|
|
|
|
|
having simple "key = value" syntax, values can also be more |
37
|
|
|
|
|
|
|
complex structures. |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
This format is not a replacement for XML, YAML, or dump formats. |
40
|
|
|
|
|
|
|
It seeks to be simple and readable while providing the ability to |
41
|
|
|
|
|
|
|
specify slightly more complicated values then just plain strings. |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
=cut |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
package RSH::ConfigFile; |
46
|
|
|
|
|
|
|
|
47
|
2
|
|
|
2
|
|
26814
|
use 5.008; |
|
2
|
|
|
|
|
7
|
|
|
2
|
|
|
|
|
84
|
|
48
|
2
|
|
|
2
|
|
12
|
use strict; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
64
|
|
49
|
2
|
|
|
2
|
|
13
|
use warnings; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
116
|
|
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
use overload |
52
|
2
|
|
|
|
|
18
|
'""' => \&string, |
53
|
2
|
|
|
2
|
|
1976
|
'%{}' => \&get_hash; |
|
2
|
|
|
|
|
1190
|
|
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
|
56
|
2
|
|
|
2
|
|
1080
|
use FileHandle; |
|
2
|
|
|
|
|
14473
|
|
|
2
|
|
|
|
|
14
|
|
57
|
2
|
|
|
2
|
|
2959
|
use File::Copy "cp"; |
|
2
|
|
|
|
|
5883
|
|
|
2
|
|
|
|
|
138
|
|
58
|
2
|
|
|
2
|
|
13
|
use Digest::MD5; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
72
|
|
59
|
2
|
|
|
2
|
|
688
|
use RSH::Exception; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
296
|
|
60
|
2
|
|
|
2
|
|
12182
|
use RSH::SmartHash; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
45
|
|
61
|
2
|
|
|
2
|
|
459
|
use RSH::LockFile; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
134
|
|
62
|
2
|
|
|
2
|
|
19
|
use RSH::FileUtil qw(get_filehandle); |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
10384
|
|
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
require Exporter; |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
=head2 EXPORT |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
None by default. |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
=cut |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
our @ISA = qw(Exporter); |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
# Items to export into callers namespace by default. Note: do not export |
75
|
|
|
|
|
|
|
# names by default without a very good reason. Use EXPORT_OK instead. |
76
|
|
|
|
|
|
|
# Do not simply export all your public functions/methods/constants. |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
our @EXPORT_OK = qw( |
79
|
|
|
|
|
|
|
); |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
our @EXPORT = qw( |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
); |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
our $VERSION = '1.0.10'; |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
# ******************** PUBLIC Class Methods ******************** |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=head2 CLASS METHODS |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
=over |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
=cut |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=item serialize_value() |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
Converts the value into a string. |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=cut |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
sub serialize_value { |
102
|
61
|
|
|
61
|
1
|
2169
|
my %args = @_; |
103
|
|
|
|
|
|
|
|
104
|
61
|
|
|
|
|
97
|
my $value = $args{value}; |
105
|
61
|
50
|
|
|
|
306
|
if (not defined($value)) { $value = ''; } |
|
0
|
|
|
|
|
0
|
|
106
|
|
|
|
|
|
|
|
107
|
61
|
50
|
|
|
|
123
|
if (not defined($args{no_quotes})) { $args{no_quotes} = 0; } |
|
61
|
|
|
|
|
107
|
|
108
|
0
|
|
0
|
|
|
0
|
else { $args{no_quotes} = $args{no_quotes} && 1; } |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
# If it is an array reference |
111
|
61
|
100
|
|
|
|
177
|
if (ref($value) eq 'ARRAY') { |
|
|
100
|
|
|
|
|
|
112
|
17
|
|
|
|
|
21
|
my @contents = @{$value}; |
|
17
|
|
|
|
|
64
|
|
113
|
17
|
|
|
|
|
58
|
for (my $i = 0; $i < scalar(@contents); $i++) { |
114
|
44
|
50
|
33
|
|
|
193
|
if ( (not $args{no_quotes}) && ($contents[$i] !~ m/^'.*'$/) ) { $contents[$i] = "'". $contents[$i] ."'"; } |
|
44
|
|
|
|
|
158
|
|
115
|
|
|
|
|
|
|
} |
116
|
17
|
|
|
|
|
36
|
my $str = "[ "; |
117
|
17
|
|
|
|
|
49
|
$str .= join ", ", @contents; |
118
|
17
|
|
|
|
|
25
|
$str .= " ]"; |
119
|
17
|
|
|
|
|
72
|
return $str; |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
# If it is a hash reference |
122
|
|
|
|
|
|
|
elsif (ref($value) eq 'HASH') { |
123
|
12
|
|
|
|
|
18
|
my @contents; |
124
|
|
|
|
|
|
|
my $val; |
125
|
12
|
|
|
|
|
19
|
foreach my $key (sort keys %{$value}) { |
|
12
|
|
|
|
|
72
|
|
126
|
24
|
|
|
|
|
46
|
$val = $value->{$key}; |
127
|
24
|
50
|
33
|
|
|
118
|
if ( (not $args{no_quotes}) && ($val !~ m/^'.*'$/) ) { $val = "'". $val ."'"; } |
|
24
|
|
|
|
|
49
|
|
128
|
24
|
|
|
|
|
82
|
push @contents, "$key => $val"; |
129
|
|
|
|
|
|
|
} |
130
|
12
|
|
|
|
|
34
|
my $str = "{ "; |
131
|
12
|
|
|
|
|
35
|
$str .= join ", ", @contents; |
132
|
12
|
|
|
|
|
17
|
$str .= " }"; |
133
|
12
|
|
|
|
|
61
|
return $str; |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
# Otherwise it is just a scalar/string |
136
|
|
|
|
|
|
|
else { |
137
|
32
|
50
|
33
|
|
|
141
|
if ( (not $args{no_quotes}) && ($value !~ m/^'.*'$/) ) { $value = "'". $value ."'"; } |
|
32
|
|
|
|
|
83
|
|
138
|
32
|
|
|
|
|
110
|
return $value; |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
=item unserialize_value() |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
Tries to unserialize a string into a value. |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=cut |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
sub unserialize_value { |
149
|
38
|
|
|
38
|
1
|
4589
|
my $str = shift; |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
# print STDERR "# RSH::ConfigFile::unserialize_value(): \$str == [[$str]]\n"; |
152
|
38
|
|
|
|
|
70
|
my $val = undef; |
153
|
|
|
|
|
|
|
# Is it an array? |
154
|
38
|
100
|
|
|
|
151
|
if ($str =~ m/^\[(.*)\]$/) { |
|
|
100
|
|
|
|
|
|
155
|
|
|
|
|
|
|
# print STDERR "# RSH::ConfigFile::unserialize_value(): ARRAY value match\n"; |
156
|
11
|
|
|
|
|
29
|
$val = []; |
157
|
11
|
|
|
|
|
31
|
my $str = $1; |
158
|
11
|
|
|
|
|
21
|
$str =~ s/\\,/\\;/; |
159
|
11
|
|
|
|
|
45
|
my @contents = split /,/, $str; |
160
|
11
|
|
|
|
|
37
|
for (my $i = 0; $i < scalar(@contents); $i++) { |
161
|
28
|
|
|
|
|
52
|
$contents[$i] =~ s/\\;/,/; |
162
|
28
|
50
|
|
|
|
139
|
if ($contents[$i] =~ m/^\s*'?(.*?)'?\s*$/) { $contents[$i] = $1; } |
|
28
|
|
|
|
|
99
|
|
163
|
|
|
|
|
|
|
} |
164
|
11
|
|
|
|
|
49
|
return \@contents; |
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
# Is it a hash? |
167
|
|
|
|
|
|
|
elsif ($str =~ m/^\{(.*)\}$/) { |
168
|
|
|
|
|
|
|
# print STDERR "# RSH::ConfigFile::unserialize_value(): HASH value match\n"; |
169
|
7
|
|
|
|
|
14
|
$val = {}; |
170
|
7
|
|
|
|
|
20
|
my $str = $1; |
171
|
7
|
|
|
|
|
13
|
$str =~ s/\\,/\\;/; |
172
|
7
|
|
|
|
|
29
|
my @contents = split /,/, $str; |
173
|
7
|
|
|
|
|
9
|
my ($key, $val); |
174
|
0
|
|
|
|
|
0
|
my %content_hash; |
175
|
7
|
|
|
|
|
22
|
for (my $i = 0; $i < scalar(@contents); $i++) { |
176
|
14
|
|
|
|
|
30
|
$contents[$i] =~ s/\\;/,/; |
177
|
14
|
|
|
|
|
36
|
($key, $val) = split /=>/, $contents[$i]; |
178
|
14
|
50
|
33
|
|
|
106
|
if (defined($key) && ($key =~ m/^\s*'?(.*?)'?\s*$/)) { $key = $1; } |
|
14
|
|
|
|
|
33
|
|
179
|
14
|
50
|
33
|
|
|
94
|
if (defined($val) && ($val =~ m/^\s*'?(.*?)'?\s*$/)) { $val = $1; } |
|
14
|
|
|
|
|
25
|
|
180
|
|
|
|
|
|
|
# Only act on defined key values for hash |
181
|
14
|
50
|
|
|
|
30
|
if (defined($key)) { $content_hash{$key} = $val; } |
|
14
|
|
|
|
|
53
|
|
182
|
|
|
|
|
|
|
} |
183
|
7
|
|
|
|
|
32
|
return \%content_hash; |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
# Otherwise, treat it as a string |
186
|
|
|
|
|
|
|
else { |
187
|
|
|
|
|
|
|
# print STDERR "# RSH::ConfigFile::unserialize_value(): default to STRING value match\n"; |
188
|
20
|
|
|
|
|
28
|
$val = $str; |
189
|
20
|
100
|
|
|
|
79
|
if ($val =~ m/^\s*'(.*?)'\s*$/) { $val = $1; } |
|
15
|
|
|
|
|
34
|
|
190
|
|
|
|
|
|
|
# Otherwise we just assume it is a string without quotes |
191
|
20
|
|
|
|
|
63
|
return $val; |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
=item load_config() |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
Factory method; takes a filename, creates a config object, and loads from the file, returning |
198
|
|
|
|
|
|
|
the freshly loaded config object. |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
=cut |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
sub load_config { |
203
|
0
|
|
|
0
|
1
|
0
|
my $filename = shift; |
204
|
|
|
|
|
|
|
|
205
|
0
|
|
|
|
|
0
|
my $config = RSH::ConfigFile->new($filename); |
206
|
0
|
|
|
|
|
0
|
my $success = $config->load(); |
207
|
0
|
0
|
|
|
|
0
|
if ($success) { return $config; } |
|
0
|
|
|
|
|
0
|
|
208
|
0
|
0
|
|
|
|
0
|
if (not $success) { die "Error loading config for file \"$filename\". ERROR: ". $config->error(); } |
|
0
|
|
|
|
|
0
|
|
209
|
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
=back |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
=cut |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
# ******************** Constructor Methods ******************** |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
=head2 CONSTRUCTORS |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
=over |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
=cut |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
=item new(%ARGS) |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
Creates a new RSH::ConfigFile object. C<%ARGS> contains |
226
|
|
|
|
|
|
|
arguments to use in initializing the new instance. |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
Params: |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
filename => filename to load from |
231
|
|
|
|
|
|
|
default => reference to a hash to use for default values |
232
|
|
|
|
|
|
|
(will not be saved to file) |
233
|
|
|
|
|
|
|
values => reference to a hash to use for values |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
B<Returns:> A new RSH::ConfigFile object. |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
=cut |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
sub new { |
240
|
2
|
|
|
2
|
1
|
1277
|
my $class = shift; |
241
|
2
|
|
|
|
|
8
|
my %params = @_; |
242
|
2
|
|
|
|
|
7
|
my $filename = $params{filename}; |
243
|
2
|
|
|
|
|
5
|
my $default_ref = $params{default}; |
244
|
2
|
|
|
|
|
4
|
my $hash_ref = $params{values}; |
245
|
|
|
|
|
|
|
|
246
|
2
|
50
|
|
|
|
9
|
if (not defined($default_ref)) { $default_ref = {}; } |
|
2
|
|
|
|
|
5
|
|
247
|
2
|
50
|
|
|
|
6
|
if (not defined($hash_ref)) { $hash_ref = {}; } |
|
2
|
|
|
|
|
6
|
|
248
|
|
|
|
|
|
|
|
249
|
2
|
|
|
|
|
4
|
my $dirty = 0; |
250
|
2
|
50
|
|
|
|
4
|
if (%{$hash_ref}) { $dirty = 1; } |
|
2
|
|
|
|
|
13
|
|
|
0
|
|
|
|
|
0
|
|
251
|
|
|
|
|
|
|
|
252
|
2
|
|
|
|
|
24
|
tie my %hash, 'RSH::SmartHash', default => $default_ref, values => $hash_ref, dirty => 1; |
253
|
|
|
|
|
|
|
|
254
|
2
|
|
|
|
|
4
|
my $self = {}; |
255
|
2
|
|
|
|
|
5
|
$self->{filename} = $filename; |
256
|
2
|
|
|
|
|
12
|
$self->{hash} = \%hash; |
257
|
2
|
|
|
|
|
3
|
$self->{error} = undef; |
258
|
2
|
|
|
|
|
5
|
$self->{warning} = undef; |
259
|
2
|
|
|
|
|
4
|
$self->{file_md5} = undef; |
260
|
2
|
50
|
33
|
|
|
12
|
if (defined($params{no_follow}) && ($params{no_follow} eq '1')) { |
261
|
0
|
|
|
|
|
0
|
$self->{no_follow} = 1; |
262
|
|
|
|
|
|
|
} else { |
263
|
2
|
|
|
|
|
60
|
$self->{no_follow} = 0; |
264
|
|
|
|
|
|
|
} |
265
|
2
|
50
|
33
|
|
|
11
|
if (defined($params{no_quotes}) && ($params{no_quotes} eq '1')) { |
266
|
0
|
|
|
|
|
0
|
$self->{no_quotes} = 1; |
267
|
|
|
|
|
|
|
} else { |
268
|
2
|
|
|
|
|
5
|
$self->{no_quotes} = 0; |
269
|
|
|
|
|
|
|
} |
270
|
2
|
50
|
33
|
|
|
9
|
if (defined($params{compact}) && ($params{compact} eq '1')) { |
271
|
0
|
|
|
|
|
0
|
$self->{compact} = 1; |
272
|
|
|
|
|
|
|
} else { |
273
|
2
|
|
|
|
|
6
|
$self->{compact} = 0; |
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
|
276
|
2
|
|
|
|
|
4
|
bless $self, $class; |
277
|
|
|
|
|
|
|
|
278
|
2
|
|
|
|
|
7
|
return $self; |
279
|
|
|
|
|
|
|
} |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
=back |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
=cut |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
# ******************** PUBLIC Instance Methods ******************** |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
=head2 INSTANCE METHODS |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
=cut |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
# ******************** Accessor Methods ******************** |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
=head3 Accessors |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
=over |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
=cut |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
=item is_dirty() |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
Read-only accessor for the object's dirty flag. The dirty flag is set |
303
|
|
|
|
|
|
|
whenever a value is changed for the object's hash values. |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
=cut |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
sub is_dirty { |
308
|
4
|
|
|
4
|
1
|
8
|
my $self = shift; |
309
|
|
|
|
|
|
|
|
310
|
4
|
|
|
|
|
6
|
return tied(%{$self->get_hash})->is_dirty(); |
|
4
|
|
|
|
|
11
|
|
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
=item filename() |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
Read-write accessor for filename attribute |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
=cut |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
sub filename { |
320
|
4
|
|
|
4
|
1
|
170
|
my $self = shift; |
321
|
4
|
|
|
|
|
7
|
my $val = shift; |
322
|
|
|
|
|
|
|
|
323
|
4
|
100
|
|
|
|
12
|
if (defined($val)) { |
324
|
2
|
|
|
|
|
8
|
my $old_val = $self->get_hash_val('filename'); |
325
|
2
|
|
|
|
|
8
|
$self->set_hash_val('filename', $val); |
326
|
2
|
100
|
66
|
|
|
29
|
if ( (defined($old_val)) and ($old_val ne $val) ) { |
327
|
1
|
|
|
|
|
5
|
$self->set_hash_val('file_md5', undef); |
328
|
1
|
|
|
|
|
2
|
tied(%{$self->get_hash})->dirty(1); |
|
1
|
|
|
|
|
4
|
|
329
|
|
|
|
|
|
|
} |
330
|
|
|
|
|
|
|
} |
331
|
|
|
|
|
|
|
|
332
|
4
|
|
|
|
|
11
|
return $self->get_hash_val('filename'); |
333
|
|
|
|
|
|
|
} |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
=item error() |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
Read-only accessor for error attribute. Error is set when an error occurs on |
338
|
|
|
|
|
|
|
save or load. If a load or save returns false for success, you can check this |
339
|
|
|
|
|
|
|
attribute for the reason why. |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
=cut |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
sub error { |
344
|
4
|
|
|
4
|
1
|
1591
|
my $self = shift; |
345
|
|
|
|
|
|
|
|
346
|
4
|
|
|
|
|
16
|
return $self->get_hash_val('error'); |
347
|
|
|
|
|
|
|
} |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
=item warning() |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
Read-only accessor for warning attribute. Warning is set when an warning occurs on |
352
|
|
|
|
|
|
|
save or load. If a load or save returns false for success, you can check this |
353
|
|
|
|
|
|
|
attribute for the reason why. |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
=cut |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
sub warning { |
358
|
4
|
|
|
4
|
1
|
631
|
my $self = shift; |
359
|
|
|
|
|
|
|
|
360
|
4
|
|
|
|
|
13
|
return $self->get_hash_val('warning'); |
361
|
|
|
|
|
|
|
} |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
=item md5() |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
Read-only accessor for md5 attribute. |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
=cut |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
sub md5 { |
370
|
10
|
|
|
10
|
1
|
5732
|
my $self = shift; |
371
|
|
|
|
|
|
|
|
372
|
10
|
|
|
|
|
34
|
return $self->get_hash_val('file_md5'); |
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
=item no_follow() |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
Read-only accessor for no_follow attribute. |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
=cut |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
sub no_follow { |
382
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
383
|
0
|
|
|
|
|
0
|
my $val = shift; |
384
|
|
|
|
|
|
|
|
385
|
0
|
0
|
|
|
|
0
|
if (defined($val)) { |
386
|
0
|
|
0
|
|
|
0
|
$self->{no_follow} = ($val && 1); |
387
|
|
|
|
|
|
|
} |
388
|
|
|
|
|
|
|
|
389
|
0
|
|
|
|
|
0
|
return $self->{no_follow}; |
390
|
|
|
|
|
|
|
} |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
=item no_quotes() |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
Read-only accessor for no_quotes attribute. |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
=cut |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
sub no_quotes { |
399
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
400
|
0
|
|
|
|
|
0
|
my $val = shift; |
401
|
|
|
|
|
|
|
|
402
|
0
|
0
|
|
|
|
0
|
if (defined($val)) { |
403
|
0
|
|
0
|
|
|
0
|
$self->{no_quotes} = ($val && 1); |
404
|
|
|
|
|
|
|
} |
405
|
|
|
|
|
|
|
|
406
|
0
|
|
|
|
|
0
|
return $self->{no_quotes}; |
407
|
|
|
|
|
|
|
} |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
=item compact() |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
Read-only accessor for compact attribute. |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
=cut |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
sub compact { |
416
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
417
|
0
|
|
|
|
|
0
|
my $val = shift; |
418
|
|
|
|
|
|
|
|
419
|
0
|
0
|
|
|
|
0
|
if (defined($val)) { |
420
|
0
|
|
0
|
|
|
0
|
$self->{compact} = ($val && 1); |
421
|
|
|
|
|
|
|
} |
422
|
|
|
|
|
|
|
|
423
|
0
|
|
|
|
|
0
|
return $self->{compact}; |
424
|
|
|
|
|
|
|
} |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
=back |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
=cut |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
# ******************** Functionality ******************** |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
=head3 Functionality |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
=over |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
=cut |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
# ******************** Serialization ******************** |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
=item load() |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
Loads the configuration object from a filename. |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
Params: |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
filename => (optional) the file to load from |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
returns: 1 on success, 0 on failure, with exceptions for exceptionally bad errors |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
=cut |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
sub load { |
453
|
3
|
|
|
3
|
1
|
944
|
my $self = shift; |
454
|
3
|
|
|
|
|
9
|
my %params = @_; |
455
|
3
|
|
|
|
|
7
|
my $filename = $params{filename}; |
456
|
|
|
|
|
|
|
|
457
|
3
|
|
|
|
|
13
|
$self->set_hash_val('error', undef); |
458
|
3
|
|
|
|
|
8
|
$self->set_hash_val('warning', undef); |
459
|
|
|
|
|
|
|
|
460
|
3
|
50
|
|
|
|
10
|
if (not defined($params{force})) { $params{force} = 0; } |
|
3
|
|
|
|
|
8
|
|
461
|
3
|
50
|
|
|
|
9
|
if (not defined($params{no_follow})) { $params{no_follow} = $self->{no_follow}; } |
|
3
|
|
|
|
|
13
|
|
462
|
|
|
|
|
|
|
|
463
|
3
|
100
|
|
|
|
13
|
if (not defined($filename)) { $filename = $self->get_hash_val('filename'); } |
|
2
|
|
|
|
|
5
|
|
464
|
3
|
50
|
|
|
|
9
|
if (not defined($filename)) { |
465
|
0
|
|
|
|
|
0
|
die new RSH::CodeException message => "Filename is not defined for this config object." |
466
|
|
|
|
|
|
|
} |
467
|
|
|
|
|
|
|
|
468
|
3
|
50
|
|
|
|
104
|
if (not -e $filename) { |
469
|
0
|
|
|
|
|
0
|
die new RSH::FileNotFoundException message => "File \"$filename\" does not exist."; |
470
|
|
|
|
|
|
|
} |
471
|
|
|
|
|
|
|
|
472
|
3
|
|
|
|
|
31
|
my $md5 = new Digest::MD5; |
473
|
3
|
|
|
|
|
7
|
eval { |
474
|
3
|
|
|
|
|
17
|
my $FILE = get_filehandle($filename, 'READ', no_follow => $params{no_follow}); |
475
|
3
|
|
|
|
|
9
|
tied(%{$self->get_hash})->CLEAR(); |
|
3
|
|
|
|
|
9
|
|
476
|
|
|
|
|
|
|
# $self->set_hash_val('hash', {}); # reinitialize values--do we want this? |
477
|
|
|
|
|
|
|
|
478
|
3
|
|
|
|
|
20
|
my $key = ""; |
479
|
3
|
|
|
|
|
8
|
my $value = ""; |
480
|
3
|
|
|
|
|
81
|
while (<$FILE>) { |
481
|
38
|
|
|
|
|
129
|
$md5->add($_); # add, as is, first, so our md5 jibes with the real contents of the file |
482
|
38
|
|
|
|
|
58
|
s/(.*)\r\n$/$1\n/; # we hatesez the Windowsez! Hates it we do!! This happens in w2k3 server |
483
|
|
|
|
|
|
|
# and w2k server perl installations when they get confused about file modes |
484
|
|
|
|
|
|
|
# s/(.*)\r$/$1\n/; # Same thing might happen on a Mac, but I doubt it :-) |
485
|
38
|
100
|
66
|
|
|
297
|
if ((! m/^\s*#.*/) && (m/(\S*)\s*=\s*(\S*)/)) { |
486
|
|
|
|
|
|
|
# suck up next line while current line ends in "\" |
487
|
33
|
|
|
|
|
88
|
while (m/^.*\\\s*$/) { |
488
|
6
|
|
|
|
|
20
|
my $temp = <$FILE>; # grab the next line |
489
|
6
|
100
|
|
|
|
22
|
if (defined($temp)) { |
490
|
5
|
|
|
|
|
17
|
$md5->add($temp); |
491
|
5
|
100
|
|
|
|
17
|
if ($temp !~ m/^\s*#.*/) { |
492
|
4
|
|
|
|
|
22
|
s/^(.*)\\\s*$/$1/; # trim off the trailing \ |
493
|
4
|
|
|
|
|
16
|
$_ .= $temp; |
494
|
|
|
|
|
|
|
} |
495
|
|
|
|
|
|
|
} else { |
496
|
1
|
|
|
|
|
16
|
s/^(.*)\\\s*$/$1/; # trim off the trailing \ |
497
|
1
|
|
|
|
|
3
|
last; # get out of the loop |
498
|
|
|
|
|
|
|
} |
499
|
|
|
|
|
|
|
} |
500
|
33
|
|
|
|
|
172
|
($key, $value) = (m/(\S*)\s*=\s*(\S*.*)/); |
501
|
33
|
50
|
|
|
|
87
|
if (defined($key)) { |
502
|
33
|
|
|
|
|
75
|
$self->{$key} = unserialize_value($value); |
503
|
|
|
|
|
|
|
} |
504
|
|
|
|
|
|
|
} |
505
|
|
|
|
|
|
|
} |
506
|
3
|
|
|
|
|
63
|
close $FILE; |
507
|
3
|
|
|
|
|
20
|
my $digest = $md5->hexdigest; |
508
|
|
|
|
|
|
|
#print "# ConfigFile::load(): new md5 for load == $digest\n"; |
509
|
3
|
|
|
|
|
9
|
$self->set_hash_val('file_md5', $digest); |
510
|
|
|
|
|
|
|
}; |
511
|
3
|
50
|
|
|
|
10
|
if ($@) { |
512
|
0
|
|
|
|
|
0
|
$self->set_hash_val('error', $@); |
513
|
0
|
|
|
|
|
0
|
return 0; |
514
|
|
|
|
|
|
|
} |
515
|
|
|
|
|
|
|
|
516
|
3
|
|
|
|
|
6
|
tied(%{$self->get_hash})->dirty(0); |
|
3
|
|
|
|
|
7
|
|
517
|
3
|
|
|
|
|
24
|
return 1; |
518
|
|
|
|
|
|
|
} |
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
=item save() |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
Saves the values in this config object to the file. If the file exists, formatting will be |
523
|
|
|
|
|
|
|
preserved, with new values being added at the end. |
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
Params: |
526
|
|
|
|
|
|
|
filename - (optional) the file to save to |
527
|
|
|
|
|
|
|
force - (optional) 1, force save, 0, rely on dirty flag; method assumes force => 0 |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
returns: 1 on success, 0 on failure, with exceptions for exceptionally bad errors |
530
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
=cut |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
sub save { |
534
|
4
|
|
|
4
|
1
|
6395
|
my $self = shift; |
535
|
4
|
|
|
|
|
26
|
my %params = @_; |
536
|
4
|
|
|
|
|
12
|
my $filename = $params{filename}; |
537
|
|
|
|
|
|
|
|
538
|
4
|
|
|
|
|
22
|
$self->set_hash_val('error', undef); |
539
|
4
|
|
|
|
|
13
|
$self->set_hash_val('warning', undef); |
540
|
|
|
|
|
|
|
|
541
|
4
|
100
|
|
|
|
20
|
if (not defined($params{force})) { $params{force} = 0; } |
|
2
|
|
|
|
|
6
|
|
542
|
4
|
50
|
|
|
|
14
|
if (not defined($params{no_follow})) { $params{no_follow} = $self->{no_follow}; } |
|
4
|
|
|
|
|
30
|
|
543
|
4
|
50
|
|
|
|
19
|
if (not defined($params{no_quotes})) { $params{no_quotes} = $self->{no_quotes}; } |
|
4
|
|
|
|
|
9
|
|
544
|
4
|
50
|
|
|
|
98
|
if (not defined($params{compact})) { $params{compact} = $self->{compact}; } |
|
4
|
|
|
|
|
10
|
|
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
# If a filename is supplied and it is NOT equal to the filename attribute, assume "always save" |
547
|
4
|
50
|
33
|
|
|
21
|
if ( (defined($filename)) && ($filename ne $self->get_hash_val('filename')) ) { $params{force} = 1; } |
|
0
|
|
|
|
|
0
|
|
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
# If not dirty and we are not forcing a save, stop processing and return success. |
550
|
4
|
100
|
66
|
|
|
18
|
if ((not $self->is_dirty) && (not $params{force}) ) { return 1; } |
|
1
|
|
|
|
|
5
|
|
551
|
|
|
|
|
|
|
|
552
|
3
|
50
|
|
|
|
10
|
if (not defined($filename)) { $filename = $self->get_hash_val('filename'); } |
|
3
|
|
|
|
|
8
|
|
553
|
3
|
50
|
|
|
|
9
|
if (not defined($filename)) { |
554
|
0
|
|
|
|
|
0
|
die new RSH::CodeException message => "Filename is not defined for this config object."; |
555
|
|
|
|
|
|
|
} |
556
|
|
|
|
|
|
|
|
557
|
3
|
100
|
|
|
|
95
|
if (not -e $filename) { |
558
|
1
|
50
|
|
|
|
4
|
if (defined($self->get_hash_val('file_md5'))) { |
559
|
0
|
|
|
|
|
0
|
my $ex = new RSH::DataIntegrityException message => "Loaded from file, but saving to empty file."; |
560
|
0
|
0
|
|
|
|
0
|
if (not $params{force}) { die $ex; } |
|
0
|
|
|
|
|
0
|
|
561
|
0
|
|
|
|
|
0
|
else { $self->set_hash_val('warning', $ex); } |
562
|
|
|
|
|
|
|
} |
563
|
|
|
|
|
|
|
# if file does not exist, don't worry about any formatting |
564
|
1
|
|
|
|
|
3
|
eval { |
565
|
1
|
|
|
|
|
11
|
my $lock = RSH::LockFile->new($filename); |
566
|
1
|
|
|
|
|
7
|
$lock->lock(no_follow => $params{no_follow}); |
567
|
|
|
|
|
|
|
|
568
|
1
|
|
|
|
|
6
|
my $FILE = get_filehandle("$filename", 'WRITE', no_follow => $params{no_follow}); |
569
|
1
|
|
|
|
|
3
|
my $key = ""; |
570
|
1
|
|
|
|
|
2
|
my $value = ""; |
571
|
1
|
|
|
|
|
3
|
foreach $key (sort keys %{$self->get_hash}) { |
|
1
|
|
|
|
|
4
|
|
572
|
11
|
|
|
|
|
24
|
$value = $self->{$key}; |
573
|
11
|
50
|
|
|
|
29
|
if (not defined($value)) { $value = ""; } # ensures no errors and proper write to file; |
|
0
|
|
|
|
|
0
|
|
574
|
|
|
|
|
|
|
# effectively the same thing to write a null string |
575
|
11
|
|
|
|
|
31
|
else { $value = serialize_value(value => $value, no_quotes => $params{no_quotes}); } |
576
|
11
|
50
|
|
|
|
25
|
if (not $params{compact}) { |
577
|
11
|
|
|
|
|
30
|
print $FILE "$key = $value\n"; |
578
|
|
|
|
|
|
|
} else { |
579
|
0
|
|
|
|
|
0
|
print $FILE "$key=$value\n"; |
580
|
|
|
|
|
|
|
} |
581
|
|
|
|
|
|
|
} |
582
|
1
|
|
|
|
|
54
|
close $FILE; |
583
|
|
|
|
|
|
|
|
584
|
1
|
|
|
|
|
10
|
my $fh = new FileHandle "<$filename"; |
585
|
1
|
|
|
|
|
85
|
my $md5 = new Digest::MD5; |
586
|
1
|
|
|
|
|
23
|
$md5->addfile($fh); |
587
|
1
|
|
|
|
|
5
|
$fh->close();; |
588
|
1
|
|
|
|
|
18
|
my $digest = $md5->hexdigest; |
589
|
|
|
|
|
|
|
#print "# ConfigFile::save()[new file]: new md5 for save == $digest\n"; |
590
|
1
|
|
|
|
|
6
|
$self->set_hash_val('file_md5', $digest); |
591
|
1
|
|
|
|
|
6
|
$lock->unlock(); |
592
|
|
|
|
|
|
|
}; |
593
|
1
|
50
|
|
|
|
5
|
if ($@) { |
594
|
0
|
|
|
|
|
0
|
$self->set_hash_val('error', $@); |
595
|
0
|
|
|
|
|
0
|
return 0; |
596
|
|
|
|
|
|
|
} |
597
|
|
|
|
|
|
|
} else { |
598
|
|
|
|
|
|
|
# if file does exist, we need to worry about formatting |
599
|
2
|
50
|
|
|
|
14
|
if (not defined($self->get_hash_val('file_md5'))) { |
600
|
0
|
|
|
|
|
0
|
my $ex = new RSH::DataIntegrityException message => "In-memory data was not loaded from file."; |
601
|
0
|
0
|
|
|
|
0
|
if (not $params{force}) { die $ex; } |
|
0
|
|
|
|
|
0
|
|
602
|
0
|
|
|
|
|
0
|
else { $self->set_hash_val('warning', $ex); } |
603
|
|
|
|
|
|
|
} |
604
|
2
|
|
|
|
|
13
|
eval { |
605
|
2
|
|
|
|
|
38
|
my $lock = RSH::LockFile->new($filename); |
606
|
2
|
|
|
|
|
20
|
$lock->lock(no_follow => $params{no_follow}); |
607
|
|
|
|
|
|
|
# my $rc = system("mv $filename $filename.bak"); |
608
|
|
|
|
|
|
|
# if ($rc != 0) { die new RSH::DataIntegrityException message => "Unable to backup original file!"; } |
609
|
2
|
|
|
|
|
36
|
my $rc = cp($filename, "$filename.bak"); |
610
|
2
|
50
|
|
|
|
935
|
if ($rc == 0) { die new RSH::DataIntegrityException message => "Unable to backup original file!"; } |
|
0
|
|
|
|
|
0
|
|
611
|
2
|
|
|
|
|
162
|
$rc = unlink($filename); |
612
|
2
|
50
|
|
|
|
9
|
if ($rc == 0) { |
613
|
0
|
|
|
|
|
0
|
die new RSH::DataIntegrityException |
614
|
|
|
|
|
|
|
message => "Unable to remove original file after backup!"; |
615
|
|
|
|
|
|
|
} |
616
|
|
|
|
|
|
|
|
617
|
2
|
|
|
|
|
13
|
my $ORIG_FILE = get_filehandle("$filename.bak", 'READ', no_follow => $params{no_follow}); |
618
|
2
|
|
|
|
|
34
|
my $md5 = new Digest::MD5; |
619
|
2
|
|
|
|
|
67
|
$md5->addfile($ORIG_FILE); |
620
|
2
|
|
|
|
|
9
|
$ORIG_FILE->close; |
621
|
2
|
|
|
|
|
45
|
my $orig_md5 = $md5->hexdigest; |
622
|
2
|
100
|
66
|
|
|
9
|
if ( defined($self->get_hash_val('file_md5')) and ($self->get_hash_val('file_md5') ne $orig_md5) ) { |
623
|
1
|
|
|
|
|
317
|
my $ex = new RSH::DataIntegrityException message => "Data file has changed since the last load."; |
624
|
1
|
50
|
|
|
|
12
|
if (not $params{force}) { die $ex; } |
|
0
|
|
|
|
|
0
|
|
625
|
1
|
|
|
|
|
8
|
else { $self->set_hash_val('warning', $ex); } |
626
|
|
|
|
|
|
|
} |
627
|
|
|
|
|
|
|
|
628
|
2
|
|
|
|
|
16
|
$ORIG_FILE = get_filehandle("$filename.bak", 'READ', no_follow => $params{no_follow}); |
629
|
2
|
|
|
|
|
18
|
my $FILE = get_filehandle("$filename", 'WRITE', no_follow => $params{no_follow}); |
630
|
|
|
|
|
|
|
|
631
|
2
|
|
|
|
|
7
|
my $key = ""; |
632
|
2
|
|
|
|
|
4
|
my $value = ""; |
633
|
2
|
|
|
|
|
4
|
my @saved; |
634
|
2
|
|
|
|
|
52
|
while (<$ORIG_FILE>) { |
635
|
27
|
100
|
66
|
|
|
218
|
if ((! m/^\s*#.*/) && (m/(\S*)\s*=\s*(\S*)/)) { |
636
|
|
|
|
|
|
|
# suck up next line while current line ends in "\" |
637
|
22
|
|
|
|
|
74
|
while (m/^.*\\\s*$/) { |
638
|
6
|
|
|
|
|
163
|
my $temp = <$ORIG_FILE>; # grab the next line |
639
|
6
|
100
|
100
|
|
|
40
|
if (defined($temp) && ($temp !~ m/^\s*#.*/)) { |
|
|
100
|
|
|
|
|
|
640
|
4
|
|
|
|
|
29
|
s/^(.*)\\\s*$/$1/; # trim off the trailing \ |
641
|
4
|
|
|
|
|
16
|
$_ .= $temp; |
642
|
|
|
|
|
|
|
} elsif (not defined($temp)) { |
643
|
1
|
|
|
|
|
18
|
s/^(.*)\\\s*$/$1/; # trim off the trailing \ |
644
|
1
|
|
|
|
|
4
|
last; # get out of the loop |
645
|
|
|
|
|
|
|
} |
646
|
|
|
|
|
|
|
} |
647
|
22
|
|
|
|
|
130
|
($key, $value) = (m/(\S*)\s*=\s*(\S*.*)/); |
648
|
22
|
50
|
33
|
|
|
97
|
if ( (defined($key)) && (defined($self->{$key})) ) { |
649
|
22
|
|
|
|
|
45
|
$value = $self->{$key}; |
650
|
22
|
50
|
|
|
|
63
|
if (not defined($value)) { $value = ""; } # ensures no errors and proper write to file; |
|
0
|
|
|
|
|
0
|
|
651
|
|
|
|
|
|
|
# effectively the same thing to write a null string |
652
|
22
|
|
|
|
|
56
|
else { $value = serialize_value(value => $value, no_quotes => $params{no_quotes}); } |
653
|
22
|
50
|
|
|
|
50
|
if (not $params{compact}) { |
654
|
22
|
|
|
|
|
70
|
print $FILE "$key = $value\n"; |
655
|
|
|
|
|
|
|
} else { |
656
|
0
|
|
|
|
|
0
|
print $FILE "$key=$value\n"; |
657
|
|
|
|
|
|
|
} |
658
|
22
|
|
|
|
|
123
|
push @saved, $key; |
659
|
|
|
|
|
|
|
} |
660
|
|
|
|
|
|
|
} else { |
661
|
5
|
|
|
|
|
36
|
print $FILE $_; |
662
|
|
|
|
|
|
|
} |
663
|
|
|
|
|
|
|
} |
664
|
|
|
|
|
|
|
|
665
|
2
|
|
|
|
|
32
|
close $ORIG_FILE; |
666
|
|
|
|
|
|
|
|
667
|
2
|
|
|
|
|
4
|
my @keys = sort keys %{$self}; |
|
2
|
|
|
|
|
6
|
|
668
|
2
|
50
|
|
|
|
17
|
if (scalar(@saved) < scalar(@keys)) { |
669
|
0
|
|
|
|
|
0
|
for (my $i = 0; $i < scalar(@keys); $i++) { |
670
|
0
|
0
|
|
|
|
0
|
if (grep(/$keys[$i]/, @saved) == 0) { |
671
|
0
|
|
|
|
|
0
|
$value = $self->{$keys[$i]}; |
672
|
0
|
0
|
|
|
|
0
|
if (not defined($value)) { $value = ""; } # ensures no errors and proper write to file; |
|
0
|
|
|
|
|
0
|
|
673
|
|
|
|
|
|
|
# effectively the same thing to write a null string |
674
|
0
|
|
|
|
|
0
|
else { $value = serialize_value(value => $value, no_quotes => $params{no_quotes}); } |
675
|
0
|
0
|
|
|
|
0
|
if (not $params{compact}) { |
676
|
0
|
|
|
|
|
0
|
print $FILE "$keys[$i] = $value\n"; |
677
|
|
|
|
|
|
|
} else { |
678
|
0
|
|
|
|
|
0
|
print $FILE "$keys[$i]=$value\n"; |
679
|
|
|
|
|
|
|
} |
680
|
|
|
|
|
|
|
} |
681
|
|
|
|
|
|
|
} |
682
|
|
|
|
|
|
|
} |
683
|
2
|
|
|
|
|
237
|
close $FILE; |
684
|
|
|
|
|
|
|
|
685
|
2
|
|
|
|
|
16
|
$FILE = get_filehandle("$filename", 'READ', no_follow => $params{no_follow}); |
686
|
2
|
|
|
|
|
21
|
$md5->new; |
687
|
2
|
|
|
|
|
40
|
$md5->addfile($FILE); |
688
|
2
|
|
|
|
|
16
|
$FILE->close(); |
689
|
2
|
|
|
|
|
42
|
my $digest = $md5->hexdigest; |
690
|
|
|
|
|
|
|
#print "# ConfigFile::save()[existing file]: new md5 for save == $digest\n"; |
691
|
2
|
|
|
|
|
10
|
$self->set_hash_val('file_md5', $digest); |
692
|
2
|
|
|
|
|
20
|
$lock->unlock(); |
693
|
|
|
|
|
|
|
}; |
694
|
2
|
50
|
|
|
|
9
|
if ($@) { |
695
|
0
|
|
|
|
|
0
|
$self->set_hash_val('error', $@); |
696
|
0
|
|
|
|
|
0
|
return 0; |
697
|
|
|
|
|
|
|
} |
698
|
|
|
|
|
|
|
} |
699
|
|
|
|
|
|
|
|
700
|
3
|
|
|
|
|
9
|
tied(%{$self->get_hash})->dirty(0); |
|
3
|
|
|
|
|
11
|
|
701
|
3
|
|
|
|
|
15
|
return 1; |
702
|
|
|
|
|
|
|
} |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
=item remove() |
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
Removes the config file. |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
=cut |
709
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
sub remove { |
711
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
712
|
0
|
|
|
|
|
0
|
my %params = @_; |
713
|
0
|
|
|
|
|
0
|
my $filename = $params{filename}; |
714
|
|
|
|
|
|
|
|
715
|
0
|
0
|
|
|
|
0
|
if (not defined($filename)) { $filename = $self->get_hash_val('filename'); } |
|
0
|
|
|
|
|
0
|
|
716
|
0
|
0
|
|
|
|
0
|
if (not defined($filename)) { die new RSH::CodeException message => "Filename is not defined for this config object." } |
|
0
|
|
|
|
|
0
|
|
717
|
|
|
|
|
|
|
|
718
|
0
|
0
|
|
|
|
0
|
if (not -e $filename) { return 1; } |
|
0
|
|
|
|
|
0
|
|
719
|
|
|
|
|
|
|
else { |
720
|
0
|
|
|
|
|
0
|
my $rc = unlink("$filename"); |
721
|
0
|
0
|
|
|
|
0
|
if ($rc == 0) { die new RSH::DataIntegrityException message => "Unable to remove file $filename."; } |
|
0
|
|
|
|
|
0
|
|
722
|
0
|
|
|
|
|
0
|
$self->set_hash_val('file_md5', undef); |
723
|
0
|
|
|
|
|
0
|
return 1; |
724
|
|
|
|
|
|
|
} |
725
|
|
|
|
|
|
|
} |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
# ******************** Overload Methods ******************** |
728
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
=item string() |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
Returns a string representation of the object. This is useful for debugging. It is NOT |
732
|
|
|
|
|
|
|
suitable to be used for serializing the object. Use save for that. |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
=cut |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
sub string { |
737
|
3
|
|
|
3
|
1
|
426
|
my $self = shift; |
738
|
|
|
|
|
|
|
|
739
|
3
|
|
|
|
|
8
|
my $str = "{ "; |
740
|
3
|
|
|
|
|
5
|
my $key = ""; |
741
|
3
|
|
|
|
|
7
|
my $value = ""; |
742
|
3
|
|
|
|
|
6
|
foreach $key (sort keys %{$self->get_hash()}) { |
|
3
|
|
|
|
|
9
|
|
743
|
25
|
|
|
|
|
89
|
$value = $self->{$key}; |
744
|
25
|
50
|
|
|
|
75
|
if (not defined($value)) { $value = "undef"; } # could be confusing if that is the real value ;-) |
|
0
|
|
|
|
|
0
|
|
745
|
25
|
|
|
|
|
50
|
else { $value = serialize_value(value => $value); } |
746
|
|
|
|
|
|
|
# if this is not the first pair |
747
|
25
|
100
|
|
|
|
63
|
if ($str ne "{ ") { $str .= ", " } |
|
22
|
|
|
|
|
27
|
|
748
|
25
|
|
|
|
|
52
|
$str .= "$key => $value"; |
749
|
|
|
|
|
|
|
} |
750
|
3
|
|
|
|
|
15
|
$str .= " }"; |
751
|
3
|
|
|
|
|
19
|
return $str; |
752
|
|
|
|
|
|
|
} |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
=item get_hash() |
755
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
Returns the 'hash' hash reference. |
757
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
Ok, this is a bit confusing if you haven't read the overload manpage, and still |
759
|
|
|
|
|
|
|
confusing if you haven't tried it ;-) |
760
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
The overload maps all attempts to use this object reference as a hash to this method. |
762
|
|
|
|
|
|
|
So, $config->{key} will actually call this method--and what this method does is return the |
763
|
|
|
|
|
|
|
hash table reference in 'hash'. So, a quick step by step is as follows: |
764
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
$config->{key} ==> get_hash($config) ==> (returns 'hash') ==> ('hash')->{key} |
766
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
So this method returns the hash, which is in turn accessed for the key 'key'. Neat and |
768
|
|
|
|
|
|
|
confusing, no? |
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
=cut |
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
sub get_hash { |
773
|
252
|
|
|
252
|
1
|
4241
|
my $self = shift; |
774
|
|
|
|
|
|
|
|
775
|
252
|
|
|
|
|
472
|
return $self->get_hash_val("hash"); |
776
|
|
|
|
|
|
|
} |
777
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
# ******************** "PRIVATE" Instance Methods ******************** |
779
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
=begin private |
781
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
=item get_hash_val() |
783
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
Gets past the overload so we can actually get at the $self hash values. All attempts |
785
|
|
|
|
|
|
|
at $self->{key} will actually call get_hash(), so we need a way around that to |
786
|
|
|
|
|
|
|
get at the values of self. |
787
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
Thank you overload manpage! |
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
=cut |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
sub get_hash_val { |
793
|
288
|
|
|
288
|
1
|
443
|
my $self = shift; |
794
|
288
|
|
|
|
|
348
|
my $key = shift; |
795
|
288
|
|
|
|
|
525
|
my $class = ref $self; |
796
|
288
|
|
|
|
|
627
|
bless $self, 'overload::dummy'; # Disable overloading of %{} |
797
|
288
|
|
|
|
|
501
|
my $val = $self->{$key}; |
798
|
288
|
|
|
|
|
461
|
bless $self, $class; # Restore overloading |
799
|
288
|
|
|
|
|
1635
|
$val; |
800
|
|
|
|
|
|
|
} |
801
|
|
|
|
|
|
|
|
802
|
|
|
|
|
|
|
=item set_hash_val() |
803
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
Gets past the overload so we can actually set the $self hash values. |
805
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
Thank you overload manpage! |
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
=cut |
809
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
sub set_hash_val { |
811
|
24
|
|
|
24
|
1
|
39
|
my $self = shift; |
812
|
24
|
|
|
|
|
42
|
my $key = shift; |
813
|
24
|
|
|
|
|
32
|
my $val = shift; |
814
|
24
|
|
|
|
|
51
|
my $class = ref $self; |
815
|
24
|
|
|
|
|
65
|
bless $self, 'overload::dummy'; # Disable overloading of %{} |
816
|
24
|
|
|
|
|
47
|
$self->{$key} = $val; |
817
|
24
|
|
|
|
|
56
|
bless $self, $class; # Restore overloading |
818
|
24
|
|
|
|
|
51
|
$val; |
819
|
|
|
|
|
|
|
} |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
=end private |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
=back |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
=cut |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
# #################### RSH::ConfigFile.pm ENDS #################### |
828
|
|
|
|
|
|
|
1; |
829
|
|
|
|
|
|
|
|
830
|
|
|
|
|
|
|
=head1 SEE ALSO |
831
|
|
|
|
|
|
|
|
832
|
|
|
|
|
|
|
http://www.rshtech.com/software/ |
833
|
|
|
|
|
|
|
|
834
|
|
|
|
|
|
|
=head1 AUTHOR |
835
|
|
|
|
|
|
|
|
836
|
|
|
|
|
|
|
Matt Luker C<< <mluker@cpan.org> >> |
837
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
Copyright 2003-2008 by Matt Luker |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
843
|
|
|
|
|
|
|
it under the same terms as Perl itself. |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
=cut |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
__END__ |
848
|
|
|
|
|
|
|
# TTGOG |
849
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
# ------------------------------------------------------------------------------ |
851
|
|
|
|
|
|
|
# |
852
|
|
|
|
|
|
|
# $Log$ |
853
|
|
|
|
|
|
|
# Revision 1.14 2004/04/09 06:18:26 kostya |
854
|
|
|
|
|
|
|
# Added quote escaping capabilities. |
855
|
|
|
|
|
|
|
# |
856
|
|
|
|
|
|
|
# Revision 1.13 2004/01/15 01:07:17 kostya |
857
|
|
|
|
|
|
|
# New version for changes in tests. |
858
|
|
|
|
|
|
|
# |
859
|
|
|
|
|
|
|
# Revision 1.12 2003/12/27 07:46:12 kostya |
860
|
|
|
|
|
|
|
# Fix for an empty element in a hash--i.e. if the last element has a comma after it, generating a null pair |
861
|
|
|
|
|
|
|
# |
862
|
|
|
|
|
|
|
# Revision 1.11 2003/12/27 07:42:07 kostya |
863
|
|
|
|
|
|
|
# Fix for slash-continues and comments |
864
|
|
|
|
|
|
|
# |
865
|
|
|
|
|
|
|
# Revision 1.10 2003/11/14 05:30:17 kostya |
866
|
|
|
|
|
|
|
# Bumped rev. |
867
|
|
|
|
|
|
|
# |
868
|
|
|
|
|
|
|
# Revision 1.9 2003/10/23 05:13:32 kostya |
869
|
|
|
|
|
|
|
# Added some explaination for s// in load. |
870
|
|
|
|
|
|
|
# |
871
|
|
|
|
|
|
|
# Revision 1.8 2003/10/23 05:08:06 kostya |
872
|
|
|
|
|
|
|
# Bumped rev. |
873
|
|
|
|
|
|
|
# |
874
|
|
|
|
|
|
|
# Revision 1.7 2003/10/23 05:06:17 kostya |
875
|
|
|
|
|
|
|
# Added a check for brain-dead Windows perl installations. |
876
|
|
|
|
|
|
|
# |
877
|
|
|
|
|
|
|
# Revision 1.6 2003/10/22 20:56:10 kostya |
878
|
|
|
|
|
|
|
# Bumped rev. |
879
|
|
|
|
|
|
|
# |
880
|
|
|
|
|
|
|
# Revision 1.5 2003/10/22 20:51:02 kostya |
881
|
|
|
|
|
|
|
# Removed OS-specifc assumptions or code |
882
|
|
|
|
|
|
|
# |
883
|
|
|
|
|
|
|
# Revision 1.4 2003/10/15 01:08:12 kostya |
884
|
|
|
|
|
|
|
# Bumped rev for getting licenses in order. |
885
|
|
|
|
|
|
|
# |
886
|
|
|
|
|
|
|
# Revision 1.3 2003/10/15 01:07:00 kostya |
887
|
|
|
|
|
|
|
# documentation and license updates--everything is Artistic. |
888
|
|
|
|
|
|
|
# |
889
|
|
|
|
|
|
|
# Revision 1.2 2003/10/14 22:50:07 kostya |
890
|
|
|
|
|
|
|
# Bumped release |
891
|
|
|
|
|
|
|
# |
892
|
|
|
|
|
|
|
# Revision 1.1.1.1 2003/10/13 01:38:04 kostya |
893
|
|
|
|
|
|
|
# First import |
894
|
|
|
|
|
|
|
# |
895
|
|
|
|
|
|
|
# Revision 1.7 2003/08/30 06:39:05 kostya |
896
|
|
|
|
|
|
|
# Patched undefined key in hash values. |
897
|
|
|
|
|
|
|
# |
898
|
|
|
|
|
|
|
# Revision 1.6 2003/08/23 07:13:28 kostya |
899
|
|
|
|
|
|
|
# Added md5 checksums. |
900
|
|
|
|
|
|
|
# |
901
|
|
|
|
|
|
|
# Revision 1.5 2003/08/23 01:02:32 kostya |
902
|
|
|
|
|
|
|
# Added remove and changed to SmartHash. |
903
|
|
|
|
|
|
|
# |
904
|
|
|
|
|
|
|
# Revision 1.4 2003/08/06 03:31:26 kostya |
905
|
|
|
|
|
|
|
# Change callback and dirty flag work. |
906
|
|
|
|
|
|
|
# |
907
|
|
|
|
|
|
|
# Revision 1.3 2003/08/01 00:52:50 kostya |
908
|
|
|
|
|
|
|
# Latest infrastructure work. |
909
|
|
|
|
|
|
|
# |
910
|
|
|
|
|
|
|
# Revision 1.2 2003/07/30 06:30:49 kostya |
911
|
|
|
|
|
|
|
# Added comments and file-locking. |
912
|
|
|
|
|
|
|
# |
913
|
|
|
|
|
|
|
# Revision 1.1.1.1 2003/07/25 07:06:35 kostya |
914
|
|
|
|
|
|
|
# Initial Import |
915
|
|
|
|
|
|
|
# |
916
|
|
|
|
|
|
|
# ------------------------------------------------------------------------------ |
917
|
|
|
|
|
|
|
|