Autobot/lib/Parser/Config.pm

# lib/Parser/Config.pm - Configuration parser.
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
# This program is free software; rights to this code are stated in doc/LICENSE.
package Parser::Config;
use strict;
use warnings;

# Create a new instance.
sub new 
{
    my $class = shift;
    my ($file) = @_;
    my $self = bless {}, $class;

	# Check to see if the configuration file exists.
	if (!-e "$Auto::Bin/../etc/$file") {
		return 0;
	}
	
	# Open, read and close the config.
	open(my $FCONF, q{<}, "$Auto::Bin/../etc/$file") or return 0;
	my @cosfl = <$FCONF> or return 0;
	close $FCONF or return 0;
	
	# Save it to self variable.
	$self->{'config'}->{'path'} = "$Auto::Bin/../etc/$file";

    return $self;
}

# Parse the configuration file.
sub parse 
{
	# Get the path to the file.
	my $self = shift;
	my $file = $self->{'config'}->{'path'};
	my $blk = 0;
	my (%rs);
	
	# Open, read and close it.
	open(my $FCONF, q{<}, "$file") or return 0;
	my @fbuf = <$FCONF> or return 0;
	close $FCONF or return 0;
	
	# Iterate the file.
	foreach my $buff (@fbuf) {
		# Main newline buffer.
		if (defined $buff) {
			# If the line begins with a #, it's a comment so ignore it.
			if (substr($buff, 0, 1) eq '#') {
				next;
			}
			
			if ($buff =~ m/;/) {
				# Semicolon buffer.
				my @asbuf = split(';', $buff);
				foreach my $asbuff (@asbuf) {
					if (defined $asbuff) {
						
						# Space buffer.
						my @ebuf = split(' ', $asbuff);
						if (!defined $ebuf[0] or !defined $ebuf[1]) {
							# Garbage. Ignoring.
							next;
						}
						my $param = $ebuf[1];
						
						if (substr($param, 0, 1) eq '"' and substr($param, length($param) - 1, 1) ne '"') {
							# Multi-word string.
							$param = substr($param, 1);
							
							for (my $i = 2; $i < scalar(@ebuf); $i++) {
								if (substr($ebuf[$i], length($ebuf[$i]) - 1, 1) eq '"') {
									$param .= " ".substr($ebuf[$i], 0, length($ebuf[$i]) - 1);
									last;
								}
								else {
									$param .= " ".$ebuf[$i];
								}
							}
						}
						elsif (substr($param, 0, 1) eq '"' and substr($param, length($param) - 1, 1) eq '"') {
							# Single-word string.
							$param = substr($param, 1, length($ebuf[1]) - 2);
						}
						elsif ($param =~ m/[0-9]/) {
							# Numeric.
							$param =~ s/[^0-9.]//g;
						}
						else {
							# Garbage.
							next;
						}
						
						my @param = ($param);
								
						unless (!$blk) {
							# We're inside a block.
							if ($blk =~ m/@@@/) {
								# We're inside a block with a parameter.
								my @sblk = split('@@@', $blk);
								
								# Check to see if this config option already exists.
								if (defined $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]}) {
									# It does, so merely push this second one to the existing array.
									push(@{ $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]} }, $param);
								}
								else {
									# It doesn't, create it as an array.
									@{ $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]} } = @param;
								}
							}
							else {
								# We're inside a block with no parameter.
								
								# Check to see if this config option already exists.
								if (defined $rs{$blk}{$ebuf[0]}) {
									# It does, so merely push this second one to the existing array.
                                    push(@{ $rs{$blk}{$ebuf[0]} }, $param);
								}
								else {
									# It doesn't, create it as an array.
									@{ $rs{$blk}{$ebuf[0]} } = @param;
								}
							}
						}
						else {
							# We're not inside a block.
							
							# Check to see if this config option already exists.
							if (defined $rs{$ebuf[0]}) {
								# It does, so merely push this second one to the existing array.
								push(@{ $rs{$ebuf[0]} }, $param);
							}
							else {
								# It doesn't, create it as an array.
								@{ $rs{$ebuf[0]} } = @param;
							}
						}	
					}
				}
			}
			else {
				# No semicolon space buffer.
				my @ebuf = split(' ', $buff);
				
				if (!defined $ebuf[0]) {
					# Garbage. Ignoring.
					next;
				}
				
				if (defined $ebuf[1]) {
					if ($ebuf[1] eq '{') {
						# This is the beginning of a block with no parameter.
                        $blk = $ebuf[0];
					}
					elsif (defined $ebuf[2]) {
						if ($ebuf[2] eq '{') {
							# This is the beginning of a block with a parameter.
							my $param = $ebuf[1];
							$param =~ s/"//g;
							$blk = $ebuf[0].'@@@'.$param;
						}
					}
				}
				if ($ebuf[0] eq '}') {
					# This is the end of a block.
					$blk = 0;
				}
			}
		}
	}	
	
	# Return the configuration data.
	return %rs;				
}


1;
# vim: set ai sw=4 ts=4: