File Coverage

blib/lib/Config/Objective.pm

Criterion	Covered	Total	%
statement	80	107	74.7
branch	11	20	55.0
condition			n/a
subroutine	12	17	70.5
pod	4	5	80.0
total	107	149	71.8

###
###  Copyright 2002-2003 University of Illinois Board of Trustees
###  Copyright 2002-2003 Mark D. Roth
###  All rights reserved.
###
###  Config::Objective - Perl module for parsing object-oriented config files
###
###  Mark D. Roth
###  Campus Information Technologies and Educational Services
###  University of Illinois at Urbana-Champaign
###


package Config::Objective;

use 5.006;
use strict;
use warnings;
#use overload;

use Parse::Lex;

use Config::Objective::DataType;
use Config::Objective::Parser;


our $VERSION = '0.9.1';
our $AUTOLOAD;


###############################################################################
###  internal functions for use by parser
###############################################################################

sub _lexer
{
	my ($parser) = @_;
	my ($token, $lexer);

	$lexer = $parser->YYData->{'lexer'};
#	print "lexer = $lexer\n";

	while (1)
	{
		$token = $lexer->next;

		if ($lexer->eoi)
		{
#			print "lexer returning EOI\n";
			return ('', undef);
		}

		next
			if ($token->name eq 'COMMENT');

#		print "lexer returning (" . $token->name . ", \"" . $token->text . "\")\n";
		return ($token->name, $token->text);
	}
}


sub _error
{
	my ($parser) = @_;
	my ($config, $lexer, $file, $line);

	$config = $parser->YYData->{'config'};
	$file = $config->{'file_stack'}->[-1];

	$lexer = $parser->YYData->{'lexer'};
	$line = $lexer->line;

	die("$file:$line: parse error\n");
}


sub _call_obj_method
{
	my ($self, $obj, $method, @args) = @_;
	my ($retval, $line, $msg);

#	print "==> _call_obj_method('$obj', '$method'";
#	map { print ", '$_'"; } @args
#		if (@args > 1 || defined($args[0]));
#	print ")\n";

	die "$obj: unknown config object"
		if (!exists($self->{'objs'}->{$obj}));

	$method = 'default'
		if (!defined($method));

	$retval = eval { $self->{'objs'}->{$obj}->$method(@args); };
	if ($@)
	{
		if (@{$self->{'lexer_stack'}})
		{
			$line = $self->{'lexer_stack'}->[-1]->line;
			$msg = "$self->{'file_stack'}->[-1]:$line: ";
		}
		$msg .= "$obj";
		die "$msg: $@";
	}

#	print "<== _call_obj_method(): returning '"
#		. (defined($retval) ? $retval : 'undef') . "'\n";
	return $retval;
}


###############################################################################
###  constructor
###############################################################################

sub new
{
	my ($class, $file, $objs, %opts) = @_;
	my ($self);

	$self = \%opts;
	bless($self, $class);

	$self->{'objs'} = $objs;
	$self->{'objs'} = {}
		if (!defined($self->{'objs'}));

	$self->{'include_dir'} = '.'
		if (!defined($self->{'include_dir'}));

	$self->{'file_stack'} = [];
	$self->{'cond_stack'} = [];
	$self->{'list_stack'} = [];
	$self->{'hash_stack'} = [];

	$self->{'in_expr'} = 0;

	$self->parse($file);

	return $self;
}


###############################################################################
###  config parser
###############################################################################

sub parse
{
	my ($self, $file) = @_;
	my ($fh, $lexer, $parser);

#	print "==> parse('$file')\n";

	open($fh, $file)
		|| die "open($file): $!\n";
	push(@{$self->{'file_stack'}}, $file);

	$lexer = Parse::Lex->new(
		'AND',		'&&',
		'COMMA',	',',
		'COMMENT',	'(?
		'ELIF',		'^\%[ \t]*elif',
		'ELSE',		'^\%[ \t]*else',
		'ENDIF',	'^\%[ \t]*endif',
		'EOS',		';',
		'PAREN_START',	'\(',
		'PAREN_END',	'\)',
		'HASH_ARROW',	'=>',
		'HASH_START',	'{',
		'HASH_END',	'}',
		'IF',		'^\%[ \t]*if',
		'INCLUDE',	'^\%[ \t]*include',
		'LIST_START',	'\[',
		'LIST_END',	'\]',
		'METHOD_ARROW',	'->',
		'NOT',		'!',
		'OR',		'\|\|',
		'WORD',		'\w+',
		'QSTRING',	[
				  '(?
				  '([^"]|(?<=\\\\)")*',
				  '(?
				],
				sub {
					my ($token, $string) = @_;

					$string =~ s/^"//;
					$string =~ s/"$//;

					$string =~ s/\\"/"/g;

					return $string;
				},
		'ERROR',	'(?s:.*)',
				sub {
					my $line = $_[0]->lexer->line;
					my $file = $self->{'file_stack'}->[-1];

					die "$file:$line: syntax error: \"$_[1]\"\n";
				}
	);
	$lexer->from(\*$fh);
	$lexer->configure('Skip' => '\s+');
	push(@{$self->{'lexer_stack'}}, $lexer);

	$parser = Config::Objective::Parser->new();
	$parser->YYData->{'lexer'} = $lexer;
	$parser->YYData->{'config'} = $self;

	$parser->YYParse(yylex => \&_lexer,
#			 yydebug => 0x1F,
			 yyerror => \&_error);

	pop(@{$self->{'file_stack'}});
	pop(@{$self->{'lexer_stack'}});
	close($fh);

#	print "<== parse('$file')\n";

	return 1;
}


###############################################################################
###  allow direct access to object values
###############################################################################

sub AUTOLOAD
{
	my ($self) = @_;
	my ($method);

	$method = $AUTOLOAD;
	$method =~ s/.*:://;

	return
		if ($method eq 'DESTROY');

#	return (overload::Overloaded($self->{'objs'}->{$method})
#		? $self->{'objs'}->{$method}
#		: $self->{'objs'}->{$method}->get());

	return $self->{'objs'}->{$method}->get();
}


###############################################################################
###  return a config object
###############################################################################

sub get_obj
{
	my ($self, $obj) = @_;

	return $self->{'objs'}->{$obj};
}


###############################################################################
###  get a list of config object names
###############################################################################

sub obj_names
{
	my ($self) = @_;

	return keys %{$self->{'objs'}};
}


###############################################################################
###  get a hash of object names and values
###############################################################################

sub get_hash
{
	my ($self) = @_;
	my ($href);

	$href = {};
	map { $href->{$_} = $self->$_; } $self->obj_names();

	return $href;
}


###############################################################################
###  cleanup and documentation
###############################################################################

1;

__END__