The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Hypatia::Base;
{
  $Hypatia::Base::VERSION = '0.029';
}
use Moose;
use Hypatia::Types qw(HypatiaDBI);
use Hypatia::DBI;
use Hypatia::Columns;
use Moose::Util::TypeConstraints;
use namespace::autoclean;

#ABSTRACT: An Abstract Base Class





has 'dbi'=>(isa=>HypatiaDBI,is=>'rw',coerce=>1,predicate=>'use_dbi',handles=>['dbh']);


subtype 'HypatiaColumns' => as maybe_type("Hypatia::Columns");
coerce "HypatiaColumns",from "HashRef", via {Hypatia::Columns->new({columns=>$_})};

#Note: the attribute here is named 'cols' so that we can use the 'columns' handle from the corresponding Hypatia::Columns object.
#We use BUILDARGS to do the ol' switcheroo.
has 'cols'=>(isa=>'HypatiaColumns',is=>'rw',coerce=>1,handles=>[qw(columns using_columns)],default=>sub{Hypatia::Columns->new});

around BUILDARGS=>sub
{
	my $orig  = shift;
	my $class = shift;
	my $args=shift;
	
	confess "Argument is not a hash reference" unless ref $args eq ref {};
	
	if(exists $args->{columns})
	{
		$args->{cols}=$args->{columns};
		delete $args->{columns};
	}
	
	return $class->$orig($args);
};


has 'input_data'=>(isa=>'HashRef',is=>'rw',predicate=>'has_input_data');




sub _guess_columns
{
	confess "The attribute 'columns' is required";
}

# This is a setup method for methods overriding _guess_columns.
# Yes, I know about the Moose keyword 'after', but I'm not
# sure offhand how to run the code in _setup_guess_columns
# except if _guess_columns is being overridden.
sub _setup_guess_columns
{
	my $self=shift;
	
	my $query=$self->dbi->_build_query;
	
	my $dbh=$self->dbh;
	my $sth=$dbh->prepare($query) or die $dbh->errstr;
	$sth->execute or die $dbh->errstr;
	
	my @return = @{$sth->{NAME}};
	
	$sth->finish;
	
	return \@return;
}

sub _get_data
{
	my $self=shift;
	my @args = ();
	
	$self->_guess_columns unless $self->using_columns;

	my $found_query = 0;
	foreach my $arg(@_)
	{
		if(defined $self->columns->{$arg} and ref $arg eq ref "" or ref $arg eq ref [])
		{
			push @args,$self->columns->{$arg};
		}
		elsif(ref $arg eq ref {} and grep{$_ eq "query"}(keys %$arg) and (not $found_query))
		{
			push @args,{query=>$arg->{query}};
			$found_query = 1;
		}
	}
	
	if($self->use_dbi)
	{	
		return $self->dbi->data(@args);
	}
	else
	{
		return $self->input_data;
	}
}

sub _validate_input_data
{
	my $self=shift;
	
	my $data=shift;
	
	return undef unless defined $data;
	
	my $first=1;
	my $num_rows;
	
	my @column_list;
	
	confess "The columns attribute is required if you wish to pass in input_data" unless $self->using_columns;

	foreach my $type(keys %{$self->columns})
	{
		my $col=$self->columns->{$type};
		
		if(ref $col eq ref [])
		{
			foreach my $c(@$col)
			{
				push @column_list,$c unless grep{$c eq $_}@column_list;
			}
		}
		else
		{
			push @column_list,$col unless grep{$col eq $_}@column_list;
		}
	}
	
	foreach my $col(@column_list)
	{ 
		unless(grep{$_ eq $col}(keys %$data))
		{
			warn "WARNING: Column \"$col\" not found as a key in the input_data attribute\n";
			return undef;
		}
		
		
		my @column=@{$data->{$col}};
		
		unless(@column == grep{defined $_}@column)
		{
			warn "WARNING: Undefined values found in the input_data for column $col";
			return undef;
		}
		
		if($first)
		{
			$num_rows=scalar(@column);
			$first=0;
		}
		else
		{
			unless(@{$data->{$col}} == $num_rows)
			{
				warn "WARNING: Mismatch for number of elements in input_data values";
				return undef;
			}
		}
	}
	
	return 1;
}

1;

__END__

=pod

=head1 NAME

Hypatia::Base - An Abstract Base Class

=head1 VERSION

version 0.029

=head1 ATTRIBUTES

=head2 dbi

If the data source is from DBI, then this attribute contains the information necessary to connect to the database (C<dsn>,C<username>, and C<password>) along with the source of the data within the database (C<query> or C<table>).  This hash reference is passed directly into a L<Hypatia::DBI> object.  Note that if a connection is successful, the resulting database handle is passed into a C<dbh> attribute.  See L<Hypatia::DBI> for more information.

=head2 columns

This is a hash reference whose keys represent the column types (often C<x> and C<y>) and the values of which represent column names from the data that correspond to the given column type.

=head2 input_data

If your data source isn't from a database, then you can store your own data in this attribute.  The requirements will vary depending on subclass.

=head2 columns

This is a hash reference that assigns a sub-class dependent column type (e.g. C<x> or C<y>) to one or more columns.  For example, 

	columns=>{
		x=>"time_of_day",
		y=>"num_widget_sales"
	}

could be used in a line graph to indicate that the "time_of_day" column goes on the x-axis and the "num_widget_sales" column goes on the y-axis.  On the other hand, for a bubble chart, you might have

	columns=>{
		x=>"total_units_sold",
		y=>["pct_growth_over_last_year","pct_growth_over_last_month"],
		size=>["pct_yearly_revenue","pct_monthly_revenue"]
	}

to indicate a bubble chart with two sets of y values each having two different columns to indicate size, and all with a single set of x values.

B<Note:> The exact requirements of this attribute will vary depending on which sub-class you're calling.  Consult the relevant documentation.

=head1 INTERNAL METHODS

=head2 _guess_columns

This can be thought of as a (quasi) abstract method. By default, this method simply invokes a L<confession|Carp>, but it's meant to be overridden by submodules.

=head2 _get_data

This method is responsible for returning the data required by the C<graph> methods (as provided by modules extending this module). If the C<columns> attribute isn't set, then column guessing is triggered (via the C<_guess_columns> method). If the data source is from a database connection, then this method grabs it, otherwise it returns the data from the C<input_data> attribute.

=head1 AUTHOR

Jack Maney <jack@jackmaney.com>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2012 by Jack Maney.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut