line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Sphinx::Config; |
2
|
|
|
|
|
|
|
|
3
|
5
|
|
|
5
|
|
188499
|
use warnings; |
|
5
|
|
|
|
|
13
|
|
|
5
|
|
|
|
|
173
|
|
4
|
5
|
|
|
5
|
|
30
|
use strict; |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
174
|
|
5
|
5
|
|
|
5
|
|
27
|
use Carp qw/croak/; |
|
5
|
|
|
|
|
13
|
|
|
5
|
|
|
|
|
368
|
|
6
|
5
|
|
|
5
|
|
157627
|
use Storable qw/dclone/; |
|
5
|
|
|
|
|
37347
|
|
|
5
|
|
|
|
|
627
|
|
7
|
5
|
|
|
5
|
|
5000
|
use List::MoreUtils qw/firstidx/; |
|
5
|
|
|
|
|
9591
|
|
|
5
|
|
|
|
|
26387
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 NAME |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
Sphinx::Config - Sphinx search engine configuration file read/modify/write |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=cut |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
our $VERSION = '0.09'; |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=head1 SYNOPSIS |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
use Sphinx::Config; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
my $c = Sphinx::Config->new(); |
22
|
|
|
|
|
|
|
$c->parse($filename); |
23
|
|
|
|
|
|
|
$path = $c->get('index', 'test1', 'path'); |
24
|
|
|
|
|
|
|
$c->set('index', 'test1', 'path', $path); |
25
|
|
|
|
|
|
|
$c->save($filename); |
26
|
|
|
|
|
|
|
... |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
=head1 CONSTRUCTOR |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=head2 new |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
$c = Sphinx::Config->new; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=cut |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
sub new { |
37
|
5
|
|
|
5
|
1
|
56
|
my $class = shift; |
38
|
|
|
|
|
|
|
|
39
|
5
|
|
33
|
|
|
55
|
bless { _bestow => 1 }, ref($class) || $class; |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
=head2 preserve_inheritance |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
$c->preserve_inheritance(0); |
45
|
|
|
|
|
|
|
$c->preserve_inheritance(1); |
46
|
|
|
|
|
|
|
$pi = $c->preserve_inheritance(1); |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
Set/get the current behaviour for preserving inherited values. When |
49
|
|
|
|
|
|
|
set to a non-zero value (the default), if a value is set in a parent |
50
|
|
|
|
|
|
|
section, then it is automatically inherited by any child sections, and |
51
|
|
|
|
|
|
|
when the configuration file is saved, values that are implicit through |
52
|
|
|
|
|
|
|
inheritance are not shown. When set to zero, each section is |
53
|
|
|
|
|
|
|
considered standalone and a complete set of values is shown in the |
54
|
|
|
|
|
|
|
saved file. |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
This flag may be enabled and disabled selectively for calls to set() and |
57
|
|
|
|
|
|
|
save(). |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
=cut |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
sub preserve_inheritance { |
62
|
2
|
|
|
2
|
1
|
6
|
my $self = shift; |
63
|
2
|
50
|
|
|
|
13
|
$self->{_bestow} = shift if @_; |
64
|
|
|
|
|
|
|
|
65
|
2
|
|
|
|
|
7
|
return $self->{_bestow}; |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
=head1 METHODS |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
=head2 parse |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
$c->parse($filename) |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
Parse the given Sphinx configuration file. |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
Dies on errors. |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=cut |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
sub parse { |
81
|
7
|
|
|
7
|
1
|
2499
|
my ($self, $filename) = @_; |
82
|
|
|
|
|
|
|
|
83
|
7
|
50
|
|
|
|
267
|
die "Sphinx::Config: $filename does not exist" unless -f $filename; |
84
|
|
|
|
|
|
|
|
85
|
7
|
|
|
|
|
16
|
my $fh; |
86
|
7
|
50
|
|
|
|
328
|
open($fh, "<$filename") or die "Sphinx::Config: cannot open $filename: $!"; |
87
|
7
|
|
|
|
|
5002
|
$self->{_file} = [ <$fh> ]; |
88
|
7
|
|
|
|
|
418
|
close( $fh ); |
89
|
7
|
|
|
|
|
21
|
$self->{_filename} = $filename; |
90
|
7
|
|
|
|
|
33
|
$self->_parse_file; |
91
|
7
|
|
|
|
|
75
|
return; |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
=head2 parse_string |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
$c->parse_string( $string ); |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
Parse the Sphinx configuration in the given string. |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
Dies on errors. |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
=cut |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
sub parse_string { |
105
|
3
|
|
|
3
|
1
|
5071
|
my( $self, $string ) = @_; |
106
|
|
|
|
|
|
|
# split string on newlines, keeping the newlines in-place |
107
|
3
|
|
|
|
|
39
|
$self->{_file} = [ split /^/m, $string ]; |
108
|
3
|
|
|
|
|
23
|
delete $self->{_filename}; |
109
|
|
|
|
|
|
|
# _filename is used by _parse_file in its error messages |
110
|
3
|
|
|
|
|
8
|
local $self->{_filename} = "STRING"; |
111
|
3
|
|
|
|
|
8
|
$self->_parse_file; |
112
|
3
|
|
|
|
|
8
|
return; |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
sub _parse_file |
116
|
|
|
|
|
|
|
{ |
117
|
10
|
|
|
10
|
|
20
|
my( $self ) = @_; |
118
|
|
|
|
|
|
|
|
119
|
10
|
|
|
|
|
19
|
my $state = 'outer'; |
120
|
10
|
|
|
|
|
22
|
my $seq = "section"; |
121
|
10
|
|
|
|
|
15
|
my $max = @{ $self->{_file} }; |
|
10
|
|
|
|
|
25
|
|
122
|
10
|
|
|
|
|
18
|
my $current; |
123
|
|
|
|
|
|
|
my @config; |
124
|
|
|
|
|
|
|
|
125
|
10
|
|
|
|
|
40
|
foreach( my $line = 0; $line < $max ; $line++ ) { |
126
|
2938
|
|
|
|
|
4966
|
my $first = $line; |
127
|
2938
|
|
|
|
|
5431
|
my $input = $self->{_file}[ $line ]; |
128
|
2938
|
|
|
|
|
4088
|
chomp $input; |
129
|
|
|
|
|
|
|
# discard comments |
130
|
2938
|
|
|
|
|
13813
|
$input =~ s/\s*\#.*//o; |
131
|
|
|
|
|
|
|
# merge continued lines |
132
|
2938
|
|
66
|
|
|
7846
|
while ($input =~ s!\\\s*$!!s and $line < $max ) { |
133
|
15
|
|
|
|
|
23
|
$line++; |
134
|
15
|
|
|
|
|
31
|
my $new = $self->{_file}[ $line ]; |
135
|
15
|
|
|
|
|
30
|
chomp( $new ); |
136
|
|
|
|
|
|
|
# We are folding all space up. XXX- How does Sphinx handle this? |
137
|
15
|
50
|
|
|
|
60
|
if( $input =~ / $/ ) { |
138
|
15
|
|
|
|
|
53
|
$new =~ s/^\s+//; |
139
|
|
|
|
|
|
|
} else { |
140
|
0
|
|
|
|
|
0
|
$new =~ s/^\s+/ /; |
141
|
|
|
|
|
|
|
} |
142
|
15
|
|
|
|
|
79
|
$input .= $new; |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
# handling this virtual line |
145
|
2938
|
|
|
|
|
9095
|
while ($input) { |
146
|
405
|
100
|
|
|
|
1007
|
if ($state eq 'outer') { |
|
|
50
|
|
|
|
|
|
147
|
|
|
|
|
|
|
# split into tokens, fully consuming input line |
148
|
103
|
|
|
|
|
298
|
my @tokens = split(/\s+/, $input); |
149
|
103
|
|
|
|
|
141
|
$input = ""; |
150
|
103
|
|
|
|
|
207
|
while( @tokens ) { |
151
|
219
|
|
|
|
|
295
|
my $tok = shift @tokens; |
152
|
219
|
100
|
|
|
|
422
|
next unless length $tok; |
153
|
211
|
100
|
|
|
|
716
|
if ($seq eq "section") { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
154
|
54
|
100
|
|
|
|
237
|
if ($tok =~ m/^(?:source|index)$/o) { |
|
|
50
|
|
|
|
|
|
155
|
43
|
|
|
|
|
222
|
$current = { _type => $tok, _lines => [ $first ] }; |
156
|
43
|
|
|
|
|
84
|
push(@config, $current); |
157
|
43
|
|
|
|
|
112
|
$seq = "name"; |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
elsif ($tok =~ m/^(?:indexer|searchd|search)$/o) { |
160
|
11
|
|
|
|
|
45
|
$current = { _type => $tok, _lines => [ $first ] }; |
161
|
11
|
|
|
|
|
28
|
push(@config, $current); |
162
|
11
|
|
|
|
|
54
|
$seq = "openblock"; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
else { |
165
|
0
|
|
|
|
|
0
|
die "Sphinx::Config: $self->{_filename}:$first: Expected section type, got '$tok'"; |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
elsif ($seq eq "name") { |
169
|
43
|
|
|
|
|
90
|
$current->{_name} = $tok; |
170
|
43
|
|
|
|
|
163
|
$seq = "openorinherit"; |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
elsif ($seq eq "openorinherit") { |
173
|
43
|
100
|
|
|
|
80
|
if ($tok eq ':') { |
174
|
17
|
|
|
|
|
53
|
$seq = "inherit"; |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
else { |
177
|
26
|
|
|
|
|
103
|
unshift(@tokens, $tok); |
178
|
26
|
|
|
|
|
65
|
$seq = "openblock"; |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
elsif ($seq eq "inherit") { |
182
|
17
|
50
|
|
|
|
53
|
die "Sphinx::Config:: $self->{_filename}:$line: a section may not inherit from itself" |
183
|
|
|
|
|
|
|
if $tok eq $current->{_name}; |
184
|
17
|
50
|
|
|
|
69
|
unless( $self->_setup_inherit( $current, $tok, \@config ) ) { |
185
|
0
|
|
|
|
|
0
|
die "Sphinx::Config: $self->{_filename}:$first: Base section '$tok' does not exist"; |
186
|
|
|
|
|
|
|
} |
187
|
17
|
|
|
|
|
93
|
$seq = "openblock"; |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
elsif ($seq eq "openblock") { |
190
|
54
|
50
|
|
|
|
116
|
die "Sphinx::Config: $self->{_filename}:$first: expected '{'" unless $tok eq "{"; |
191
|
54
|
|
|
|
|
70
|
$seq = "section"; |
192
|
54
|
|
|
|
|
127
|
$state = "inner"; |
193
|
|
|
|
|
|
|
# return any leftovers |
194
|
54
|
|
|
|
|
284
|
$input = join(" ", @tokens); |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
elsif ($state eq "inner") { |
199
|
302
|
|
|
|
|
742
|
my $pos = [ $first, $line ]; |
200
|
302
|
100
|
|
|
|
10481
|
if ($input =~ s/^\s*\}//o) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
201
|
54
|
|
|
|
|
86
|
$state = "outer"; |
202
|
54
|
|
|
|
|
116
|
$current->{_lines}[1] = $line; |
203
|
54
|
|
|
|
|
232
|
$current = undef; |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
elsif ($input =~ s/^\s*([\w]+)\s*=\s*(.*)\s*$//o) { |
206
|
244
|
|
|
|
|
467
|
my $k = $1; |
207
|
244
|
|
|
|
|
484
|
my $v = $2; |
208
|
244
|
100
|
100
|
|
|
859
|
if (exists($current->{_data}->{$k}) && ! $current->{_inherited}->{$k}) { |
209
|
13
|
50
|
|
|
|
39
|
if (ref($current->{_data}->{$k}) eq 'ARRAY') { |
210
|
|
|
|
|
|
|
# append to existing array |
211
|
0
|
|
|
|
|
0
|
push(@{$current->{_data}->{$k}}, $v); |
|
0
|
|
|
|
|
0
|
|
212
|
|
|
|
|
|
|
} |
213
|
|
|
|
|
|
|
else { |
214
|
|
|
|
|
|
|
# promote to array |
215
|
13
|
|
|
|
|
63
|
$current->{_data}->{$k} = [ $current->{_data}->{$k}, $v ]; |
216
|
|
|
|
|
|
|
} |
217
|
13
|
|
|
|
|
23
|
push(@{$current->{_pos}->{$k}}, $pos); |
|
13
|
|
|
|
|
72
|
|
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
else { |
220
|
|
|
|
|
|
|
# first or simple value |
221
|
231
|
|
|
|
|
732
|
$current->{_data}->{$k} = $v; |
222
|
231
|
|
|
|
|
723
|
$current->{_pos}->{$k} = [$pos]; |
223
|
231
|
|
|
|
|
1191
|
$current->{_inherited}->{$k} = 0; |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
elsif ($input =~ s/^\s+$//o) { |
227
|
|
|
|
|
|
|
# carry on |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
else { |
230
|
0
|
|
|
|
|
0
|
die "Sphinx::Config: $self->{_filename}:$line: expected name=value pair or end of section, got '$input'"; |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
|
236
|
10
|
|
|
|
|
26
|
$self->{_config} = \@config; |
237
|
10
|
|
|
|
|
26
|
my %keys; |
238
|
10
|
|
|
|
|
26
|
for (@config) { |
239
|
54
|
100
|
|
|
|
244
|
$keys{$_->{_type} . ($_->{_name}?(' ' . $_->{_name}):'')} = $_; |
240
|
|
|
|
|
|
|
} |
241
|
|
|
|
|
|
|
|
242
|
10
|
|
|
|
|
30
|
$self->{_keys} = \%keys; |
243
|
10
|
|
|
|
|
14926
|
return; |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
# Find a section. |
248
|
|
|
|
|
|
|
# Either in $config (at parse-time) or in {_keys} |
249
|
|
|
|
|
|
|
sub _find_section |
250
|
|
|
|
|
|
|
{ |
251
|
20
|
|
|
20
|
|
37
|
my( $self, $type, $name, $config ) = @_; |
252
|
20
|
100
|
|
|
|
39
|
if( $config ) { |
253
|
17
|
|
|
|
|
20
|
my $c; |
254
|
17
|
|
|
|
|
67
|
for (my $i = 0; $i <= $#$config; $i++) { |
255
|
31
|
|
|
|
|
52
|
$c = $config->[$i]; |
256
|
31
|
50
|
|
|
|
140
|
next unless $c->{_name}; # ignore searchd, indexer sections |
257
|
31
|
100
|
66
|
|
|
155
|
if( $c->{_name} eq $name && $c->{_type} eq $type ) { |
258
|
17
|
|
|
|
|
54
|
return $c; |
259
|
|
|
|
|
|
|
} |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
else { |
263
|
3
|
|
|
|
|
4
|
my $key = $type; |
264
|
3
|
50
|
|
|
|
7
|
$key .= " $name" if $name; |
265
|
3
|
|
|
|
|
7
|
return $self->{_keys}{$key}; |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
} |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
# setup (or change) the inheritance of a section |
270
|
|
|
|
|
|
|
# returns true on success |
271
|
|
|
|
|
|
|
# returns undef if it can't find the base section |
272
|
|
|
|
|
|
|
sub _setup_inherit |
273
|
|
|
|
|
|
|
{ |
274
|
20
|
|
|
20
|
|
35
|
my( $self, $current, $base_name, $config ) = @_; |
275
|
|
|
|
|
|
|
|
276
|
20
|
|
|
|
|
60
|
my $base = $self->_find_section( $current->{_type}, $base_name, $config ); |
277
|
|
|
|
|
|
|
|
278
|
20
|
50
|
33
|
|
|
117
|
return unless defined $base && $base != $current; |
279
|
|
|
|
|
|
|
|
280
|
20
|
|
100
|
|
|
88
|
my $out = $current->{_data} ||= {}; |
281
|
|
|
|
|
|
|
|
282
|
20
|
100
|
|
|
|
55
|
if( $current->{_inherit} ) { |
283
|
|
|
|
|
|
|
# Delete all inherited variables |
284
|
3
|
|
|
|
|
4
|
my $I = $current->{_inherited}; |
285
|
3
|
|
|
|
|
11
|
while( my( $f, $v ) = each %$I ) { |
286
|
12
|
100
|
|
|
|
23
|
next unless $v; |
287
|
10
|
|
|
|
|
27
|
delete $out->{$f}; |
288
|
|
|
|
|
|
|
} |
289
|
3
|
|
|
|
|
7
|
$current->{_inherited} = {}; |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
|
292
|
20
|
|
|
|
|
44
|
$current->{_inherit} = $base_name; |
293
|
|
|
|
|
|
|
# XXX - check that {_children} doesn't already have {_name} |
294
|
20
|
|
100
|
|
|
23
|
push(@{$base->{_children} ||= []}, $current->{_name}); |
|
20
|
|
|
|
|
92
|
|
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
# copy new values over |
297
|
20
|
|
50
|
|
|
1355
|
my $in = dclone($base->{_data} || {}); |
298
|
20
|
|
|
|
|
89
|
while( my( $f, $v ) = each %$in ) { |
299
|
150
|
100
|
|
|
|
314
|
next if exists $out->{$f}; |
300
|
148
|
|
|
|
|
237
|
$out->{$f} = $v; |
301
|
148
|
|
|
|
|
738
|
$current->{_inherited}{ $f } = 1; |
302
|
|
|
|
|
|
|
} |
303
|
20
|
|
|
|
|
104
|
return 1; |
304
|
|
|
|
|
|
|
} |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
=head2 config |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
$config = $c->config; |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
Get the parsed configuration data as an array of hashes, where each entry in the |
314
|
|
|
|
|
|
|
array represents one section of the configuration, in the order as parsed or |
315
|
|
|
|
|
|
|
constructed. |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
Each section is described by a hash with the following keys: |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
=over 4 |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
=item * _type A mandatory key describing the section type (index, searchd etc) |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
=item * _name The name of the section, where applicable |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
=item * _inherited The name of the parent section, where applicable |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
=item * _data A hash containing the name/value pairs which hold the |
328
|
|
|
|
|
|
|
configuration data for the section. All values are simple data |
329
|
|
|
|
|
|
|
elements, except where the same key can appear multiple times in the |
330
|
|
|
|
|
|
|
configuration file with different values (such as in attribute |
331
|
|
|
|
|
|
|
declarations), in which case the value is an array ref. |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
=item * _inherited A hash describing which data values have been inherited |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
=back |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
=cut |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
sub config { |
340
|
3
|
|
|
3
|
1
|
30
|
return shift->{_config}; |
341
|
|
|
|
|
|
|
} |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
=head2 get |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
$value = $c->get($type, $name, $varname) |
346
|
|
|
|
|
|
|
$value = $c->get($type, $name) |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
Get the value of a configuration parameter. |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
If $varname is specified, the value of the named parameter from the section |
351
|
|
|
|
|
|
|
identified by the type and name is returned as a scalar. Otherwise, the hash containing all key/value pairs from the section is returned. |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
$name may be undef for sections that do not require a name (e.g. searchd, |
354
|
|
|
|
|
|
|
indexer, search). |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
If the section cannot be found or the named parameter does not exist, undef is |
357
|
|
|
|
|
|
|
returned. |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
=cut |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
sub get { |
362
|
43
|
|
|
43
|
1
|
9868
|
my ($self, $type, $name, $var) = @_; |
363
|
|
|
|
|
|
|
|
364
|
43
|
|
|
|
|
63
|
my $key = $type; |
365
|
43
|
100
|
|
|
|
262
|
$key .= ' ' . $name if $name; |
366
|
|
|
|
|
|
|
|
367
|
43
|
|
|
|
|
92
|
my $current = $self->{_keys}->{$key}; |
368
|
43
|
100
|
|
|
|
103
|
return undef unless $current; |
369
|
41
|
100
|
|
|
|
79
|
if ($var) { |
370
|
34
|
100
|
|
|
|
83
|
if ($var =~ m/^_/) { |
371
|
3
|
|
|
|
|
10
|
return $current->{$var}; |
372
|
|
|
|
|
|
|
} |
373
|
|
|
|
|
|
|
else { |
374
|
31
|
|
|
|
|
156
|
return $current->{_data}->{$var}; |
375
|
|
|
|
|
|
|
} |
376
|
|
|
|
|
|
|
} |
377
|
|
|
|
|
|
|
|
378
|
7
|
|
|
|
|
33
|
return $current->{_data}; |
379
|
|
|
|
|
|
|
} |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
=head2 set |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
$c->set($type, $name, $varname, $value) |
384
|
|
|
|
|
|
|
$c->set($type, $name, \%values) |
385
|
|
|
|
|
|
|
$c->set($type, $name, undef(), $base_name) |
386
|
|
|
|
|
|
|
$c->set($type, $name, \%values, $base_name) |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
Set the value or values of a section in the configuration. |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
If varname is given, then the single parameter of that name in the |
391
|
|
|
|
|
|
|
given section is set to the specified value. If the value is an |
392
|
|
|
|
|
|
|
array, multiple entries will be created in the output file for the |
393
|
|
|
|
|
|
|
same key. |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
If a hash of name/value pairs is given, then any existing values are replaced |
396
|
|
|
|
|
|
|
with the given hash. |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
$c->set('source', , $name, \%values); |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
If the section does not currently exist, a new one is appended. |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
Set C<$name> to C to set variables in an C, C or |
403
|
|
|
|
|
|
|
C section. |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
$c->set('indexer', undef, 'listen', $port); |
406
|
|
|
|
|
|
|
$c->set('search', undef, \%values ); |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
To change the section's inheritance, set $value to undef and specify a value |
409
|
|
|
|
|
|
|
in the 4th parameter. |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
$c->set('source', 'src1', undef(), 'base2'); |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
You this may be combined with a hash variable : |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
$c->set('source', 'src1', \%values, 'base_source'); |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
To delete a name/value pair, set $value to undef. |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
$c->set('source', 'src1', 'sql_query_pre', undef()); |
420
|
|
|
|
|
|
|
$c->set('source', 'src1', 'sql_query_pre'); |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
Returns the hash containing the current data values for the given section. |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
See L for a description of how inherited values are handled. |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
=cut |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
sub set { |
429
|
19
|
|
|
19
|
1
|
2053
|
my ($self, $type, $name, $var, $value) = @_; |
430
|
|
|
|
|
|
|
|
431
|
19
|
|
|
|
|
26
|
my $key = $type; |
432
|
19
|
100
|
|
|
|
68
|
$key .= ' ' . $name if $name; |
433
|
|
|
|
|
|
|
|
434
|
19
|
100
|
|
|
|
61
|
if (! $self->{_keys}->{$key}) { |
435
|
|
|
|
|
|
|
# append to configuration |
436
|
1
|
|
|
|
|
3
|
my $current = { _type => $type, _new => 1 }; |
437
|
1
|
50
|
|
|
|
4
|
$current->{_name} = $name if $name; |
438
|
1
|
|
|
|
|
2
|
push(@{$self->{_config}}, $current); |
|
1
|
|
|
|
|
3
|
|
439
|
1
|
|
|
|
|
3
|
$self->{_keys}->{$key} = $current; |
440
|
|
|
|
|
|
|
# new lines will be created by as_string() |
441
|
|
|
|
|
|
|
# set inheritance at the same time |
442
|
|
|
|
|
|
|
} |
443
|
|
|
|
|
|
|
|
444
|
19
|
100
|
100
|
|
|
101
|
if( not defined $var and $value ) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
445
|
|
|
|
|
|
|
# change inheritance |
446
|
2
|
50
|
|
|
|
8
|
unless( $self->_change_inherit( $key, $value ) ) { |
447
|
0
|
|
|
|
|
0
|
croak "Sphinx::Config: Unable to find $name $value for inheritance"; |
448
|
|
|
|
|
|
|
} |
449
|
|
|
|
|
|
|
} |
450
|
|
|
|
|
|
|
elsif (! ref($var)) { |
451
|
14
|
100
|
|
|
|
48
|
if (! defined($var)) { |
|
|
50
|
|
|
|
|
|
452
|
|
|
|
|
|
|
# delete section |
453
|
2
|
50
|
|
|
|
13
|
if (my $entry = delete $self->{_keys}->{$key}) { |
454
|
2
|
|
|
7
|
|
10
|
my $i = firstidx { $_ == $entry } @{$self->{_config}}; |
|
7
|
|
|
|
|
17
|
|
|
2
|
|
|
|
|
37
|
|
455
|
2
|
50
|
|
|
|
14
|
if( $i >= 0 ) { |
456
|
|
|
|
|
|
|
# delete config |
457
|
2
|
|
|
|
|
28
|
splice(@{$self->{_config}}, $i, 1); |
|
2
|
|
|
|
|
9
|
|
458
|
|
|
|
|
|
|
# delete from file |
459
|
2
|
|
|
|
|
7
|
$self->_clear_lines( $entry->{_lines} ); |
460
|
|
|
|
|
|
|
} |
461
|
|
|
|
|
|
|
} |
462
|
|
|
|
|
|
|
} |
463
|
|
|
|
|
|
|
elsif ($var =~ m/^_/) { |
464
|
|
|
|
|
|
|
# This seems to be mainly useful for unit tests |
465
|
0
|
0
|
|
|
|
0
|
if (defined $value) { |
466
|
0
|
|
|
|
|
0
|
$self->{_keys}->{$key}->{$var} = $value; |
467
|
|
|
|
|
|
|
} |
468
|
|
|
|
|
|
|
else { |
469
|
0
|
|
|
|
|
0
|
delete $self->{_keys}->{$key}->{$var}; |
470
|
|
|
|
|
|
|
} |
471
|
|
|
|
|
|
|
# _keys belong to us : no inheritance, not written to config file |
472
|
|
|
|
|
|
|
} |
473
|
|
|
|
|
|
|
else { |
474
|
12
|
|
|
|
|
36
|
$self->_set( $type, $name, $var, $value ); |
475
|
|
|
|
|
|
|
} |
476
|
|
|
|
|
|
|
} |
477
|
|
|
|
|
|
|
elsif (ref($var) eq "HASH") { |
478
|
3
|
|
|
|
|
13
|
$self->_redefine( $type, $name, $var ); |
479
|
3
|
100
|
|
|
|
10
|
if( $value ) { |
480
|
|
|
|
|
|
|
# Change inheritance |
481
|
1
|
50
|
|
|
|
3
|
unless( $self->_change_inherit( $key, $value ) ) { |
482
|
0
|
|
|
|
|
0
|
croak "Sphinx::Config: Unable to find $type $value for inheritance"; |
483
|
|
|
|
|
|
|
} |
484
|
|
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
} |
486
|
|
|
|
|
|
|
else { |
487
|
0
|
|
|
|
|
0
|
croak "Must provide variable name or hash, not " . ref($var); |
488
|
|
|
|
|
|
|
} |
489
|
|
|
|
|
|
|
|
490
|
19
|
|
|
|
|
80
|
return $self->{_keys}->{$key}->{_data}; |
491
|
|
|
|
|
|
|
} |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
# Set or remove a variable. Deals with inheritance |
494
|
|
|
|
|
|
|
sub _set |
495
|
|
|
|
|
|
|
{ |
496
|
16
|
|
|
16
|
|
32
|
my( $self, $type, $name, $var, $value ) = @_; |
497
|
|
|
|
|
|
|
|
498
|
16
|
|
|
|
|
23
|
my $key = $type; |
499
|
16
|
100
|
|
|
|
45
|
$key .= " $name" if $name; |
500
|
|
|
|
|
|
|
|
501
|
16
|
100
|
|
|
|
31
|
if (defined $value) { |
502
|
15
|
|
|
|
|
42
|
$self->{_keys}->{$key}->{_data}->{$var} = $value; |
503
|
15
|
|
|
|
|
39
|
$self->_set_var_lines( $key, $var, $value ); |
504
|
|
|
|
|
|
|
} |
505
|
|
|
|
|
|
|
else { |
506
|
1
|
|
|
|
|
5
|
delete $self->{_keys}->{$key}->{_data}->{$var}; |
507
|
1
|
|
|
|
|
5
|
$self->_clear_var_lines( $key, $var ); |
508
|
|
|
|
|
|
|
} |
509
|
16
|
100
|
|
|
|
87
|
if( $self->{_keys}{$key}{_inherit} ) { |
510
|
3
|
|
|
|
|
7
|
$self->{_keys}->{$key}->{_inherited}->{$var} = 0; |
511
|
|
|
|
|
|
|
} |
512
|
|
|
|
|
|
|
|
513
|
16
|
100
|
|
|
|
27
|
for my $child (@{$self->{_keys}->{$key}->{_children} || []}) { |
|
16
|
|
|
|
|
92
|
|
514
|
8
|
|
|
|
|
21
|
my $ckey = join ' ', $type, $child; |
515
|
8
|
50
|
|
|
|
27
|
my $c = $self->{_keys}->{$ckey} or next; |
516
|
8
|
100
|
|
|
|
20
|
if ($self->{_bestow}) { |
517
|
4
|
50
|
|
|
|
13
|
if ($c->{_inherited}->{$var}) { |
518
|
4
|
100
|
|
|
|
10
|
if (defined $value) { |
519
|
2
|
|
|
|
|
9
|
$c->{_data}->{$var} = $value; |
520
|
|
|
|
|
|
|
} |
521
|
|
|
|
|
|
|
else { |
522
|
2
|
|
|
|
|
10
|
delete $c->{_data}->{$var}; |
523
|
|
|
|
|
|
|
} |
524
|
|
|
|
|
|
|
} |
525
|
|
|
|
|
|
|
} |
526
|
|
|
|
|
|
|
else { |
527
|
4
|
|
|
|
|
10
|
$c->{_inherited}->{$var} = 0; |
528
|
4
|
|
|
|
|
13
|
$self->_set_var_lines( $ckey, $var, $c->{_data}{$var} ); |
529
|
|
|
|
|
|
|
} |
530
|
|
|
|
|
|
|
} |
531
|
|
|
|
|
|
|
} |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
# Completely redefine a section |
534
|
|
|
|
|
|
|
sub _redefine { |
535
|
3
|
|
|
3
|
|
7
|
my( $self, $type, $name, $var ) = @_; |
536
|
|
|
|
|
|
|
|
537
|
3
|
|
|
|
|
6
|
my $key = $type; |
538
|
3
|
100
|
|
|
|
57
|
$key .= " $name" if $name; |
539
|
3
|
|
|
|
|
11
|
my $section = $self->{_keys}{$key}; |
540
|
|
|
|
|
|
|
|
541
|
3
|
|
|
|
|
253
|
$var = dclone $var; |
542
|
|
|
|
|
|
|
# Get a list of variables that currently exist |
543
|
3
|
|
|
|
|
6
|
my @have = keys %{ $section->{_data} }; |
|
3
|
|
|
|
|
14
|
|
544
|
3
|
|
|
|
|
5
|
my %had; |
545
|
3
|
|
|
|
|
36
|
@had{ @have } = (1) x @have; |
546
|
|
|
|
|
|
|
# Set new values |
547
|
3
|
|
|
|
|
13
|
foreach my $sk ( keys %$var ) { |
548
|
4
|
|
|
|
|
16
|
$self->_set( $type, $name, $sk, $var->{$sk} ); |
549
|
4
|
|
|
|
|
10
|
delete $had{ $sk }; |
550
|
|
|
|
|
|
|
} |
551
|
|
|
|
|
|
|
# Delete any remaining non-inherited values |
552
|
3
|
|
|
|
|
16
|
foreach my $sk ( keys %had ) { |
553
|
3
|
50
|
|
|
|
10
|
next if $section->{_inherited}{$sk}; |
554
|
0
|
|
|
|
|
0
|
$self->_set( $type, $name, $sk ); |
555
|
|
|
|
|
|
|
} |
556
|
|
|
|
|
|
|
} |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
# Clear all lines between $pos->[0] and $pos->[1], inclusive |
560
|
|
|
|
|
|
|
sub _clear_lines { |
561
|
11
|
|
|
11
|
|
31
|
my( $self, $pos ) = @_; |
562
|
11
|
|
|
|
|
50
|
for( my $line= $pos->[0]; $line <= $pos->[1]; $line++ ) { |
563
|
22
|
|
|
|
|
82
|
$self->{_file}[$line] = undef; |
564
|
|
|
|
|
|
|
} |
565
|
|
|
|
|
|
|
} |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
# Clear all lines associated with a variable |
568
|
|
|
|
|
|
|
sub _clear_var_lines { |
569
|
8
|
|
|
8
|
|
16
|
my( $self, $key, $var ) = @_; |
570
|
8
|
|
|
|
|
11
|
foreach my $pos ( @{ $self->{_keys}{$key}{_pos}{$var} } ) { |
|
8
|
|
|
|
|
35
|
|
571
|
9
|
|
|
|
|
21
|
$self->_clear_lines( $pos ); |
572
|
|
|
|
|
|
|
} |
573
|
|
|
|
|
|
|
} |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
# Append a variable to a section |
576
|
|
|
|
|
|
|
sub _append_var_lines { |
577
|
9
|
|
|
9
|
|
19
|
my( $self, $key, $var, $value ) = @_; |
578
|
9
|
|
|
|
|
20
|
my $section = $self->{_keys}{ $key }; |
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
# find last variable |
581
|
9
|
|
|
|
|
11
|
my( $last, $last_var, $output ); |
582
|
9
|
|
|
|
|
18
|
foreach my $var ( keys %{ $section->{_pos} } ) { |
|
9
|
|
|
|
|
31
|
|
583
|
10
|
|
|
|
|
14
|
foreach my $pos ( @{ $section->{_pos}{$var} } ) { |
|
10
|
|
|
|
|
20
|
|
584
|
10
|
100
|
100
|
|
|
47
|
if( not $last or $pos->[1] > $last->[1] ) { |
585
|
6
|
|
|
|
|
8
|
$last_var = $var; |
586
|
6
|
|
|
|
|
18
|
$last = $pos |
587
|
|
|
|
|
|
|
} |
588
|
|
|
|
|
|
|
} |
589
|
|
|
|
|
|
|
} |
590
|
|
|
|
|
|
|
# adding to an empty section? |
591
|
9
|
100
|
|
|
|
25
|
unless( $last ) { |
592
|
5
|
|
|
|
|
8
|
$last = $section->{_lines}; |
593
|
5
|
|
|
|
|
15
|
$output = $self->_var_as_string( $var, $value ); |
594
|
|
|
|
|
|
|
} |
595
|
|
|
|
|
|
|
else { |
596
|
4
|
|
|
|
|
11
|
$output = $self->_get_var_lines( $last ); |
597
|
|
|
|
|
|
|
# change the key |
598
|
4
|
|
|
|
|
55
|
$output =~ s/$last_var(\s*=)/$var$1/; |
599
|
|
|
|
|
|
|
# change the value(s) |
600
|
4
|
|
|
|
|
13
|
$output = $self->_set_var_value( $output, $var, $value ); |
601
|
|
|
|
|
|
|
} |
602
|
9
|
|
|
|
|
38
|
$section->{_append}{$var} = $output; |
603
|
|
|
|
|
|
|
} |
604
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
sub _set_var_value { |
606
|
15
|
|
|
15
|
|
32
|
my( $self, $output, $var, $value ) = @_; |
607
|
15
|
100
|
|
|
|
28
|
unless( ref $value ) { |
608
|
13
|
|
|
|
|
294
|
$output =~ s/($var\s*=\s*)(.+)$/$1$value\n/s; |
609
|
|
|
|
|
|
|
} |
610
|
|
|
|
|
|
|
else { |
611
|
2
|
|
|
|
|
6
|
my $line = $output; |
612
|
2
|
|
|
|
|
3
|
$output = ''; |
613
|
2
|
|
|
|
|
7
|
foreach my $v ( @$value ) { |
614
|
4
|
|
|
|
|
14
|
$output .= $self->_set_var_value( $line, $var, $v ); |
615
|
|
|
|
|
|
|
} |
616
|
|
|
|
|
|
|
} |
617
|
15
|
|
|
|
|
49
|
return $output; |
618
|
|
|
|
|
|
|
} |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
# Convert a [min,max] into a string that may be modified |
621
|
|
|
|
|
|
|
sub _get_var_lines { |
622
|
11
|
|
|
11
|
|
13
|
my( $self, $pos ) = @_; |
623
|
11
|
|
|
|
|
13
|
my @text; |
624
|
11
|
|
|
|
|
43
|
for( my $line= $pos->[0] ; $line <= $pos->[1] ; $line++ ) { |
625
|
12
|
|
50
|
|
|
56
|
push @text, $self->{_file}[$line]||''; |
626
|
|
|
|
|
|
|
} |
627
|
11
|
|
|
|
|
90
|
return join '', @text; |
628
|
|
|
|
|
|
|
} |
629
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
# Change the line(s) associated with a variable |
631
|
|
|
|
|
|
|
sub _set_var_lines { |
632
|
19
|
|
|
19
|
|
34
|
my( $self, $key, $var, $value ) = @_; |
633
|
|
|
|
|
|
|
|
634
|
19
|
|
|
|
|
34
|
my $section = $self->{_keys}{ $key }; |
635
|
19
|
50
|
|
|
|
44
|
croak "Can't find section $key" unless $section; |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
# New variable... |
638
|
19
|
100
|
|
|
|
57
|
unless( $section->{_pos}{ $var } ) { |
639
|
|
|
|
|
|
|
# ... in a new section: generated by as_string |
640
|
12
|
100
|
|
|
|
32
|
return if $section->{_new}; |
641
|
|
|
|
|
|
|
|
642
|
9
|
|
|
|
|
23
|
$self->_append_var_lines( $key, $var, $value ); |
643
|
9
|
|
|
|
|
23
|
return; |
644
|
|
|
|
|
|
|
} |
645
|
|
|
|
|
|
|
|
646
|
|
|
|
|
|
|
# build one line based on the first instance |
647
|
7
|
|
|
|
|
16
|
my $pos = $section->{_pos}{$var}[0]; |
648
|
7
|
|
|
|
|
24
|
my $input = $self->_get_var_lines( $pos ); |
649
|
|
|
|
|
|
|
# modify the line |
650
|
7
|
|
|
|
|
33
|
my $output = $self->_set_var_value( $input, $var, $value ); |
651
|
|
|
|
|
|
|
# clear every other instance |
652
|
7
|
|
|
|
|
23
|
$self->_clear_var_lines( $key, $var ); |
653
|
|
|
|
|
|
|
# set the new line |
654
|
7
|
|
|
|
|
19
|
$self->{_file}[$pos->[0]] = $output; |
655
|
|
|
|
|
|
|
# only one pos, on only one line. Yes this line could contain \n, but |
656
|
|
|
|
|
|
|
# and this will cause problems |
657
|
7
|
|
|
|
|
10
|
$pos->[1] = $pos->[0]; |
658
|
7
|
|
|
|
|
21
|
$section->{_pos}{$var} = [ $pos ]; |
659
|
7
|
|
|
|
|
19
|
return; |
660
|
|
|
|
|
|
|
} |
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
# Change the inheritance of a section |
663
|
|
|
|
|
|
|
sub _set_inherit_lines { |
664
|
3
|
|
|
3
|
|
4
|
my( $self, $key, $base_name, $was ) = @_; |
665
|
|
|
|
|
|
|
|
666
|
3
|
|
|
|
|
6
|
my $section = $self->{_keys}{ $key }; |
667
|
3
|
50
|
|
|
|
9
|
croak "Can't find section $key" unless $section; |
668
|
3
|
50
|
|
|
|
7
|
return 1 if $section->{_new}; |
669
|
|
|
|
|
|
|
|
670
|
3
|
|
|
|
|
3
|
my $file = $self->{_file}; |
671
|
3
|
|
|
|
|
6
|
my $pos = $section->{_lines}; |
672
|
3
|
|
|
|
|
4
|
my $done; |
673
|
3
|
|
|
|
|
10
|
for( my $line=$pos->[0]; $line <= $pos->[1]; $line++ ) { |
674
|
7
|
50
|
|
|
|
16
|
next unless defined $file->[$line]; |
675
|
7
|
50
|
|
|
|
11
|
if( $was ) { |
|
|
0
|
|
|
|
|
|
676
|
7
|
100
|
100
|
|
|
143
|
if( ($file->[$line] =~ s/(:\s*)$was/$1$base_name/ or |
677
|
|
|
|
|
|
|
$file->[$line] =~ s/^(\s*)$was(\s*(\{|\Z))/$1$base_name$2/ ) ) { |
678
|
3
|
|
|
|
|
15
|
return 1; |
679
|
|
|
|
|
|
|
} |
680
|
|
|
|
|
|
|
} |
681
|
|
|
|
|
|
|
elsif( $file->[$line] =~ s/\{/$base_name {/ ) { |
682
|
0
|
|
|
|
|
0
|
return 1; |
683
|
|
|
|
|
|
|
} |
684
|
|
|
|
|
|
|
} |
685
|
0
|
|
|
|
|
0
|
die "Can't find where to put the base name in ", join '', |
686
|
0
|
|
|
|
|
0
|
@{ $file }[ $pos->[0] .. $pos->[1] ]; |
687
|
|
|
|
|
|
|
} |
688
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
sub _change_inherit { |
690
|
3
|
|
|
3
|
|
5
|
my( $self, $key, $base_name ) = @_; |
691
|
3
|
|
|
|
|
4
|
my $section = $self->{_keys}{$key}; |
692
|
3
|
|
|
|
|
5
|
my $was = $section->{_inherit}; |
693
|
3
|
50
|
|
|
|
7
|
return unless $self->_setup_inherit( $section, $base_name ); |
694
|
3
|
|
|
|
|
11
|
return $self->_set_inherit_lines( $key, $base_name, $was ); |
695
|
|
|
|
|
|
|
} |
696
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
=head2 save |
698
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
$c->save |
700
|
|
|
|
|
|
|
$c->save($filename, $comment) |
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
Save the configuration to a file. The currently opened file is used if not |
703
|
|
|
|
|
|
|
specified. |
704
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
The comment is inserted literally, so each line should begin with '#'. |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
See L for a description of how inherited blocks are handled. |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
=cut |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
sub save { |
712
|
3
|
|
|
3
|
1
|
8
|
my ($self, $filename, $comment) = @_; |
713
|
|
|
|
|
|
|
|
714
|
3
|
0
|
33
|
|
|
11
|
if( not $filename and not $self->{_filename} ) { |
715
|
0
|
|
|
|
|
0
|
croak "Sphinx::Config: Please to specify the file to save to"; |
716
|
|
|
|
|
|
|
} |
717
|
|
|
|
|
|
|
|
718
|
3
|
|
33
|
|
|
8
|
$filename ||= $self->{_filename}; |
719
|
|
|
|
|
|
|
|
720
|
3
|
|
|
|
|
5
|
my $fh; |
721
|
3
|
50
|
|
|
|
606
|
open($fh, ">$filename") or croak "Sphinx::Config: Cannot open $filename for writing"; |
722
|
3
|
|
|
|
|
14
|
print $fh $self->as_string($comment); |
723
|
3
|
|
|
|
|
144
|
close($fh); |
724
|
|
|
|
|
|
|
} |
725
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
=head2 as_string |
729
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
$s = $c->as_string |
731
|
|
|
|
|
|
|
$s = $c->as_string($comment) |
732
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
Returns the configuration as a string, optionally with a comment prepended. |
734
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
The comment is inserted literally, so each line should begin with '#'. |
736
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
An effort has been made to make the configuration round-trip safe. That is, |
738
|
|
|
|
|
|
|
any formating or comments in the original should also appear as-is in the |
739
|
|
|
|
|
|
|
generated configuration. New sections are added at the end of the |
740
|
|
|
|
|
|
|
configuration with an 8 space indent. |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
New variables added to existing sections are handled as follows: |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
=over 4 |
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
=item * |
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
If you add a new variable to an existing section, it is added at the end of |
749
|
|
|
|
|
|
|
the section, using the whitespace of the last existing variable. |
750
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
Given: |
752
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
index foo { |
754
|
|
|
|
|
|
|
biff= bof |
755
|
|
|
|
|
|
|
# ... |
756
|
|
|
|
|
|
|
} |
757
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
and you add C with the value C, you will end up with: |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
index foo { |
761
|
|
|
|
|
|
|
biff= bof |
762
|
|
|
|
|
|
|
# ... |
763
|
|
|
|
|
|
|
honk= bonk |
764
|
|
|
|
|
|
|
} |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
=item * |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
If you have a comment that looks a bit like the default or commented out |
769
|
|
|
|
|
|
|
variable, the new value is added after the comment. |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
Given: |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
index foo { |
774
|
|
|
|
|
|
|
.... |
775
|
|
|
|
|
|
|
# honk=foo |
776
|
|
|
|
|
|
|
# more details |
777
|
|
|
|
|
|
|
} |
778
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
and you add C with the value C, you will end up with: |
780
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
index foo { |
782
|
|
|
|
|
|
|
.... |
783
|
|
|
|
|
|
|
# honk=foo |
784
|
|
|
|
|
|
|
honk = bonk |
785
|
|
|
|
|
|
|
# more details |
786
|
|
|
|
|
|
|
} |
787
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
=back |
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
=cut |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
sub as_string { |
793
|
6
|
|
|
6
|
1
|
333
|
my ($self, $comment) = @_; |
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
# By using a copy, ->as_string can be called multiple times, even |
796
|
|
|
|
|
|
|
# if we append variables to a section. Otherwise the new variables |
797
|
|
|
|
|
|
|
# would be added multiple times |
798
|
6
|
50
|
33
|
|
|
30
|
if (! $self->{_file} || ! @{$self->{_file}}) { |
|
6
|
|
|
|
|
23
|
|
799
|
0
|
|
|
|
|
0
|
return $self->as_string_new($comment); |
800
|
|
|
|
|
|
|
} |
801
|
6
|
|
|
|
|
10
|
my $file = [@{ $self->{_file} }]; |
|
6
|
|
|
|
|
471
|
|
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
# Find new sections and variables |
804
|
6
|
|
|
|
|
15
|
my @todo; |
805
|
6
|
|
|
|
|
8
|
foreach my $section ( @{ $self->{_config} } ) { |
|
6
|
|
|
|
|
18
|
|
806
|
33
|
100
|
|
|
|
88
|
unless( $section->{_lines} ) { |
807
|
1
|
|
|
|
|
2
|
push @todo, $section; |
808
|
1
|
|
|
|
|
2
|
next; |
809
|
|
|
|
|
|
|
} |
810
|
32
|
100
|
|
|
|
89
|
if( $section->{_append} ) { |
811
|
7
|
|
|
|
|
10
|
my $A = { %{ $section->{_append} } }; |
|
7
|
|
|
|
|
30
|
|
812
|
7
|
|
|
|
|
15
|
my $pos = $section->{_lines}; |
813
|
|
|
|
|
|
|
LINE: |
814
|
7
|
|
|
|
|
32
|
for( my $line = $pos->[0] ; $line <= $pos->[1] ; $line++ ) { |
815
|
34
|
|
|
|
|
69
|
foreach my $var ( keys %$A ) { |
816
|
52
|
100
|
|
|
|
857
|
next unless $file->[$line] =~ /(\s*)#\s*$var/; |
817
|
1
|
|
|
|
|
3
|
my $prefix = $1; |
818
|
1
|
|
|
|
|
2
|
my $output = delete $A->{$var}; |
819
|
1
|
|
|
|
|
4
|
$output =~ s/^\s+//; |
820
|
1
|
|
|
|
|
3
|
$file->[$line] .= "$prefix$output"; |
821
|
1
|
|
|
|
|
5
|
next LINE; |
822
|
|
|
|
|
|
|
} |
823
|
|
|
|
|
|
|
} |
824
|
7
|
50
|
|
|
|
20
|
if( %$A ) { |
825
|
7
|
|
|
|
|
23
|
my $add = join '', values %$A; |
826
|
7
|
|
|
|
|
19
|
$DB::single = 1; |
827
|
7
|
|
|
|
|
51
|
$file->[ $pos->[1] ] =~ s/}/$add}/; |
828
|
|
|
|
|
|
|
} |
829
|
|
|
|
|
|
|
} |
830
|
|
|
|
|
|
|
} |
831
|
|
|
|
|
|
|
|
832
|
|
|
|
|
|
|
# Build a config string |
833
|
6
|
100
|
|
|
|
24
|
my $s = $comment ? "$comment\n" : ""; |
834
|
6
|
|
|
|
|
15
|
foreach my $line ( @$file ) { |
835
|
2131
|
100
|
|
|
|
3877
|
next unless defined $line; |
836
|
2116
|
|
|
|
|
2831
|
$s .= $line; |
837
|
|
|
|
|
|
|
} |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
# Append new sections |
840
|
6
|
|
|
|
|
19
|
for my $c (@todo) { |
841
|
1
|
50
|
|
|
|
5
|
$s .= "\n" if $s =~ /}$/; |
842
|
1
|
50
|
|
|
|
7
|
$s .= $c->{_type} . ($c->{_name} ? (" " . $c->{_name}) : ''); |
843
|
1
|
|
|
|
|
59
|
my $data = dclone($c->{_data}); |
844
|
1
|
50
|
33
|
|
|
5
|
if ($c->{_inherit} && $self->{_bestow}) { |
845
|
0
|
|
|
|
|
0
|
$s .= " : " . $c->{_inherit}; |
846
|
|
|
|
|
|
|
# my $base = $self->get($c->{_type}, $c->{_inherit}); |
847
|
|
|
|
|
|
|
} |
848
|
1
|
|
|
|
|
2
|
my $section = " {\n"; |
849
|
1
|
|
|
|
|
6
|
for my $k (sort keys %$data) { |
850
|
2
|
50
|
33
|
|
|
11
|
next if $self->{_bestow} && $c->{_inherited}->{$k}; |
851
|
2
|
|
|
|
|
6
|
$section .= $self->_var_as_string( $k, $data->{$k} ); |
852
|
|
|
|
|
|
|
} |
853
|
1
|
|
|
|
|
28
|
$s .= $section . "}\n"; |
854
|
|
|
|
|
|
|
} |
855
|
|
|
|
|
|
|
|
856
|
6
|
|
|
|
|
700
|
return $s; |
857
|
|
|
|
|
|
|
} |
858
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
sub _var_as_string |
860
|
|
|
|
|
|
|
{ |
861
|
7
|
|
|
7
|
|
11
|
my( $self, $k, $value ) = @_; |
862
|
7
|
|
|
|
|
10
|
my $section = ''; |
863
|
7
|
50
|
|
|
|
17
|
if ( ref($value) eq 'ARRAY' ) { |
864
|
0
|
|
|
|
|
0
|
for my $v (@$value ) { |
865
|
0
|
|
|
|
|
0
|
$section .= $self->_var_as_string( $k, $v ); |
866
|
|
|
|
|
|
|
} |
867
|
|
|
|
|
|
|
} |
868
|
|
|
|
|
|
|
else { |
869
|
7
|
|
|
|
|
22
|
$section .= ' ' . $k . ' = ' . $value . "\n"; |
870
|
|
|
|
|
|
|
} |
871
|
7
|
|
|
|
|
16
|
return $section; |
872
|
|
|
|
|
|
|
} |
873
|
|
|
|
|
|
|
|
874
|
|
|
|
|
|
|
=head2 as_string_new |
875
|
|
|
|
|
|
|
|
876
|
|
|
|
|
|
|
$s = $c->as_string_new |
877
|
|
|
|
|
|
|
$s = $c->as_string_new($comment) |
878
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
Returns the configuration as a string, optionally with a comment prepended, |
880
|
|
|
|
|
|
|
without attempting to preserve formatting from the original file. |
881
|
|
|
|
|
|
|
|
882
|
|
|
|
|
|
|
The comment is inserted literally, so each line should begin with '#'. |
883
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
=cut |
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
sub as_string_new { |
887
|
0
|
|
|
0
|
1
|
|
my ($self, $comment) = @_; |
888
|
|
|
|
|
|
|
|
889
|
0
|
0
|
|
|
|
|
my $s = $comment ? "$comment\n" : ""; |
890
|
0
|
|
|
|
|
|
for my $c (@{$self->{_config}}) { |
|
0
|
|
|
|
|
|
|
891
|
0
|
0
|
|
|
|
|
$s .= $c->{_type} . ($c->{_name} ? (" " . $c->{_name}) : ''); |
892
|
0
|
|
|
|
|
|
my $data = dclone($c->{_data}); |
893
|
0
|
0
|
0
|
|
|
|
if ($c->{_inherit} && $self->{_bestow}) { |
894
|
0
|
|
|
|
|
|
$s .= " : " . $c->{_inherit}; |
895
|
0
|
|
|
|
|
|
my $base = $self->get($c->{_type}, $c->{_inherit}); |
896
|
|
|
|
|
|
|
} |
897
|
0
|
|
|
|
|
|
my $section = " {\n"; |
898
|
0
|
|
|
|
|
|
for my $k (sort keys %$data) { |
899
|
0
|
0
|
0
|
|
|
|
next if $self->{_bestow} && $c->{_inherited}->{$k}; |
900
|
0
|
0
|
|
|
|
|
if (ref($data->{$k}) eq 'ARRAY') { |
901
|
0
|
|
|
|
|
|
for my $v (@{$data->{$k}}) { |
|
0
|
|
|
|
|
|
|
902
|
0
|
|
|
|
|
|
$section .= ' ' . $k . ' = ' . $v . "\n"; |
903
|
|
|
|
|
|
|
} |
904
|
|
|
|
|
|
|
} |
905
|
|
|
|
|
|
|
else { |
906
|
0
|
|
|
|
|
|
$section .= ' ' . $k . ' = ' . $data->{$k} . "\n"; |
907
|
|
|
|
|
|
|
} |
908
|
|
|
|
|
|
|
} |
909
|
0
|
|
|
|
|
|
$s .= $section . "}\n"; |
910
|
|
|
|
|
|
|
} |
911
|
|
|
|
|
|
|
|
912
|
0
|
|
|
|
|
|
return $s; |
913
|
|
|
|
|
|
|
} |
914
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
=head1 SEE ALSO |
916
|
|
|
|
|
|
|
|
917
|
|
|
|
|
|
|
L |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
=head1 AUTHOR |
920
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
Jon Schutz, C<< >> |
922
|
|
|
|
|
|
|
|
923
|
|
|
|
|
|
|
=head1 BUGS |
924
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
Please report any bugs or feature requests to |
926
|
|
|
|
|
|
|
C, or through the web interface at |
927
|
|
|
|
|
|
|
L. |
928
|
|
|
|
|
|
|
I will be notified, and then you'll automatically be notified of progress on |
929
|
|
|
|
|
|
|
your bug as I make changes. |
930
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
=head1 SUPPORT |
932
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
934
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
perldoc Sphinx::Config |
936
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
You can also look for information at: |
938
|
|
|
|
|
|
|
|
939
|
|
|
|
|
|
|
=over 4 |
940
|
|
|
|
|
|
|
|
941
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
L |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
=item * CPAN Ratings |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
L |
948
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker |
950
|
|
|
|
|
|
|
|
951
|
|
|
|
|
|
|
L |
952
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
=item * Search CPAN |
954
|
|
|
|
|
|
|
|
955
|
|
|
|
|
|
|
L |
956
|
|
|
|
|
|
|
|
957
|
|
|
|
|
|
|
=back |
958
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
960
|
|
|
|
|
|
|
|
961
|
|
|
|
|
|
|
Philip Gwyn contributed the patch to preserve round-trip formatting, |
962
|
|
|
|
|
|
|
which was a significant chunk of work. |
963
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
965
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
Copyright 2007 Jon Schutz, all rights reserved. |
967
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
969
|
|
|
|
|
|
|
under the same terms as Perl itself. |
970
|
|
|
|
|
|
|
|
971
|
|
|
|
|
|
|
=cut |
972
|
|
|
|
|
|
|
|
973
|
|
|
|
|
|
|
1; # End of Sphinx::Config |