File Coverage

blib/lib/Test/Collectd/Config.pm

Criterion	Covered	Total	%
statement	40	46	86.9
branch	7	10	70.0
condition	2	5	40.0
subroutine	11	13	84.6
pod	1	1	100.0
total	61	75	81.3

package Test::Collectd::Config;

use Test::Collectd::Config::Parse;
use Parse::Lex;
use IO::File;
use strict;
use warnings;

=head1 NAME

Test::Collectd::Config - Reimplementation of L in perl.

=head1 VERSION

Version 0.1001

=head1 SYNOPSOS

	use Test::Collectd::Config;

	my $config = parse ( "/etc/collectd.conf" );

This module reimplements the config parser of collectd in perl. It's being used by L. The only exported function is L.

=cut

require Exporter;
use vars qw($VERSION @ISA @EXPORT_OK @EXPORT $BFALSE $IGNORE_mlWHITE_SPACE $CLOSEBRAC $IGNORE_COL $NUMBER $EOL $IGNORE_CONT_QUOTED_STRING $SLASH $ERROR $IGNORE_WHITE_SPACE $OPENBRAC $BTRUE $IGNORE_COMMENT $IGNORE_START_QUOTED_STRING $QUOTED_STRING $DUPE_0_QUOTED_STRING $DUPE_0_UNQUOTED_STRING $UNQUOTED_STRING);
push @ISA, qw(Exporter);
@EXPORT_OK = qw(
	parse
);
@EXPORT = qw(
	parse
);

$VERSION = "0.1001";

my $EOL = '\r?\n';
my $IP_BYTE = '(2(5[0-5]|[0-4][0-9])|1[0-9][0-9]|[1-9]?[0-9])';
my $PORT = '(6(5(5(3[0-5]|[0-2][0-9])|[0-4][0-9][0-9])|[0-4][0-9][0-9][0-9])|[1-5][0-9][0-9][0-9][0-9]|[1-9][0-9]?[0-9]?[0-9]?)';
my $IPV4_ADDR = "$IP_BYTE\\.$IP_BYTE\\.$IP_BYTE\\.$IP_BYTE(:$PORT)?";
my $HEX_NUMBER = '0[xX][0-9a-fA-F]+';
my $OCT_NUMBER = '0[0-7]+';
my $DEC_NUMBER = '[\+\-]?[0-9]+';
my $FLOAT_NUMBER = '[\+\-]?[0-9]*\.[0-9]+([eE][\+\-][0-9]+)?';
my $NUMBER = "($FLOAT_NUMBER|$HEX_NUMBER|$OCT_NUMBER|$DEC_NUMBER)";
my $QUOTED_STRING = '([^\\"]+|\\.)*';
#$QUOTED_STRING = '((?
my $UNQUOTED_STRING = '[0-9A-Za-z_]+';
my $WHITE_SPACE = '[\ \t\b]';
my $NON_WHITE_SPACE = '[^\ \t\b]';

my $ml_buffer;

my @lex = (
	qw(IGNORE_WHITE_SPACE), $WHITE_SPACE,
	qw(IGNORE_COMMENT), '#.*',
	qw(IGNORE_COL), "\\$EOL",
	qw(EOL), $EOL,
	qw(SLASH /),
	qw(OPENBRAC <),
	qw(CLOSEBRAC >),
	qw(BTRUE), '(true|yes|on)$', sub { 1 },
	qw(BFALSE), '(false|no|off)$', sub { 0 },
	qw(UNQUOTED_STRING), ${IPV4_ADDR},
	qw(NUMBER), $NUMBER,
	qw(QUOTED_STRING), "\"$QUOTED_STRING\"",
	qw(DUPE_0_UNQUOTED_STRING), ${UNQUOTED_STRING},
	qw(IGNORE_START_QUOTED_STRING), "\"$QUOTED_STRING\\$EOL", \&_start_string,
	qw(ML:IGNORE_mlWHITE_SPACE), "^${WHITE_SPACE}+",
	qw(ML:IGNORE_CONT_QUOTED_STRING), "${NON_WHITE_SPACE}${QUOTED_STRING}\\${EOL}", \&_cont_string,
	qw(ML:DUPE_0_QUOTED_STRING), "${NON_WHITE_SPACE}${QUOTED_STRING}\"", \&_end_string,
	qw(ERROR .*), \&_error,
);

sub _error {
	die qq!can\'t analyze: "$_[1]"!;
}
sub _start_string {
	$ml_buffer = "";
	($ml_buffer.= $_[1]) =~ s/\\\r?\n$//;
	$_[0] -> lexer -> start ("ML");
}
sub _cont_string {
	($ml_buffer.= $_[1]) =~ s/\\$//;
	return @_;
}
sub _end_string {
	_cont_string (@_);
	$_[0] -> lexer -> start ("INITIAL");
	return $ml_buffer;
}

Parse::Lex->exclusive('ML');
my $lexer = Parse::Lex->new(@lex);
#$lexer -> trace;
$lexer -> skip('');

sub _lex {
	while (my $token = $lexer -> next) {
		return ('', undef) if $lexer->eoi;
		next if $token -> name =~ /^IGNORE_/;
		(my $name = $token->name) =~ s/^DUPE_[^_]+_//;
		return ($name, $token->text);
	}
}

sub _parse_error {die "parser failed ", join ", ", map { "$_: ".${$_[0] -> {$_}}} qw(TOKEN VALUE)}

=head2 parse ( $config_in )

Parses $config_in and returns the compiled configuration in the form of a nested structure identical to the one returned to the plugin's config callback. The

=cut

sub parse {
	my $in = shift || die "usage: __PACKAGE__->parse(\$config_in)";
	my $config;
	if (ref $in && $in->isa("GLOB")) {
		$config = $in;
	} elsif (!ref $in) {
		my $fh = IO::File -> new ( $in, 'r' ) or die $!;
		local $/;
		$config = $fh;
	} else {
		die 'parse($config_in) must be either a string (filename) or a GLOB (handle).';
	}
	$lexer->from($config);
	my $parser = Test::Collectd::Config::Parse -> new;
	my $value = $parser -> YYParse(yylex => \&_lex, yyerror => \&_parse_error, yydebug => 0x00);
}

1;