summaryrefslogtreecommitdiff
path: root/lib/Config/Tree/Node/Section.pm
blob: 25b1bd5605916ee079d4c9d1d2bb72ade4c741a9 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
package Config::Tree::Node::Section;
use parent 'Config::Tree::Node';
use strict;
use warnings;
use Carp;
use Config::Tree::Node::Null;

sub new {
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    $self->{_subtree} = {};
    return $self;
}

sub subtree {
    my $self = shift;
    if (my $key = shift) {
	if (my $val = shift) {
	    $self->{_subtree}{$key} = $val;
	}
	return $self->{_subtree}{$key};
    }
    return $self->{_subtree};
}

sub keys {
    my $self = shift;
    return keys %{$self->{_subtree}};
}

sub has_key {
    my ($self, $key) = @_;
    return $self->subtree($key);
}

sub delete {
    my ($self, $key) = @_;
    delete $self->{_subtree}{$key};
}

sub merge {
    my ($self, $other) = @_;
    while (my ($k, $v) = each %{$other->subtree}) {
	if (my $old = $self->subtree($k)) {
	    if ($old->is_section) {
		$old->merge($v);
	    } elsif (ref($old->value) eq 'ARRAY') {
		push @{$old->value}, $v->value;
		$old->locus->add_locus($v->locus);
	    } else {
		$old->value($v->value);
	    }
	} else {
	    $self->subtree($k => $old->clone);
	}
	$self->locus->add_locus($v->locus);
    }
}

=head2 $h = $cfg->as_hash

=head2 $h = $cfg->as_hash($map)    

Returns parse tree converted to a hash reference. If B<$map> is supplied,
it must be a reference to a function. For each I<$key>/I<$value>
pair, this function will be called as:

    ($newkey, $newvalue) = &{$map}($what, $key, $value)

where B<$what> is C<section> or C<value>, depending on the type of the
hash entry being processed. Upon successful return, B<$newvalue> will be
inserted in the hash slot for the key B<$newkey>.

If B<$what> is C<section>, B<$value> is always a reference to an empty
hash (since the parse tree is traversed in pre-order fashion). In that
case, the B<$map> function is supposed to do whatever initialization that
is necessary for the new subtree and return as B<$newvalue> either B<$value>
itself, or a reference to a hash available inside the B<$value>. For
example:

    sub map {
        my ($what, $name, $val) = @_;
        if ($name eq 'section') {
            $val->{section} = {};
            $val = $val->{section};
        }
        ($name, $val);
    }
    
=cut

sub as_hash {
    my $self = shift;
    my $map = shift // sub { shift; @_ };
    my $hroot = {};
    my @ar;
    
    push @ar, [ '', $self, $hroot ];
    while (my $elt = shift @ar) {
	if ($elt->[1]->is_section) {
	    my $hr0 = {};
	    my ($name, $hr) = &{$map}('section', $elt->[0], $hr0);
	    $elt->[2]{$name} = $hr0;
	    while (my ($kw, $val) = each %{$elt->[1]->subtree}) {
		push @ar, [ $kw, $val, $hr ];
	    }
	} else {
	    my ($name, $value) = &{$map}('value', $elt->[0], $elt->[1]->value);
	    $elt->[2]{$name} = $value;
	}
    }
    return $hroot->{''};
}

sub as_string { '(section)' }

our $AUTOLOAD;

sub AUTOLOAD {
    my $self = shift;
    my $key = $AUTOLOAD;
    $key =~ s/.*:://;
    if ($key =~ s/^([A-Z])(.*)/\l$1$2/) {
	$key =~ s/__/-/g;
	return $self->subtree($self->{_ci} ? lc($key) : $key)
	       // new Config::Tree::Node::Null;
    }
    confess "Can't locate method $AUTOLOAD";
}

1;

Return to:

Send suggestions and report system problems to the System administrator.