288 lines
8.8 KiB
Perl
288 lines
8.8 KiB
Perl
# ====================================================================
|
|
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
|
#
|
|
# GT::SQL::Search::STH
|
|
# Author: Aki Mimoto
|
|
# CVS Info : 087,071,086,086,085
|
|
# $Id: STH.pm,v 1.25 2004/08/28 03:53:46 jagerman Exp $
|
|
#
|
|
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
|
# ====================================================================
|
|
#
|
|
|
|
package GT::SQL::Search::STH;
|
|
#--------------------------------------------------------------------------------
|
|
use strict;
|
|
use vars qw/@ISA $ATTRIBS $VERSION $DEBUG $ERRORS $ERROR_MESSAGE /;
|
|
use GT::Base;
|
|
|
|
@ISA = ('GT::Base');
|
|
$ATTRIBS = {
|
|
'_debug' => 0,
|
|
'sth' => undef,
|
|
'results' => {},
|
|
'db' => undef,
|
|
'table' => undef,
|
|
'index' => 0,
|
|
'order' => [],
|
|
'sb' => 'score',
|
|
'so' => '',
|
|
'score_col' => 'SCORE',
|
|
'score_sort'=> 0,
|
|
'nh' => 0,
|
|
'mh' => 0
|
|
};
|
|
$ERROR_MESSAGE = 'GT::SQL';
|
|
$ERRORS = {
|
|
BADSB => 'Invalid character found in so: "%s"',
|
|
};
|
|
|
|
sub init {
|
|
#--------------------------------------------------------------------------------
|
|
my $self = shift;
|
|
|
|
# setup the options
|
|
$self->set(@_);
|
|
|
|
# correct a few of the values
|
|
--$self->{nh} if $self->{nh};
|
|
|
|
my $sth;
|
|
my $results = $self->{results};
|
|
$self->{rows} = scalar( $results ? keys %{$results} : 0 );
|
|
|
|
# if we have asked to have sorting by another column (non score), create the part of the query that handles taht
|
|
$self->debug( "Setting up sorting for GT::SQL::Search::STH" ) if ($self->{_debug});
|
|
my $sb;
|
|
|
|
# clean up the sort by columns.
|
|
unless ($self->{'score_sort'}) {
|
|
$sb = GT::SQL::Search::Base::Search->clean_sb($self->{sb}, $self->{so});
|
|
}
|
|
|
|
# setup the max hits and the offsets
|
|
$self->{index} = $self->{nh} * $self->{mh} || 0;
|
|
$self->{max_index} = $self->{index} + $self->{mh} - 1; # index + mh is the first record which should not be returned.
|
|
|
|
if ( $self->{max_index} > $self->{rows} ) {
|
|
$self->{max_index} = $self->{rows};
|
|
$self->{rows} = $self->{rows} - $self->{index};
|
|
$self->{rows} < 0 ? $self->{rows} = 0 : 0;
|
|
}
|
|
|
|
else {
|
|
$self->{rows} = $self->{mh};
|
|
}
|
|
|
|
# if we are sorting by another column, handle that
|
|
if ( $sb and (keys %{$self->{results}})) {
|
|
my ( $table, $pk ) = $self->_table_info();
|
|
my ( $query, $where, $st, $limit );
|
|
|
|
$where = qq!$pk in(! . join( ",", keys %{$self->{results}}) . ')';
|
|
$self->{mh} and $limit = qq!LIMIT $self->{index}, $self->{rows}!;
|
|
$query = qq!
|
|
SELECT $pk
|
|
FROM $table
|
|
WHERE $where
|
|
$sb
|
|
$limit
|
|
!;
|
|
$self->debug( "Row fetch query: $query" ) if ($self->{_debug});
|
|
$sth = $self->{table}->{driver}->prepare( $query );
|
|
$sth->execute();
|
|
|
|
# fix the counts
|
|
$self->{index} = 0;
|
|
$self->{max_hits} = $self->{rows};
|
|
|
|
# now return them
|
|
my $order = $sth->fetchall_arrayref();
|
|
$sth->finish();
|
|
|
|
$self->{'order'} = [ map { $_->[0] } @{$order} ];
|
|
}
|
|
else {
|
|
$self->{'order'} = [ sort {
|
|
( $results->{$b} || return 0 ) <=> ( $results->{$a} || 0 )
|
|
} keys %{$results} ];
|
|
$self->debug_dumper( "Results will be presented in the following order: ", $self->{'order'} ) if ($self->{_debug});
|
|
}
|
|
|
|
}
|
|
|
|
sub cache_results {
|
|
#--------------------------------------------------------------------------------
|
|
my $self = shift;
|
|
|
|
my $results = $self->{'results'};
|
|
my ($sth, @records, $i, %horder, @order, $in_list);
|
|
my $table = $self->{table};
|
|
my $tname = $table->name();
|
|
my ($pk) = $self->{table}->pk;
|
|
|
|
use GT::SQL::Condition;
|
|
|
|
# we know what we're doing here so shut off warns (complains about uninit'd values in range
|
|
# if thee aren't enough elements in the order array)
|
|
my $w = $^W; $^W = 0;
|
|
@order = grep $_, @{$self->{'order'} || []}[$self->{index}..$self->{max_index}] or return [];
|
|
$^W = $w;
|
|
|
|
$i = 0; %horder = ( map { ( $_ => $i++) } @order );
|
|
$in_list = join ( ",", @order );
|
|
my $query = qq|
|
|
SELECT *
|
|
FROM
|
|
$tname
|
|
WHERE
|
|
$pk IN($in_list)
|
|
|;
|
|
|
|
# the following is left commented out as...
|
|
# if $tbl->select is used $table->hits() will not
|
|
# return an accurate count of the number of all the hits. instead, will return
|
|
# a value up to mh. $tbl->hits() is important because the value is used
|
|
# in toolbar calculations
|
|
#
|
|
# $sth = $table->select( GT::SQL::Condition->new( $pk, 'IN', \"($in_list)" ) );
|
|
$sth = $table->do_query( $query );
|
|
|
|
while ( my $href = $sth->fetchrow_hashref() ) {
|
|
$records[$horder{$href->{$pk}}] = \%$href
|
|
}
|
|
|
|
return \@records;
|
|
|
|
}
|
|
|
|
sub fetchrow_array {
|
|
#--------------------------------------------------------------------------------
|
|
return @{ $_[0]->fetchrow_arrayref() || [] };
|
|
}
|
|
|
|
sub fetchrow_arrayref {
|
|
#--------------------------------------------------------------------------------
|
|
my $self = shift;
|
|
my $records = $self->{cache} ||= $self->cache_results;
|
|
my $href = shift @$records or return;
|
|
return $self->_hash_to_array($href);
|
|
}
|
|
|
|
sub fetchrow_hashref {
|
|
#--------------------------------------------------------------------------------
|
|
my $self = shift;
|
|
|
|
my $results = $self->{'results'};
|
|
my $records = $self->{cache} ||= $self->cache_results;
|
|
my $table = $self->{table};
|
|
my ($pk) = $self->{table}->pk;
|
|
|
|
my $href = shift @$records or return;
|
|
|
|
$href->{$self->{'score_col'}} = ( $self->{score} = $results->{$href->{$pk}} );
|
|
|
|
return $href;
|
|
|
|
}
|
|
|
|
sub fetchall_hashref {
|
|
#--------------------------------------------------------------------------------
|
|
my $self = shift;
|
|
my @results;
|
|
while (my $res = $self->fetchrow_hashref) {
|
|
push @results, $res;
|
|
}
|
|
return \@results;
|
|
}
|
|
|
|
sub fetchall_list {
|
|
#--------------------------------------------------------------------------------
|
|
return { map { @$_ } @{shift->fetchall_arrayref} }
|
|
}
|
|
|
|
sub fetchall_arrayref {
|
|
#--------------------------------------------------------------------------------
|
|
my $self = shift;
|
|
|
|
$self->{order} or return [];
|
|
my $results = $self->{results};
|
|
my ($pk) = $self->{table}->pk;
|
|
my $scol = $self->{score_col};
|
|
|
|
|
|
if (!$self->{allref_cache}) {
|
|
$self->{allref_cache} ||= $self->cache_results;
|
|
|
|
for my $i ( 0 .. $#{$self->{allref_cache}} ) {
|
|
my $element = $self->{allref_cache}->[$i];
|
|
if ( $_[0] eq 'HASH' ) {
|
|
$element->{$scol} = $results->{$element->{$pk}};
|
|
}
|
|
else {
|
|
$element->{$scol} = $self->_hash_to_array( $element->{$scol} );
|
|
}
|
|
};
|
|
}
|
|
|
|
my $records = $self->{allref_cache};
|
|
|
|
return $records;
|
|
}
|
|
|
|
sub score {
|
|
#--------------------------------------------------------------------------------
|
|
my $self = shift;
|
|
return $self->{score};
|
|
}
|
|
|
|
sub _hash_to_array {
|
|
#--------------------------------------------------------------------------------
|
|
my $self = shift;
|
|
my $href = shift or return;
|
|
|
|
my $results = $self->{'results'};
|
|
my $table = $self->{table};
|
|
my $cols = $table->cols();
|
|
my $ordercols = ( $self->{ordercols} ||= [ sort { $cols->{$a}->{pos} <=> $cols->{$b}->{pos} } keys %$cols ] );
|
|
my ($pk) = $self->{table}->pk;
|
|
my $aref = [ map { $href->{$_} } @$ordercols, ( $self->{score} = $results->{$href->{$pk}} ) ];
|
|
|
|
return $aref;
|
|
}
|
|
|
|
sub rows {
|
|
#--------------------------------------------------------------------------------
|
|
my $self = shift;
|
|
return $self->{rows};
|
|
}
|
|
|
|
sub _table_info {
|
|
#--------------------------------------------------------------------------------
|
|
my $self = shift;
|
|
my $table = $self->{table}->name() or return $self->error('NOSCHEMA', 'FATAL');
|
|
my ($pk) = $self->{table}->pk;
|
|
return ( $table, $pk );
|
|
}
|
|
|
|
sub DESTROY {
|
|
#--------------------------------------------------------------------------------
|
|
my $self = shift;
|
|
$self->{'sth'} and $self->{'sth'}->finish();
|
|
}
|
|
|
|
sub debug_dumper {
|
|
#--------------------------------------------------------------------------------
|
|
# calls debug but also dumps all the messages
|
|
my $self = shift;
|
|
my $message = shift;
|
|
my $level = ref $_[0] ? 1 : shift;
|
|
|
|
if ( $self->{_debug} >= $level ) {
|
|
require GT::Dumper;
|
|
$self->debug( $message . join( "", map { GT::Dumper::Dumper($_) } @_ )) if ($self->{_debug});
|
|
}
|
|
}
|
|
|
|
1;
|