package Config::HAProxy::Node::Section; use strict; use warnings; use parent 'Config::HAProxy::Node'; use Carp; sub new { my $class = shift; my $self = $class->SUPER::new(@_); $self->{_tree} = []; return $self; } sub is_section { 1 } sub append_node { my $self = shift; my $n = @{$self->{_tree}}; push @{$self->{_tree}}, map { $_->parent($self); $_->index($n++); $_ } @_; } sub append_node_nonempty { my $self = shift; my $n = $#{$self->{_tree}}; while ($n >= 0 && $self->{_tree}[$n]->is_empty) { $n--; } $self->insert_node($n+1, @_); } sub insert_node { my $self = shift; my $n = shift; my $i = $n; splice @{$self->{_tree}}, $n, 0, map { $_->parent($self); $_->index($i++); $_ } @_; for (; $i < @{$self->{_tree}}; $i++) { $self->{_tree}[$i]->index($i); } } sub delete_node { my ($self, $n) = @_; splice @{$self->{_tree}}, $n, 1; for (; $n < @{$self->{_tree}}; $n++) { $self->{_tree}[$n]->index($n); } $self->root->mark_dirty; } sub tree { my ($self, $n) = @_; if ($n) { return undef if $n >= @{$self->{_tree}}; return $self->{_tree}[$n]; } return @{shift->{_tree}} }; sub ends_in_empty { my $self = shift; while ($self->is_section) { $self = $self->tree(-1); } return $self->is_empty; } my %match = ( name => { wantarg => 1, matcher => sub { my ($node, $value) = @_; return $node->kw && $node->kw eq $value; } }, arg => { wantarg => 1, matcher => sub { my ($node, $value) = @_; my $arg = $node->arg($value->{n}); return $arg && $arg eq $value->{v}; } }, section => { matcher => sub { my $node = shift; return $node->is_section; } }, statement => { matcher => sub { my $node = shift; return $node->is_statement; } }, comment => { matcher => sub { my $node = shift; return $node->is_comment; } } ); sub select { my $self = shift; my @prog; while (my $p = shift) { my $arg = shift or croak "missing argument"; my $m = $match{$p} or croak "unknown matcher: $p"; if ($m->{wantarg}) { push @prog, [ $m->{matcher}, $arg ]; } elsif ($arg) { push @prog, $m->{matcher}; } } grep { _test_node($_, @prog) } $self->tree; } sub _test_node { my $node = shift; foreach my $f (@_) { if (ref($f) eq 'ARRAY') { return 0 unless &{$f->[0]}($node, $f->[1]); } else { return 0 unless &{$f}($node); } } return 1; } 1;