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