package Data::Dataset::SQL;

use strict;
use warnings;
use Data::Dataset;
use Carp; # for similarity to the sql_engine methods


# $Id: SQL.pm,v 1.7 2007/01/08 17:34:17 mca Exp $

=head1 NAME

Data::Dataset::SQL - provide SQL fetching methods

=head1 DESCRIPTION

Provideds code to conveniently fetch labelled data from various
wrapped-up forms of DBI used within Sanger.

Currently, this isn't a class providing any methods.  It contains some
private subroutines and inserts to the various other packages some
additional methods to access this code.

XXX: This module file does bad things to the privates of several other
classes.


=head1 STANDARD-ish METHODS

These object methods become available within L<WrapSE2> and
L<sql_engine> (aka. L<statements>), B<provided> the rest of those
classes' code has been loaded.


=head2 getAllDataset($qname, \@params)

Object method.  Like C<getAll>, but returns a L<Data::Dataset> object.

Apply C<getAll> to the L<SqlEngine2> and L<WrapDBI> objects.  Passes
the given query name and parameters, extracts output field names with
C<getSthInfo> then generates and returns a L<Data::Dataset::Grid>
object containing the resulting data.

=head2 getAllDataset($qname, \@params1, \@params2, ...)

If multiple sets of parameters are supplied, the query will be
executed for each set in order.  Rows are concatenated in this order,
as with a UNION of SELECT queries, before the Dataset is made.

There is no uniq'ing or DISTINCT operation.

Dies if no parameters are supplied - there would be no guarantee that
C<getSthInfo> would work to fetch the column headings.

=cut

sub WrapSE2::getAllDataset {
    my ($self, @args) = @_;
    return Data::Dataset::SQL::_getAll_SE2
      ($self->{SE2}, $self->{dbh},
       @args);
}

sub statements::getAllDataset {
    my ($self, @args) = @_;
    return Data::Dataset::SQL::_getAll_sqleng
      ($self,
       @args);
}

# This method is provided by SqlEngine2; we need it in sql_engine too
sub statements::getSthInfo {
    my ($self, $statement, $key) = @_;

# Code from sql_engine.pm get()

    my ($lib, $sql);
    if ($statement =~ /::/){
	($lib, $sql) = $statement =~ /(\S+)::(\S+)/;
    } else {
	croak __PACKAGE__."~>SQL_ENGINE_ERROR $statement is not in the correct format of library::sql_name | all\n";
    }

    my $array_memb = $self->{seen_libs}->{$lib};
    unless (defined $array_memb &&
	    defined $self->{prepared_sql_libs}->[$array_memb]->{$sql}){
	# This isn't fatal in sql_engine.pm, but was intended to be.
	# For callers of the new code, it is.
	croak __PACKAGE__."~>SQL_ENGINE_ERROR $statement: This SQL has not been prepared !";
    }

    my $sth = $self->{prepared_sql_libs}->[$array_memb]->{$sql};

    my $rc = eval { $sth->{$key} };
    if ($@) {
	my $prob = $@;
	croak __PACKAGE__."~>SQL_ENGINE_ERROR $statement: getSthInfo($key) error: $prob";
    }
    return $rc;
}

sub _getAll_SE2 {
    my ($se2, $dbh, $qname, @params) = @_;

    my ($colinfo, $rows);
    for (my $i=0; $i<@params; $i++) {
	my $r = $se2->getAll($qname, $params[$i], $dbh);
	if (0 == $i) {
	    $colinfo = $se2->getSthInfo($qname, 'NAME_lc', $dbh);
	    $rows = $r;
	} else {
	    # move fetched rows onto our list; splice rather than push
	    # to give Perl the chance to avoid pointless refcount
	    # updates (?)
	    splice @$rows, scalar @$rows, 0,
	      @$r;
	}
    }
    die "No parameter sets for $qname call" unless @params && $colinfo;

    return Data::Dataset::Grid->new(-cols => $colinfo, -rows => $rows);
}

sub _getAll_sqleng {
    my ($sqleng, $qname, @params) = @_;

    my ($colinfo, $rows);
    for (my $i=0; $i<@params; $i++) {
	my $r = $sqleng->get($qname, $params[$i]);
	if (0 == $i) {
	    $colinfo = $sqleng->getSthInfo($qname, 'NAME_lc');
	    $rows = $r;
	} else {
	    # move fetched rows onto our list; splice rather than push
	    # to give Perl the chance to avoid pointless refcount
	    # updates (?)
	    splice @$rows, scalar @$rows, 0,
	      @$r;
	}
    }
    die "No parameter sets for $qname call" unless @params && $colinfo;

    return Data::Dataset::Grid->new(-cols => $colinfo, -rows => $rows);
}


=head2 getAllDataset_multi($qname, %args)

Run SELECT query(ies) and return a L<Data::Dataset>.  Designed to pull
back many rows WHERE column in (list-of-values), where you may pass in
an arbitrary sized list-of-values and have the query called enough
times to fetch them all.

$qname is an sql_lib query name, as for C<getAllDataset>.  Generates a
warning if this doesn't end in C<"_x".$by> where $by is the
placeholder list size.

