line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#=Copyright Infomation |
2
|
|
|
|
|
|
|
#========================================================== |
3
|
|
|
|
|
|
|
#Module Name : Config::IniMan |
4
|
|
|
|
|
|
|
#Program Author : Dr. Ahmed Amin Elsheshtawy, Ph.D. Physics, E.E. |
5
|
|
|
|
|
|
|
#Home Page : http://www.mewsoft.com |
6
|
|
|
|
|
|
|
#Contact Email : support@mewsoft.com |
7
|
|
|
|
|
|
|
#Copyrights © 2014 Mewsoft. All rights reserved. |
8
|
|
|
|
|
|
|
#========================================================== |
9
|
|
|
|
|
|
|
package Config::IniMan; |
10
|
|
|
|
|
|
|
|
11
|
1
|
|
|
1
|
|
25573
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
44
|
|
12
|
1
|
|
|
1
|
|
8
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
33
|
|
13
|
1
|
|
|
1
|
|
902
|
use Tie::IxHash; |
|
1
|
|
|
|
|
5736
|
|
|
1
|
|
|
|
|
33
|
|
14
|
1
|
|
|
1
|
|
927
|
use utf8; |
|
1
|
|
|
|
|
10
|
|
|
1
|
|
|
|
|
5
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
our $VERSION = '1.20'; |
17
|
|
|
|
|
|
|
#=========================================================# |
18
|
|
|
|
|
|
|
=encoding utf-8 |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
=head1 NAME |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
Config::IniMan - INI file manager object style preserved format and sort order. |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
=head1 SYNOPSIS |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
use Config::IniMan; |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
# Create the config object and load it from a file |
29
|
|
|
|
|
|
|
my $config = Config::IniMan->new("sample.ini"); |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
# Create the config object and load it from a file with specific encoding |
32
|
|
|
|
|
|
|
my $config = Config::IniMan->new("sample.ini", "utf8"); |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# Create empty config object |
35
|
|
|
|
|
|
|
my $config = Config::IniMan->new(); |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# then load the config file |
38
|
|
|
|
|
|
|
$config->read("sample.ini"); |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
#read file in specific encoding |
41
|
|
|
|
|
|
|
$config->read("sample.ini", "utf8"); |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
# parameters values can be obtained as object methods. getter/setter style. |
44
|
|
|
|
|
|
|
# get the parameter 'website' value from current or default section. |
45
|
|
|
|
|
|
|
my $value = $config->website; |
46
|
|
|
|
|
|
|
# same as |
47
|
|
|
|
|
|
|
my $value = $config->get("website"); |
48
|
|
|
|
|
|
|
# set parameter 'website' value as a setter object method |
49
|
|
|
|
|
|
|
$config->website("http://mewsoft.com"); |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
# get parameter value from default or current section |
52
|
|
|
|
|
|
|
my $value = $config->get("name"); |
53
|
|
|
|
|
|
|
# get parameter value from a section |
54
|
|
|
|
|
|
|
my $value = $config->get("section", "name"); |
55
|
|
|
|
|
|
|
# get parameter value from a section and return default value if it does not exist |
56
|
|
|
|
|
|
|
my $value = $config->get("section", "name", "default"); |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
# change parameter value in the current or default section |
59
|
|
|
|
|
|
|
$config->set("name", "value"); |
60
|
|
|
|
|
|
|
# change parameter value in a section |
61
|
|
|
|
|
|
|
$config->set("section", "name", "value"); |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
# add a new section at the end of the file |
64
|
|
|
|
|
|
|
$config->add_section("section"); |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
#set current active section |
67
|
|
|
|
|
|
|
$config->section(); # set current section to default section |
68
|
|
|
|
|
|
|
$config->section("section"); |
69
|
|
|
|
|
|
|
# set current section and get a parameter value from it. |
70
|
|
|
|
|
|
|
$value = $config->section("section")->get("name"); |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
# get entire section as a hash reference |
73
|
|
|
|
|
|
|
$section = $config->get_section();# default section |
74
|
|
|
|
|
|
|
$section = $config->get_section("section"); |
75
|
|
|
|
|
|
|
print $section->{"merchant"}; |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
# get all sections names |
78
|
|
|
|
|
|
|
@sections = $config->sections(); |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
# get all section params |
81
|
|
|
|
|
|
|
@params = $config->section_params("section"); |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
# get all section values |
84
|
|
|
|
|
|
|
@params = $config->section_values("section"); |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
#delete section params |
87
|
|
|
|
|
|
|
$config->delete("section", @name); |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
#delete entire section |
90
|
|
|
|
|
|
|
$config->delete_section("section"); |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
#check if parameter exists |
93
|
|
|
|
|
|
|
$found = $config->exists("name"); # check parameter name exists in the current section. |
94
|
|
|
|
|
|
|
$found = $config->exists("section", "name"); |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
#check if section exists |
97
|
|
|
|
|
|
|
$found = $config->section_exists("section"); |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
#Returns entire ini file contents in memory as single string with format preserved. |
100
|
|
|
|
|
|
|
$ini_data = $config->as_string(); |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
#writes entire ini contents in memory to a file. |
103
|
|
|
|
|
|
|
$config->write(); # save changes to the currently loaded file. |
104
|
|
|
|
|
|
|
$config->write("newfile"); # save as a new file. |
105
|
|
|
|
|
|
|
$config->write("newfile", "utf8"); # save as a new file in different encoding. |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=head1 DESCRIPTION |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
This module reads and writes INI files in object style and preserves original files sort order, comments, empty lines, and multi lines parameters. |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
It is basically built on the top of using the L module which implements Perl hashes that preserve the order in which the hash |
113
|
|
|
|
|
|
|
elements were added. The order is not affected when values corresponding to existing sections or parameters are changed. |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
New sections will be added to the end of the current file contents and new parameters will be added to the end of the current section. |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
=head2 INI Format Sample |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
;default section without name. this line is a comment |
120
|
|
|
|
|
|
|
#this line also is another comment |
121
|
|
|
|
|
|
|
title=Hellow world |
122
|
|
|
|
|
|
|
name=Ahmed Amin Elsheshtawy |
123
|
|
|
|
|
|
|
email=support@mewsoft.com |
124
|
|
|
|
|
|
|
website=http://www.mewsoft.com |
125
|
|
|
|
|
|
|
; |
126
|
|
|
|
|
|
|
;line below is empty line and is allowed |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
;database settings |
129
|
|
|
|
|
|
|
[database] |
130
|
|
|
|
|
|
|
name=blog |
131
|
|
|
|
|
|
|
user=user1234 |
132
|
|
|
|
|
|
|
password=blog1234 |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
;admin login |
135
|
|
|
|
|
|
|
[admin] |
136
|
|
|
|
|
|
|
username=admin |
137
|
|
|
|
|
|
|
password=admin123 |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
# paypal account setting |
140
|
|
|
|
|
|
|
[payment] |
141
|
|
|
|
|
|
|
merchant=paypal |
142
|
|
|
|
|
|
|
email=support@mewsoft.com |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
[multil-line-data] |
145
|
|
|
|
|
|
|
ftp_msg=This is the ftp address of the domain where\ |
146
|
|
|
|
|
|
|
the software will be installed. Either use domain name\ |
147
|
|
|
|
|
|
|
or IP address, for example ftp.yourdomain.com is the \ |
148
|
|
|
|
|
|
|
ftp address and 234.453.213.32 is the IP number. |
149
|
|
|
|
|
|
|
; |
150
|
|
|
|
|
|
|
[lastlogin] |
151
|
|
|
|
|
|
|
time=5/9/2014=Friday |
152
|
|
|
|
|
|
|
; |
153
|
|
|
|
|
|
|
# utf8 Arabic section |
154
|
|
|
|
|
|
|
[عربى] |
155
|
|
|
|
|
|
|
الأسم=أحمد امين الششتاوى |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
=cut |
158
|
|
|
|
|
|
|
#=========================================================# |
159
|
|
|
|
|
|
|
sub AUTOLOAD { |
160
|
0
|
|
|
0
|
|
|
my ($self) = shift; |
161
|
|
|
|
|
|
|
|
162
|
0
|
|
|
|
|
|
my ($class, $method) = our $AUTOLOAD =~ /^(.*)::(\w+)$/; |
163
|
|
|
|
|
|
|
|
164
|
0
|
0
|
|
|
|
|
if ($self->can($method)) { |
165
|
0
|
|
|
|
|
|
return $self->$method(@_); |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
|
168
|
0
|
0
|
|
|
|
|
if (@_) { |
169
|
|
|
|
|
|
|
# set parameter value in the current section |
170
|
0
|
|
|
|
|
|
$self->{data}->{$self->{section}}->{$method} = $_[0]; |
171
|
0
|
|
|
|
|
|
return $self; |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
else { |
174
|
|
|
|
|
|
|
# return parameter value from current section |
175
|
0
|
|
|
|
|
|
return $self->{data}->{$self->{section}}->{$method}; |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
#=========================================================# |
179
|
|
|
|
|
|
|
=head2 new() |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
use Config::IniMan; |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
# Create the config object and load it from a file |
184
|
|
|
|
|
|
|
my $config = Config::IniMan->new("sample.ini"); |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
# Create the config object and load it from a file with specific encoding |
187
|
|
|
|
|
|
|
my $config = Config::IniMan->new("sample.ini", "utf8"); |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
# Create empty config object |
190
|
|
|
|
|
|
|
my $config = Config::IniMan->new(); |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
# then load the config file |
193
|
|
|
|
|
|
|
$config->read("sample.ini"); |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
#read file in specific encoding |
196
|
|
|
|
|
|
|
$config->read("sample.ini", "utf8"); |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
Create the config object and load it from a file if provided with specific encoding. |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
=cut |
201
|
|
|
|
|
|
|
sub new { |
202
|
0
|
|
|
0
|
0
|
|
my ($self, $file, $encoding) = @_; |
203
|
|
|
|
|
|
|
|
204
|
0
|
|
|
|
|
|
$self = bless {}, $self; |
205
|
|
|
|
|
|
|
|
206
|
0
|
|
|
|
|
|
$self->{encoding} = $encoding; |
207
|
0
|
|
|
|
|
|
$self->{file} = $file; |
208
|
0
|
|
|
|
|
|
$self->{section} = "_"; # default section name |
209
|
0
|
|
|
|
|
|
$self->{data} = {}; |
210
|
0
|
|
|
|
|
|
$self->{counter} = 0; |
211
|
|
|
|
|
|
|
|
212
|
0
|
0
|
|
|
|
|
$self->read($self->{file}) if ($self->{file}); |
213
|
|
|
|
|
|
|
|
214
|
0
|
|
|
|
|
|
return $self; |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
#=========================================================# |
217
|
|
|
|
|
|
|
=head2 read() |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
use Config::IniMan; |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
# Create empty config object |
222
|
|
|
|
|
|
|
my $config = Config::IniMan->new(); |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
# then load the config file |
225
|
|
|
|
|
|
|
$config->read("sample.ini"); |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
#read file in specific encoding |
228
|
|
|
|
|
|
|
$config->read("sample.ini", "utf8"); |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
Read and parse ini file contents in specific encoding. |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
=cut |
233
|
|
|
|
|
|
|
sub read { |
234
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
235
|
0
|
|
|
|
|
|
my $file = shift; |
236
|
0
|
0
|
|
|
|
|
if (@_) { |
237
|
0
|
|
|
|
|
|
$self->encoding(shift); |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
|
240
|
0
|
0
|
|
|
|
|
my $encoding = $self->encoding? "<:".$self->encoding : '<'; |
241
|
0
|
|
|
|
|
|
local $/= undef; |
242
|
|
|
|
|
|
|
|
243
|
0
|
0
|
|
|
|
|
open (my $fh, $encoding, $file) or return ("Error reading file $file: $!"); |
244
|
0
|
|
|
|
|
|
my $content = <$fh>; |
245
|
0
|
|
|
|
|
|
close ($fh); |
246
|
|
|
|
|
|
|
|
247
|
0
|
|
|
|
|
|
$self->parse($content); |
248
|
0
|
|
|
|
|
|
$self->{file} = $file; |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
#=========================================================# |
251
|
|
|
|
|
|
|
sub parse { |
252
|
0
|
|
|
0
|
0
|
|
my ($self, $content) = @_; |
253
|
|
|
|
|
|
|
|
254
|
0
|
|
|
|
|
|
my @lines = split (/(?:\015{1,2}\012|\015|\012)/, $content); |
255
|
|
|
|
|
|
|
|
256
|
0
|
|
|
|
|
|
my $section = "_"; # default section name, not written to file |
257
|
|
|
|
|
|
|
|
258
|
0
|
|
|
|
|
|
$self->{counter} = 0; |
259
|
|
|
|
|
|
|
|
260
|
1
|
|
|
1
|
|
632
|
no strict 'subs'; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
991
|
|
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
# sections sorted hash |
263
|
0
|
|
|
|
|
|
tie %{$self->{data}}, Tie::IxHash; |
|
0
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
# default section variables sorted hash |
266
|
0
|
|
|
|
|
|
tie %{$self->{data}->{$section}}, Tie::IxHash; |
|
0
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
|
268
|
0
|
|
|
|
|
|
my ($name, $value, $multiline); |
269
|
|
|
|
|
|
|
|
270
|
0
|
|
|
|
|
|
$multiline = 0; |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
# process data |
273
|
0
|
|
|
|
|
|
foreach my $line (@lines) { |
274
|
|
|
|
|
|
|
|
275
|
0
|
|
|
|
|
|
$self->{counter}++; |
276
|
|
|
|
|
|
|
# keep comments and empty lines |
277
|
0
|
0
|
|
|
|
|
if ($line =~ /^\s*(?:\#|\;|$)/ ) { |
278
|
0
|
|
|
|
|
|
$self->{data}->{$section}->{"__SKIP__$self->{counter}"} = $line; |
279
|
0
|
|
|
|
|
|
next; |
280
|
|
|
|
|
|
|
} |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
# sections names |
283
|
0
|
0
|
|
|
|
|
if ($line =~ /^\s*\[\s*(.+?)\s*\]\s*$/) { |
284
|
0
|
|
|
|
|
|
$section = $1; |
285
|
|
|
|
|
|
|
# add new section variables sorted hash |
286
|
0
|
|
|
|
|
|
tie %{$self->{data}->{$section}}, Tie::IxHash; |
|
0
|
|
|
|
|
|
|
287
|
0
|
|
|
|
|
|
next; |
288
|
|
|
|
|
|
|
} |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
# section variables key, value pairs key=value |
291
|
0
|
0
|
|
|
|
|
if ($multiline) { |
|
|
0
|
|
|
|
|
|
292
|
0
|
|
|
|
|
|
$multiline = 0; |
293
|
0
|
0
|
|
|
|
|
if ($line =~ /\\$/) { |
294
|
0
|
|
|
|
|
|
$multiline = 1; |
295
|
0
|
|
|
|
|
|
$line =~ s/\\$//; |
296
|
|
|
|
|
|
|
} |
297
|
0
|
|
|
|
|
|
$self->{data}->{$section}->{$name} .= $line; |
298
|
0
|
|
|
|
|
|
next; |
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
elsif ($line =~ /^\s*([^=]+?)\s*=\s*(.*?)\s*$/) { |
301
|
0
|
|
|
|
|
|
($name, $value) = ($1, $2); |
302
|
0
|
|
|
|
|
|
$multiline = 0; |
303
|
0
|
0
|
|
|
|
|
if ($value =~ /\\$/) { |
304
|
0
|
|
|
|
|
|
$multiline = 1; |
305
|
0
|
|
|
|
|
|
$value =~ s/\\$//; |
306
|
|
|
|
|
|
|
} |
307
|
0
|
|
|
|
|
|
$self->{data}->{$section}->{$name} = $value; |
308
|
0
|
|
|
|
|
|
next; |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
# TODO error formated line here, heredocs if needed etc |
312
|
|
|
|
|
|
|
}# @lines |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
#=========================================================# |
315
|
|
|
|
|
|
|
=head2 encoding() |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
$encoding = $config->encoding(); |
318
|
|
|
|
|
|
|
$config->encoding("utf8"); # set encoding |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
Gets and sets the default file read and write encoding. |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
=cut |
323
|
|
|
|
|
|
|
sub encoding { |
324
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
325
|
0
|
0
|
|
|
|
|
$self->{encoding} = shift if (@_); |
326
|
0
|
|
|
|
|
|
$self->{encoding}; |
327
|
|
|
|
|
|
|
} |
328
|
|
|
|
|
|
|
#=========================================================# |
329
|
|
|
|
|
|
|
=head2 clear() |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
$config->clear(); |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
Deletes entire file contents from memory. Does not save to the file. |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
=cut |
336
|
|
|
|
|
|
|
sub clear { |
337
|
0
|
|
|
0
|
0
|
|
my ($self) = @_; |
338
|
0
|
|
|
|
|
|
$self->{data} = {}; |
339
|
0
|
|
|
|
|
|
$self->{file} = ""; |
340
|
0
|
|
|
|
|
|
$self->{section} = "_"; |
341
|
0
|
|
|
|
|
|
$self->{counter} = 0; |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
#=========================================================# |
344
|
|
|
|
|
|
|
=head2 get() |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
$value = $config->get("name"); # get parameter value from default or current section |
347
|
|
|
|
|
|
|
$value = $config->get("section", "name"); |
348
|
|
|
|
|
|
|
$value = $config->get("section", "name", "default"); |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
# parameters values can be obtained as object methods. getter/setter style. |
351
|
|
|
|
|
|
|
# get the parameter 'website' value from current or default section. |
352
|
|
|
|
|
|
|
my $value = $config->website; |
353
|
|
|
|
|
|
|
# same as |
354
|
|
|
|
|
|
|
my $value = $config->get("website"); |
355
|
|
|
|
|
|
|
# set parameter 'website' value as a setter object method |
356
|
|
|
|
|
|
|
$config->website("http://mewsoft.com"); |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
Gets parameter value. Returns the value of a parameter by its name. If you pass only the parameter name, it will search within the |
359
|
|
|
|
|
|
|
current section or the default section. You can pass also a default value to be returned if parameter does not exist. |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
=cut |
362
|
|
|
|
|
|
|
sub get { |
363
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
364
|
0
|
|
|
|
|
|
my ($section, $name, $default) = ""; |
365
|
0
|
0
|
|
|
|
|
if (@_ == 1) { |
|
|
0
|
|
|
|
|
|
366
|
0
|
|
|
|
|
|
$name = shift; |
367
|
0
|
|
|
|
|
|
$section = $self->{section}; |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
elsif (@_ == 2) { |
370
|
0
|
|
|
|
|
|
($section, $name) = @_; |
371
|
|
|
|
|
|
|
} |
372
|
|
|
|
|
|
|
else { |
373
|
0
|
|
|
|
|
|
($section, $name, $default) = @_; |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
|
376
|
0
|
|
0
|
|
|
|
$section ||= $self->{section}; |
377
|
|
|
|
|
|
|
|
378
|
0
|
0
|
|
|
|
|
if (exists $self->{data}->{$section}->{$name}) { |
379
|
0
|
|
|
|
|
|
return $self->{data}->{$section}->{$name}; |
380
|
|
|
|
|
|
|
} |
381
|
|
|
|
|
|
|
|
382
|
0
|
|
|
|
|
|
return $default; |
383
|
|
|
|
|
|
|
} |
384
|
|
|
|
|
|
|
#=========================================================# |
385
|
|
|
|
|
|
|
=head2 set() |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
$config->set("name", "value"); # sets parameter value in the current or default section |
388
|
|
|
|
|
|
|
$config->set("section", "name", "value"); |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
# set parameter 'website' value as a setter object method |
391
|
|
|
|
|
|
|
$config->website("http://mewsoft.com"); |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
Sets parameter value. Adds new section if section does not exist. This method is chained. |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
=cut |
396
|
|
|
|
|
|
|
sub set { |
397
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
398
|
0
|
|
|
|
|
|
my ($section, $name, $value) = ""; |
399
|
0
|
0
|
|
|
|
|
if (@_ == 2) { |
400
|
0
|
|
|
|
|
|
($name, $value) = @_; |
401
|
0
|
|
|
|
|
|
$section = $self->{section}; |
402
|
|
|
|
|
|
|
} |
403
|
|
|
|
|
|
|
else { |
404
|
0
|
|
|
|
|
|
($section, $name, $value) = @_; |
405
|
|
|
|
|
|
|
} |
406
|
|
|
|
|
|
|
|
407
|
0
|
|
0
|
|
|
|
$section ||= "_"; |
408
|
|
|
|
|
|
|
|
409
|
0
|
0
|
|
|
|
|
if (!$self->section_exists($section)) { |
410
|
0
|
|
|
|
|
|
$self->add_section($section); |
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
|
413
|
0
|
|
|
|
|
|
$self->{data}->{$section}->{$name} = $value; |
414
|
0
|
|
|
|
|
|
$self; |
415
|
|
|
|
|
|
|
} |
416
|
|
|
|
|
|
|
#=========================================================# |
417
|
|
|
|
|
|
|
=head2 add_section() |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
$config->add_section("section"); |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
Adds new section to the end of the file if it does not exist. This method is chained. |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
=cut |
424
|
|
|
|
|
|
|
sub add_section { |
425
|
0
|
|
|
0
|
0
|
|
my ($self, $section) = @_; |
426
|
|
|
|
|
|
|
|
427
|
0
|
|
0
|
|
|
|
$section ||= "_"; |
428
|
1
|
|
|
1
|
|
7
|
no strict 'subs'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
1000
|
|
429
|
0
|
0
|
|
|
|
|
if (!$self->section_exists($section)) { |
430
|
0
|
|
|
|
|
|
tie %{$self->{data}->{$section}}, Tie::IxHash; |
|
0
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
} |
432
|
|
|
|
|
|
|
|
433
|
0
|
|
|
|
|
|
$self; |
434
|
|
|
|
|
|
|
} |
435
|
|
|
|
|
|
|
#=========================================================# |
436
|
|
|
|
|
|
|
=head2 section() |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
$config->section(); # set current section to default section |
439
|
|
|
|
|
|
|
$config->section("section"); |
440
|
|
|
|
|
|
|
# set current section and get a parameter value from it. |
441
|
|
|
|
|
|
|
$value = $config->section("section")->get("name"); |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
Sets current active section. If empty section name is passed, will set the default section as current one. This method is chained. |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
=cut |
446
|
|
|
|
|
|
|
sub section { |
447
|
0
|
|
|
0
|
0
|
|
my ($self, $section) = @_; |
448
|
0
|
|
0
|
|
|
|
$section ||= "_"; |
449
|
0
|
0
|
|
|
|
|
if ($self->section_exists($section)) { |
450
|
0
|
|
|
|
|
|
$self->{section} = $section; |
451
|
0
|
|
|
|
|
|
return $self->{data}->{$section}; |
452
|
|
|
|
|
|
|
} |
453
|
|
|
|
|
|
|
} |
454
|
|
|
|
|
|
|
#=========================================================# |
455
|
|
|
|
|
|
|
=head2 get_section() |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
$section = $config->get_section();# default section |
458
|
|
|
|
|
|
|
$section = $config->get_section("section"); |
459
|
|
|
|
|
|
|
print $section->{"email"}; |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
Returns entire section as a hash ref if exists. |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
=cut |
464
|
|
|
|
|
|
|
sub get_section { |
465
|
0
|
|
|
0
|
0
|
|
my ($self, $section) = @_; |
466
|
0
|
|
0
|
|
|
|
$section ||= "_"; |
467
|
0
|
0
|
|
|
|
|
if ($self->section_exists($section)) { |
468
|
0
|
|
|
|
|
|
return $self->{data}->{$section}; |
469
|
|
|
|
|
|
|
} |
470
|
|
|
|
|
|
|
} |
471
|
|
|
|
|
|
|
#=========================================================# |
472
|
|
|
|
|
|
|
=head2 sections() |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
@sections = $config->sections(); |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
Returns array of sections names in the same sorted order in the file. |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
=cut |
479
|
|
|
|
|
|
|
sub sections { |
480
|
0
|
|
|
0
|
0
|
|
my ($self) = @_; |
481
|
0
|
|
|
|
|
|
(keys %{$self->{data}}); |
|
0
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
} |
483
|
|
|
|
|
|
|
#=========================================================# |
484
|
|
|
|
|
|
|
=head2 section_params() |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
@params = $config->section_params("section"); |
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
Returns array of section parameters names in the same sorted order in the file. |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
=cut |
491
|
|
|
|
|
|
|
sub section_params { |
492
|
0
|
|
|
0
|
0
|
|
my ($self, $section) = @_; |
493
|
|
|
|
|
|
|
|
494
|
0
|
|
0
|
|
|
|
$section ||= $self->{section}; |
495
|
0
|
|
|
|
|
|
(keys %{$self->{data}->{$section}}); |
|
0
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
} |
497
|
|
|
|
|
|
|
#=========================================================# |
498
|
|
|
|
|
|
|
=head2 section_values() |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
@values = $config->section_values(); # get current or default section values |
501
|
|
|
|
|
|
|
@values = $config->section_values("section"); |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
Returns array of section parameters values in the same sorted order in the file. |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
=cut |
506
|
|
|
|
|
|
|
sub section_values { |
507
|
0
|
|
|
0
|
0
|
|
my ($self, $section) = @_; |
508
|
0
|
|
|
|
|
|
(values %{$self->{data}->{$section}}); |
|
0
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
} |
510
|
|
|
|
|
|
|
#=========================================================# |
511
|
|
|
|
|
|
|
=head2 delete() |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
$config->delete("section", @name); |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
Delete section parameters. This method is chained. |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
=cut |
518
|
|
|
|
|
|
|
sub delete { |
519
|
0
|
|
|
0
|
0
|
|
my ($self, $section, @name) = @_; |
520
|
0
|
|
0
|
|
|
|
$section ||= "_"; |
521
|
0
|
|
|
|
|
|
delete $self->{data}->{$section}->{$_} for @name; |
522
|
0
|
|
|
|
|
|
$self; |
523
|
|
|
|
|
|
|
} |
524
|
|
|
|
|
|
|
#=========================================================# |
525
|
|
|
|
|
|
|
=head2 delete_section() |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
$config->delete_section();# delete default section |
528
|
|
|
|
|
|
|
$config->delete_section("section"); |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
Delete entire section if it exist. This method is chained. |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
=cut |
533
|
|
|
|
|
|
|
sub delete_section { |
534
|
0
|
|
|
0
|
0
|
|
my ($self, $section) = @_; |
535
|
0
|
|
0
|
|
|
|
$section ||= "_"; |
536
|
0
|
|
|
|
|
|
delete $self->{data}->{$section}; |
537
|
0
|
|
|
|
|
|
$self; |
538
|
|
|
|
|
|
|
} |
539
|
|
|
|
|
|
|
#=========================================================# |
540
|
|
|
|
|
|
|
=head2 exists() |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
$found = $config->exists("name"); # check parameter name exists in the current section. |
543
|
|
|
|
|
|
|
$found = $config->exists("section", "name"); |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
Checks if parameter exists. If no section passed, it will check in the current of default section. |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
=cut |
548
|
|
|
|
|
|
|
sub exists { |
549
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
550
|
0
|
|
|
|
|
|
my ($section, $name); |
551
|
0
|
0
|
|
|
|
|
if (@_ == 1) { |
552
|
0
|
|
|
|
|
|
$name = shift; |
553
|
0
|
|
|
|
|
|
$section = $self->{section}; |
554
|
|
|
|
|
|
|
} |
555
|
|
|
|
|
|
|
else { |
556
|
0
|
|
|
|
|
|
($section, $name) = @_; |
557
|
|
|
|
|
|
|
} |
558
|
0
|
|
0
|
|
|
|
$section ||= "_"; |
559
|
0
|
|
|
|
|
|
exists $self->{data}->{$section}->{$name}; |
560
|
|
|
|
|
|
|
} |
561
|
|
|
|
|
|
|
#=========================================================# |
562
|
|
|
|
|
|
|
=head2 section_exists() |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
$found = $config->section_exists("section"); |
565
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
Checks if section exists. |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
=cut |
569
|
|
|
|
|
|
|
sub section_exists { |
570
|
0
|
|
|
0
|
0
|
|
my ($self, $section) = @_; |
571
|
0
|
|
0
|
|
|
|
$section ||= "_"; |
572
|
0
|
|
|
|
|
|
exists $self->{data}->{$section}; |
573
|
|
|
|
|
|
|
} |
574
|
|
|
|
|
|
|
#=========================================================# |
575
|
|
|
|
|
|
|
=head2 as_string() |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
$ini_data = $config->as_string(); |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
Returns entire ini file contents in memory as single string with format preserved. |
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
=cut |
582
|
|
|
|
|
|
|
sub as_string { |
583
|
0
|
|
|
0
|
0
|
|
my ($self) = @_; |
584
|
|
|
|
|
|
|
|
585
|
0
|
|
|
|
|
|
my $content = ""; |
586
|
|
|
|
|
|
|
|
587
|
0
|
|
|
|
|
|
my $v; |
588
|
0
|
|
|
|
|
|
foreach my $section (keys %{$self->{data}}) { |
|
0
|
|
|
|
|
|
|
589
|
0
|
0
|
|
|
|
|
$content .= "[$section]\n" unless ($section eq "_"); |
590
|
|
|
|
|
|
|
|
591
|
0
|
|
|
|
|
|
foreach my $k (keys %{$self->{data}->{$section}}) { |
|
0
|
|
|
|
|
|
|
592
|
0
|
|
|
|
|
|
$v =$self->{data}->{$section}->{$k}; |
593
|
0
|
0
|
|
|
|
|
if ($k =~ /^__SKIP__\d+$/) { |
594
|
0
|
|
|
|
|
|
$content .= "$v\n"; |
595
|
0
|
|
|
|
|
|
next; |
596
|
|
|
|
|
|
|
} |
597
|
|
|
|
|
|
|
else { |
598
|
0
|
|
|
|
|
|
$content .= "$k=$v\n"; |
599
|
|
|
|
|
|
|
} |
600
|
|
|
|
|
|
|
} |
601
|
|
|
|
|
|
|
} |
602
|
|
|
|
|
|
|
|
603
|
0
|
|
|
|
|
|
return $content; |
604
|
|
|
|
|
|
|
} |
605
|
|
|
|
|
|
|
#=========================================================# |
606
|
|
|
|
|
|
|
=head2 write() |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
$config->write(); # save changes to the currently loaded file. |
609
|
|
|
|
|
|
|
$config->write("newfile"); # save as a new file. |
610
|
|
|
|
|
|
|
$config->write("newfile", "utf8"); # save as a new file in different encoding. |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
Writes entire ini file contents in memory to file. |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
=cut |
615
|
|
|
|
|
|
|
sub write { |
616
|
0
|
|
|
0
|
0
|
|
my $self= shift; |
617
|
0
|
0
|
|
|
|
|
my $file = shift if (@_); |
618
|
0
|
0
|
|
|
|
|
$self->encoding(shift) if (@_); |
619
|
|
|
|
|
|
|
|
620
|
0
|
0
|
|
|
|
|
$file or return ("Empty file name during writing file: $!"); |
621
|
|
|
|
|
|
|
|
622
|
0
|
0
|
|
|
|
|
my $encoding = $self->encoding? ">:".$self->encoding : '>'; |
623
|
0
|
|
|
|
|
|
local $/= undef; |
624
|
|
|
|
|
|
|
|
625
|
0
|
0
|
|
|
|
|
open(my $fh, $encoding, $file) or return ("Error writing file $file: $!"); |
626
|
0
|
|
|
|
|
|
print $fh $self->as_string; |
627
|
0
|
|
|
|
|
|
close($fh); |
628
|
|
|
|
|
|
|
} |
629
|
|
|
|
|
|
|
#=========================================================# |
630
|
|
|
|
|
|
|
#TODO |
631
|
|
|
|
|
|
|
#sub rename { |
632
|
|
|
|
|
|
|
#my ($self, $section, $key, $newkey) = @_; |
633
|
|
|
|
|
|
|
#} |
634
|
|
|
|
|
|
|
#=========================================================# |
635
|
|
|
|
|
|
|
#TODO |
636
|
|
|
|
|
|
|
#sub rename_section { |
637
|
|
|
|
|
|
|
#my ($self, $section, $newsection) = @_; |
638
|
|
|
|
|
|
|
#} |
639
|
|
|
|
|
|
|
#=========================================================# |
640
|
|
|
|
|
|
|
#TODO |
641
|
|
|
|
|
|
|
#sub set_section_comment { |
642
|
|
|
|
|
|
|
#my ($self, $section, @comment) = @_; |
643
|
|
|
|
|
|
|
#} |
644
|
|
|
|
|
|
|
#=========================================================# |
645
|
|
|
|
|
|
|
#TODO |
646
|
|
|
|
|
|
|
#sub get_section_comment { |
647
|
|
|
|
|
|
|
#my ($self, $section, @comment) = @_; |
648
|
|
|
|
|
|
|
#} |
649
|
|
|
|
|
|
|
#=========================================================# |
650
|
|
|
|
|
|
|
#TODO |
651
|
|
|
|
|
|
|
#sub del_section_comment { |
652
|
|
|
|
|
|
|
#my ($self, $section, @comment) = @_; |
653
|
|
|
|
|
|
|
#} |
654
|
|
|
|
|
|
|
#=========================================================# |
655
|
0
|
|
|
0
|
|
|
sub DESTROY { |
656
|
|
|
|
|
|
|
} |
657
|
|
|
|
|
|
|
#=========================================================# |
658
|
|
|
|
|
|
|
#=========================================================# |
659
|
|
|
|
|
|
|
1; |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
=head1 Bugs |
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
This project is available on github at L . |
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
=head1 SEE ALSO |
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
L |
669
|
|
|
|
|
|
|
L |
670
|
|
|
|
|
|
|
L |
671
|
|
|
|
|
|
|
L |
672
|
|
|
|
|
|
|
L |
673
|
|
|
|
|
|
|
L |
674
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
=head1 AUTHOR |
676
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
Ahmed Amin Elsheshtawy, احمد امين الششتاوى |
678
|
|
|
|
|
|
|
Website: http://www.mewsoft.com |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
Copyright (C) 2014 by Dr. Ahmed Amin Elsheshtawy support@mewsoft.com, |
683
|
|
|
|
|
|
|
L |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. |
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
=cut |
688
|
|
|
|
|
|
|
|