Initial commit

Spawned from the proxyctl project.

5 files changed, 192 insertions, 0 deletions

diff --git a/lib/Config/HAProxy/Node/Comment.pm b/lib/Config/HAProxy/Node/Comment.pm
new file mode 100644
index 0000000..5d7ef88
--- /dev/null
+++ b/lib/Config/HAProxy/Node/Comment.pm
@@ -0,0 +1,6 @@
+package Config::HAProxy::Node::Comment;
+use parent 'Config::HAProxy::Node';
+
+sub is_comment { 1 }
+
+1;
diff --git a/lib/Config/HAProxy/Node/Empty.pm b/lib/Config/HAProxy/Node/Empty.pm
new file mode 100644
index 0000000..bee0f2e
--- /dev/null
+++ b/lib/Config/HAProxy/Node/Empty.pm
@@ -0,0 +1,6 @@
+package Config::HAProxy::Node::Empty;
+use parent 'Config::HAProxy::Node';
+
+sub is_empty { 1 }
+
+1;
diff --git a/lib/Config/HAProxy/Node/Root.pm b/lib/Config/HAProxy/Node/Root.pm
new file mode 100644
index 0000000..656bb9f
--- /dev/null
+++ b/lib/Config/HAProxy/Node/Root.pm
@@ -0,0 +1,31 @@
+package Config::HAProxy::Node::Root;
+use strict;
+use warnings;
+use parent 'Config::HAProxy::Node::Section';
+use Carp;
+
+sub new {
+    my $class = shift;
+    my $self = $class->SUPER::new(@_);
+    $self->{dirty} = 0;
+    return $self;
+}
+
+sub is_dirty {
+    my $self = shift;
+    return $self->{dirty}
+}
+
+sub mark_dirty {
+    my $self = shift;
+    $self->{dirty} = 1;
+}
+
+sub clear_dirty {
+    my $self = shift;
+    $self->{dirty} = 0;
+}
+    
+1;
+
+    
diff --git a/lib/Config/HAProxy/Node/Section.pm b/lib/Config/HAProxy/Node/Section.pm
new file mode 100644
index 0000000..c332155
--- /dev/null
+++ b/lib/Config/HAProxy/Node/Section.pm
@@ -0,0 +1,143 @@
+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;
+
+
diff --git a/lib/Config/HAProxy/Node/Statement.pm b/lib/Config/HAProxy/Node/Statement.pm
new file mode 100644
index 0000000..abf0e50
--- /dev/null
+++ b/lib/Config/HAProxy/Node/Statement.pm
@@ -0,0 +1,6 @@
+package Config::HAProxy::Node::Statement;
+use parent 'Config::HAProxy::Node';
+
+sub is_statement { 1 }
+
+1;