package Yaa::LookupMap;


use strict;
use Yaa::LookupMap::Result;
use vars qw ($VERSION $Error);

use constant DEFAULT_RESULT_CACHE_TIME => 60;

# set debugging constant if YAA_DEBUG environment variable is set
BEGIN {
	use constant DEBUG => ((defined $ENV{YAA_DEBUG}) ? 1 : 0);
	use constant UNIX => ((($^O !~ /win/i) ? 0 : 1));
}

######################################################
#                GLOBAL VARIABLES                    #
######################################################
my $VERSION = "0.1";
$Error = undef;

######################################################
#               OBJECT CONSTRUCTOR                   #
######################################################

sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my $self = {};

	##################################################
	#               PUBLIC VARS                      #
	##################################################

	# last error accoured
	$self->{error} = undef;
	
	# cache last result?
	$self->{cache_last_result} = 1;

	# cache last result for specified number of seconds
	$self->{cache_result_time} = DEFAULT_RESULT_CACHE_TIME;

	##################################################
	#              PRIVATE VARS                      #
	##################################################
	
	# last lookup key
	$self->{_last_key} = undef;

	# last result object
	$self->{_last_result} = undef;	

	bless($self, $class);
	return $self;
}

####################################################
#               PUBLIC METHODS                     #
####################################################

# returns last error accoured
sub error {
	my ($self) = @_;
	
	return ((defined $self) ? $self->{error} : $Error);
}

# initializes new driver
sub factory {
	shift if ($_[0] eq 'Yaa::LookupMap');
	my $driver = undef;

	# it's time to parse command line arguments
	for (my $i = 0; $i <= $#_; $i++) {
		if ($_[$i] eq 'driver') {
			$driver = $_[$i + 1];
			last;
		}
	}

	# time to initialize driver
	if ($driver) {
		if (! grep(/^\Q$driver\E$/, Yaa::LookupMap->getAvailableDrivers())) {
			$Error = "Driver " . $driver . " is not available.";
			return undef;
		}
		
		# Load module
		eval "require Yaa::LookupMap::Driver::$driver;";

		if ($@) {
			$Error = "Unable to load driver (require() failed).";
			return undef;
		}
		return ("Yaa::LookupMap::Driver::" . $driver)->new(@_);
	}

	# hm..., looks like driver has not been initialized
	$Error = "Map driver was not specified.";

	# return error
	return undef;
}

# This function was taken from perl DBI module,
# written by Tim Bunce and later modified for Yaa
# requirements
# returns array of maps
sub getAvailableDrivers {
	my(@drivers, %seen_dir, %seen_yaa);
	my $haveFileSpec = eval { require File::Spec };
	local (*YAA::MAP::DIR, $@);

	foreach  my $d (@INC){
		# Perl 5 beta 3 bug in #!./perl -Ilib from Test::Harness
		chomp($d);

		my $yaa_dir = ($haveFileSpec ? File::Spec->catdir($d, "Yaa", "LookupMap", "Driver") : $d . "/Yaa/LookupMap/Driver");
		next unless (-d $yaa_dir);
		next if ($seen_dir{$d});
		$seen_dir{$d} = 1;

		# XXX we have a problem here with case insensitive file systems
		# XXX since we can't tell what case must be used when loading.
		if (! opendir(YAA::MAP::DIR, $yaa_dir)) {
			print STDERR "Cannot open directory ", $yaa_dir, ": ", $!, "\n";
			next;
		}
		foreach my $f (readdir(YAA::MAP::DIR)){
			next unless ($f =~ s/\.pm$//);
			next if ($f eq 'NullP');
			
			# this map driver seems ok, push it into list of drivers
			push(@drivers, $f) unless ($seen_yaa{$f});
			$seen_yaa{$f} = $d;
		}
		closedir(YAA::MAP::DIR);
	}

	# "return sort @drivers" will not DWIM in scalar context.
	return (wantarray ? sort @drivers : @drivers);
}


sub lookup {
	my ($self, $key) = @_;
	
	#print "key: '$key', last key: '", $self->{_last_key}, "', CACHE: ", $self->{cache_last_result}, "\n";
	
	# THIS IS SOOO UGLY
	if ($self->{cache_last_result}) {
		if ($key eq $self->{_last_key}) {
			if (($self->{_last_result_time} + $self->{cache_result_time} >= time())) {
				print STDERR "DEBUG: ",  File::Basename::basename(__FILE__), ", lookup(), line ", __LINE__, ": result for key '$key' in object cache.\n" if (DEBUG);
			} else {
				print STDERR "DEBUG: ",  File::Basename::basename(__FILE__), ", lookup(), line ", __LINE__, ": result for key '$key' in object cache, but has expired. Querying driver.\n" if (DEBUG);
				$self->{_last_result} = $self->_lookup($key);
				$self->{_last_result_time} = time();
			}
		} else {
			print STDERR "DEBUG: ",  File::Basename::basename(__FILE__), ", lookup(), line ", __LINE__, ": result for key '$key' not in object cache, querying driver.\n" if (DEBUG);
			$self->{_last_key} = $key;
			$self->{_last_result} = $self->_lookup($key);
			$self->{_last_result_time} = time();
		}
	} else {
		return $self->_lookup($key);
	}

	return $self->{_last_result};
}

=head2 setParams (key => value, key2 => value2)

Sets object's parameters. Parameters are driver dependent.

=cut
sub setParams {
	my ($self) = shift;
	
	while (defined (my $name = shift) && defined (my $value = shift)) {
		$self->{$name} = $value if (substr($name, 0, 1) ne '_');
	}
	
	return 1;
}

=head2 clearParam ()

Clears object's parameters

=cut
sub clearParams {
	return 1;
}

####################################################
#               PRIVATE METHODS                    #
####################################################

# driver lookup method
sub _lookup {
	my ($self) = @_;
	$self->{error} = "This method should be overloaded by driver subclass.";
	return undef;
}

1;