%args contains key/value pairs,

=over 4

=item -by => num

Positive integer, the size of the list of placeholders into which
C<-in> values must by fitted in turn.  This must match the number of
placeholders in the SQL.

=item -in => \@list

List contains values to be put to the query's placeholders in turn.
Duplicate, C<undef> or non-SCALAR values here are not a good idea,
don't do it!

Will not modify @list, but see C<-partial> below.

=item -ordered => 0

Pass this to acknowledge that rows may not come back in any particular
order, and that if the C<-in> list contained any duplicates these may
not be duplicated in the output (depending on how the list was carved
up).

This is not a default, the C<-ordered> parameter is mandatory.

=item -ordered => \@orderer

The ARRAYref will be used to sort the collection of rows that come
back from the multiple queries.  This uses the

 $rows->rowListSorted(-sortby => \@orderer)

method of L<Data::Dataset>.  The specification for @orderer is there.

=item -pre => \@pre

=item -post => \@post

Additional bindparam lists, to be put before/after each set of C<-in>
values per query.  Each query executed will have parameters C<(@pre,
@val, @post)> where @val are some members from C<-in => \@list> above.

Note that these will be used even when some or all of the C<-in>
values are C<undef>.

=back

Unknown or missing keys will provoke errors.

Pending features, not yet supported (YAGNI), ask if you need them:

=over 4

=item -partial

Currently all the C<-in> values will be used to query, and the set of
results will be returned in one lump.  Other values may be supported
later, e.g. shifting off a bunch of C<-in> items and returning results
for those.

=item -tickoff

If a column were specified, this could be used to ensure that data had
been found for each of the C<-in> items.

=item -uniqify

To be applied either to the input parameters and/or output rows?

=back

XXX: can I use this to simplify ExoCheck::Report->plates_events_dataset ?

=cut

sub WrapSE2::getAllDataset_multi {
    my ($self, @args) = @_;
    return Data::Dataset::SQL::_getAll_multi($self, @args);
}

sub statements::getAllDataset_multi {
    my ($self, @args) = @_;
    return Data::Dataset::SQL::_getAll_multi($self, @args);
}

sub _getAll_multi { # depends on $db->getAllDataset
    my ($db, $qname, %args) = @_;

    ### Check args

    foreach my $k (qw( -by -in -ordered )) {
	die "getAllDataset_multi needs '$k' param"
	  unless defined $args{$k};
    }

    my $by = delete $args{-by};
    die "-by => $by: expected an int > 1" unless $by =~ /^\d+$/ && $by > 0;

    foreach my $k (qw( -in -pre -post )) {
	die "$k => $args{$k}: is not ARRAY ref"
	  if exists $args{$k} && ref($args{$k}) ne 'ARRAY';
    }
    my $in = delete $args{-in};
    my $pre = delete $args{-pre} || [];
    my $post = delete $args{-post} || [];

    die "-ordered: required parameter missing" unless exists $args{-ordered};
    my $ordered = delete $args{-ordered};
    die "-ordered => $ordered: expected ARRAY ref or false"
      unless (!$ordered || ref($ordered) eq 'ARRAY');

    # We're using all the args, copy the -in list so the caller's
    # array is not modified
    $in = [ @$in ];

    {
	my @unk = keys %args;
	die "Unknown args (@unk)" if @unk;
    }

    if ($qname !~ /_x$by$/) {
	# Convention for SQL naming might be useful, don't insist on it
	warn "Expected multi-query $qname to end in '_x$by', carrying on anyway";
    }


    ### Build sets of parameters, then pass to getAllDataset

    my @paramset;
    while (@$in) {
	# Take up to $by values
	my @param = splice @$in, 0, $by;
	# Pad out to a full set with NULLs
	push @param, (undef) x ($by - @param);

	push @paramset, [ @$pre, @param, @$post ];
    }

    if (0 == @paramset) {
	# If there are no params, we can't run the query; then we
	# can't know the column names.  So we need some params.
	#
	# Fudge up a matches-nothing parameter set and run with that.
	# The optimiser seems to be pretty bright about skipping.
	my @param = (undef) x $by;
	push @paramset, [ @$pre, @param, @$post ];
    }

    # Do the fetch(es)
    my $rows = $db->getAllDataset($qname, @paramset);

    if ($ordered) {
	# User requested a sort
	my @sorted = $rows->rowListSorted(-sortby => $ordered); # list of rowId in new order
	$rows = $rows->map_rowlist($rows->name.":sort", @sorted);
    }

    return $rows;
}


=head1 ADDITIONAL POKED METHODS

=head2 $se2-E<gt>getAllDataset($dbh, $query, @params)

An additional L<SqlEngine2> method to provide access to
C<getAllDataset> functionality, but note the different method
signature!

=cut

sub SqlEngine2::getAllDataset {
    my ($se2, $dbh, $query, @params) = @_;
    return Data::Dataset::SQL::_getAll_SE2
      ($se2, $dbh,
       $query, @params);
}


=head1 AUTHOR

mca@sanger.ac.uk

=cut

1;
