Router::LG - Looking Glass

	- Multiple router vendor support
	- Multiple parameter support
	- Custom command definition

#!/usr/local/bin/perl

# LG (Looking Glass)
# by Chris Josephes
#
# A framework for accessing information on routers
# remotely

#
# Package Definition
#

package Router::LG;

#
# Includes
#

#
# Global Variables
#

# Software version
$VERSION=0.98;

# Table of Submodules of LG
%Loaded=();

# Default TTL for cached data
$DefaultTTL=600;

#
# Constructor Method
#

#
# new
# Construct a new LG object
sub new
{
my ($object)={};
bless ($object);
return($object);
}

#
# version
# Return version data of the LG class
sub version
{
return($VERSION);
}

#
# Data Methods
#

#
# router
# Set/Get the router stucture that we will be accessing
sub router
{
my ($self,$router)=@_;
if ($router)
{
	$self->{"router"}=$router;
	$self->_loadDriver($router->{"-class"});
	unless ($self->{"router"}->{"-driver"})
	{
		return(undef);
	}
}
return($self->{"router"});
}

#
# parameters
# Set/Get the parameters to be parsed into the command string
# passing "-remove" clears the array
sub parameters
{
my ($self,@list)=@_;
#print("Params Called\n");
if (@list)
{
	if ($list[0] eq "-clear")
	{
		$self->{"parameters"}=[];
	} else {
		while (@list)
		{
			push(@{$self->{"parameters"}},shift(@list));
		}
	}
}
return(@{$self->{"parameters"}});
}

#
# cache
# Sets/Gets caching setup
# arguements: -directory (cache directory) -ttl (time to live in secs)
sub cache
{
my ($self,%args)=@_;
if (%args)
{
        if ($args{"-directory"})
        {
                # determine if directory is safe
                if (-d $args{"-directory"})
                {
                        $self->{"cache"}->{"-directory"}=$args{"-directory"};
                } else {
                        $self->error("Cache directory does not exist.");
                }
        }
        $self->{"cache"}->{"-ttl"}=$args{"-ttl"} || $DefaultTTL;
}
return(%{$self->{"cache"}});
}

#
# commands
# Returns a list of commands the router driver understands
sub commands
{
my ($self)=@_;
my ($driver);
$driver=$self->_driver();
if ($driver)
{
	return($driver->commands());
} else {
	$self->error("Driver class not yet defined");
	return(undef);
}
}

sub command
{
my ($self,$command,@rest)=@_;
my ($driver);
$driver=$self->_driver();
if ($driver)
{
	if (@rest)
	{
		$driver->command($command,@rest);
	} 
	return($driver->command($command));
} else {
	$self->error("Driver class not yet defined");
	return(undef);
}
}

sub cmdlabels
{
my ($self)=@_;
my ($cmd,@list,%lhash,%th);
(@list)=$self->commands();
print("LIST: ",@list,"\n");
while (@list)
{
	$cmd=pop(@list);
	(%th)=$self->command($cmd);
	$lhash{$cmd}=$th{"-label"};
}
return(%lhash);
}

#
# Cache Control Methods
#

#
# _cacheOK
# Determine if cached data from a command is valid by checking the following:
# - If parameters were passed with the command
# - If the command can be cached
# - If the previously cached data is still valid
sub _cacheOK
{
my ($self,$command)=@_;
my ($file,$update,$age);
return (undef) if ($self->parameters());
$file=$self->_cacheFile($command);
if (-e $file)
{
	(undef,undef,undef,undef,undef,undef,undef,undef,undef,$update)=
		stat($file);
	$age=time()-$update;
	return($age < $self->{"cache"}->{"-ttl"} ? 1 : 0);
} else {
	return(undef);
}
}

#
# _readCache
# Read cached output from an earlier execution
sub _readCache
{
my ($self,$command)=@_;
my ($file,$x);
$file=$self->_cacheFile($command);
open (F, $file) || return(undef);
while ($x=<F>)
{
	push(@output,$x);
}
close(F);
return(@output);
}

#
# _writeCache
# Copy data from a router to a cachefile
sub _writeCache
{
my ($self,$command,@output)=@_;
my ($file);
$file=$self->_cacheFile($command);
open (F, ">$file") || return(undef);
print F (@output);
close(F);
}

#
# Execution Methods
#

#
# parse
# Return the command string the driver would send to the router
sub parse
{
my ($self,$command)=@_;
my ($driver,$string);
$driver=$self->_driver();
$string=$driver->parse($command);
return($string);
}

#
# execute
# Have the driver send the command and parameters to the router
sub execute
{
my ($self,$command)=@_;
my ($driver,$cs,@output);
$driver=$self->_driver();
#print("REF2:",ref($driver),"\n");
#print("Determining cache\n");
if ($driver->cachable($command))
{
	if ($self->_cacheOK($command))
	{
		#print("Cached data\n");
		(@output)=$self->_readCache($command);
		$cs=1;
	} else {
		#print("Active data\n");
		# (@output)=&{$class."::exec"}($self,$command);
		(@output)=$driver->exec($command);
		$cs=0;
		# Now send this data to the cache!
		$self->_writeCache($command,@output);
	}
} else {
	#print("Active data\n");
	#(@output)=&{$class."::exec"}($self,$command);
	(@output)=$driver->exec($command);
	$cs=0;
}
return($cs,@output);
}

#
# error
# Set or return an error message
sub error
{
my ($self,@msgs)=@_;
if (@msgs)
{
	if ($msgs[0] eq "-clear")
	{
		$self->{ec}=[];
	} else {
		while (@msgs)
		{
			my ($err,$pkg);
			$err=shift(@msgs);
			$pkg=caller();
			$err="$pkg => $err\n";
			# print("E: $err");
			push(@{$self->{ec}},$err);
		}
	}
} 
if ($self->{ec})
{
	return(@{$self->{ec}})
} else {
	return("LG => No Errors\n");
}
}
#
# Hidden Methods
#

#
# _loadDriver
# Load a LG::* class to access a specific router
sub _loadDriver
{
my ($self,$driver)=@_;
my ($class);
$driver=lc($driver);
$driver=ucfirst($driver);
$class="Router::LG::".$driver;
#print("Attempting to load $class\n");
unless ($Loaded{$driver})
{
	if (eval "require ($class)")
	{
		$Loaded{$driver}=1;
	} else {
		$self->error("Loading of ($class) failed");
		return(undef);
	}
}
$self->{"router"}->{"-driver"}=&{$class."::new"}($self);
return($self->{"router"}->{"-driver"});
}

#
# _driver
# Return the driver object
sub _driver
{
my ($self)=@_;
return($self->{"router"}->{"-driver"});
}

#
# _cacheFile
# Return a generated cache filename
sub _cacheFile
{
my ($self,$command)=@_;
my ($file);
$file=$self->{"cache"}->{"-directory"}."/".$command."--".
	$self->{"router"}->{"-hostname"};
return($file);
}

#
# Exit Block
#

1;

__END__

#
# POD Block
#