path: root/lib/Config/HAProxy.pm

package Config::HAProxy;
use strict;
use warnings;
use Text::Locus;
use Config::HAProxy::Node::Root;
use Config::HAProxy::Node::Section;
use Config::HAProxy::Node::Statement;
use Config::HAProxy::Node::Comment;
use Config::HAProxy::Node::Empty;
use Text::ParseWords;
use File::Basename;
use File::Temp qw(tempfile);
use File::stat;
use Carp;

my %sections = (
    global => 1,
    defaults => 1,
    frontend => 1,
    backend => 1,
);

sub new {
    my $class = shift;
    my $filename = shift // '/etc/haproxy/haproxy.cfg';
    my $self = bless { _filename => $filename }, $class;
    $self->reset();
    return $self;
}

sub filename { shift->{_filename} }

sub parse {
    my $self = shift;

    open(my $fh, '<', $self->filename)
	or croak "can't open ".$self->filename.": $!";
    my $line = 0;
    $self->reset();
    $self->push($self->tos);
    while (<$fh>) {
	my $locus = new Text::Locus($self->filename, ++$line);
	chomp;
	my $orig = $_;
	s/^\s+//;
	s/\s+$//;

	if ($_ eq "") {
	    $self->tos->append_node(
		new Config::HAProxy::Node::Empty(locus => $locus));
	    next;
	}
	    
	if (/^#.*/) {
	    $self->tos->append_node(
		new Config::HAProxy::Node::Comment(orig => $orig,
						   locus => $locus));
	    next;
	}
 
	my @words = parse_line('\s+', 1, $_);
	my $kw = shift @words;
	if ($sections{$kw}) {
	    my $section =
		new Config::HAProxy::Node::Section(kw => $kw,
						   argv => \@words,
						   orig => $orig,
						   locus => $locus);
	    $self->pop;
	    $self->tos->append_node($section);
	    $self->push($section);
	} else {
	    $self->tos->append_node(
		new Config::HAProxy::Node::Statement(kw => $kw,
						     argv => \@words,
						     orig => $orig,
						     locus => $locus));
	}
    }
    $self->pop;
    close $fh;
}

sub reset {
    my $self = shift;
    $self->{_stack} = [ new Config::HAProxy::Node::Root() ];
}

sub push {
    my $self = shift;
    push @{$self->{_stack}}, @_;
}

sub pop {
    my $self = shift;
    croak "can't pop the root tree" if @{$self->{_stack}} == 1;
    pop @{$self->{_stack}};
}

sub tos {
    my $self = shift;
    $self->{_stack}[-1];
}

sub tree {
    my $self = shift;
    $self->{_stack}[0];
}

sub select {
    my $self = shift;
    $self->tree->select(@_);
}

sub iterator {
    my $self = shift;
    $self->tree->iterator(@_);
}

sub write {
    my $self = shift;
    my $file = shift;
    my $fh;

    if (ref($file) eq 'GLOB') {
	$fh = $file;
    } else {
	open($fh, '>', $file) or croak "can't open $file: $!";
    }

    local %_ = @_;
    my $itr = $self->iterator(inorder => 1);
    
    while (defined(my $node = $itr->next)) {
	my $s = $node->as_string;
	if ($_{indent}) {
	    if ($node->is_comment) {
		if ($_{reindent_comments}) {
		    my $indent = ' ' x ($_{indent} * $node->depth);
		    $s =~ s/^\s+//;
		    $s = $indent . $s;
		}
	    } else {
		my $indent = ' ' x ($_{indent} * $node->depth);
		if ($_{tabstop}) {
		    $s = $indent . $node->kw;
		    for (my $i = 0; my $arg = $node->arg($i); $i++) {
			my $off = 1;
			if ($i < @{$_{tabstop}}) {
			    if (($off = $_{tabstop}[$i] - length($s)) <= 0) {
				$off = 1;
			    }
			}
			$s .= (' ' x $off) . $arg;
		    }
		} else {
		    $s =~ s/^\s+//;
		    $s = $indent . $s;
		}
	    }
	}
	print $fh $s,"\n";
    }

    close $fh unless ref($file) eq 'GLOB';
}

sub save {
    my $self = shift;

    return unless $self->tree;# FIXME
    return unless $self->tree->is_dirty;
    my ($fh, $tempfile) = tempfile('haproxy.XXXXXX',
				   DIR => dirname($self->filename));
    $self->write($fh, @_);
    close($fh);
    
    my $sb = stat($self->filename);
    $self->backup;
    rename($tempfile, $self->filename)
	or croak "can't rename $tempfile to ".$self->tempfile.": $!";
    # This will fail unless we are root, let it be so.
    chown $sb->uid, $sb->gid, $self->filename;
    # This will succeed: we've created the file, so we're owning it.
    chmod $sb->mode & 0777, $self->filename;
    
    $self->tree->clear_dirty
}

sub backup_name {
    my $self = shift;
    $self->filename . '~'
}

sub backup {
    my $self = shift;
    my $backup = $self->backup_name;
    if (-f $backup) {
	unlink $backup
	    or croak "can't unlink $backup: $!"
    }
    rename $self->filename, $self->backup_name
	or croak "can't rename :"
	         . $self->filename
		 . " to "
		 . $self->backup_name
		 . ": $!";
}

1;	
__END__

=head1 NAME

Config::HAProxy - HAProxy configuration file

=head1 SYNOPSIS

use Config::HAProxy;
$cfg = new Config::HAProxy($filename);
$cfg->parse;

$name = $cfg->filename;

@frontends = $cfg->select(name => 'frontend');

$itr = $cfg->iterator(inorder => 1);
while (defined($node = $itr->next)) {
    # do something with $node
}

$cfg->save;

$cfg->write($file_or_handle);

$cfg->backup;
$name = $self->backup_name;

$cfg->reset;
$cfg->push($node);
$node = $cfg->pop;
$node = $cfg->tos;
$node = $cfg->tree;

=head1 DESCRIPTION

FIXME
    
=head1 CONSTRUCTOR

    $cfg = new Config::HAProxy($filename);

Creates and returns a new object for manipulating the HAProxy configuration.
Optional B<$filename> specifies the name of the file to read configuration
from. It defaults to F</etc/haproxy/haproxy.cfg>.

=head1 THE PARSE TREE

=head2 parse

    $cfg->parse;

Reads and parses the configuration file. Croaks if the file does not exist.


=head2 reset

    $cfg->reset;

Clears the parse tree.

=head2 push

    $cfg->push($node);

Appends the B<$node> (the B<Config::HAProxy::Node> object), to the
end of the parse tree.

=head2 pop

    $node = $cfg->pop;

Removes the tail node from the tree and returns it.

=head1 INSPECTING THE TREE    

=head2 tree

    $node = $cfg->tree;

Returns the top of the tree.

=head2 tos

    $node = $cfg->tos;

Returns the last node in the tree.
    
=head1 SAVING

=head2 save

    $cfg->save;

Saves the configuration file.

=head2 write

    $cfg->write($file, %hash);

Writes configuration to the named file or file handle. If B<$file> is the
only argument, the original indentation is preserved. Otherwise, if
B<%hash> controls the indentation of the output. It must contain at least
the B<indent> key, which specifies the amount of indentation per nesting
level. If B<tabstop> key is also present, its value must be a reference to
the list of tabstop columns. For each statement with arguments, this array
is consulted to determine the column number for each subsequent argument.
Arguments are zero-indexed. Starting column where the argument should be
placed is determined as B<$tabstop[$i]>, where B<$i> is the argument index.
Arguments with B<$i> greater than or equal to B<@tabstop> are appended to
the resulting output, preserving their original offsets.    

Normally, comments retain their original indentation. However, if the
key B<reintent_comments> is present, and its value is evaluated as true,
then comments are reindented following the rules described above.