discourse-legacysite-perl/site/slowtwitch.com/cgi-bin/articles/GT/SQL/Search/MYSQL/VER3.pm

# ==================================================================
# Gossamer Threads Module Library - http://gossamer-threads.com/
#
#   GT::Search::MYSQL::VER3
#   Author  : Aki Mimoto
#   CVS Info : 087,071,086,086,085      
#   $Id: VER3.pm,v 1.3 2004/08/28 03:53:49 jagerman Exp $
#
# Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
# ==================================================================
#
# Description:
#   Class used to search indexed tables.
#

package GT::SQL::Search::MYSQL::VER3;
# ------------------------------------------------------------------------------
    use strict;
    use vars qw/ @ISA $ATTRIBS $VERSION $DEBUG $AUTOLOAD /;
    use GT::SQL::Search::Base::Search;
    @ISA = qw( GT::SQL::Search::Base::Search );

# ------------------------------------------------------------------------------
# Preamble information related to the object

    $DEBUG   = 0;
    $VERSION = sprintf "%d.%03d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/;
    $ATTRIBS = {
        min_word_size => 4
    };

sub _phrase_query {
# ------------------------------------------------------------------------------
    my $self    = shift;
    my $phrases = shift or return $_[0];
    my $results = shift || {};

    foreach my $phrase ( values %{$phrases} ) {
        $self->debug_dumper( "Unioning: ", $phrase ) if ($self->{_debug});

        my $tmp = {};
        foreach my $keyword ( @{ $phrase->{phrase}|| [] } ) {
            $tmp = $self->_get_words ( [ $keyword ], $tmp, 'intersect' );
            keys %$tmp or return {};
        }
        foreach my $key ( keys %$tmp ) { $results->{$key} += $tmp->{$key} }

    }

    return $results;
}

sub _get_phrase {
# ------------------------------------------------------------------------------
# one day change this so it does words properly
    return _get_words(@_);
}

sub _union_query {
# ------------------------------------------------------------------------------
    return _get_words(@_);
}

sub _intersect_query {
# ------------------------------------------------------------------------------
    my ( $self, $keywords, $results ) = @_;
    $keywords or return $results;

    foreach my $keyword ( keys %{ $keywords || {} } ) {
        $results = $self->_get_words ( [ $keyword ], $results, 'intersect' );
        keys %$results or return {};
    }

    return $results;
}

sub _phrase_intersect_query {
# ------------------------------------------------------------------------------
    my $self    = shift;
    my $phrases = shift or return $_[0];
    my $results = shift || {};

    my $tmp = $self->_phrase_query ( $phrases, $results );
    keys %$results or return $tmp;
    foreach my $key ( keys %$results ) {
        if ( $tmp->{$key} ) {
            $results->{$key} += $tmp->{$key};
        }
        else {
            delete $results->{$key}
        }
    }

    return $results;
}

sub _disjoin_query {
# ------------------------------------------------------------------------------
    my $self    = shift;
    my $words   = shift or return shift;
    my $results = shift || {};

    $results = $self->_get_words([ keys %{$words || {}} ], $results, 'disjoin' );

    return $results;
}

sub _phrase_disjoin_query {
# ------------------------------------------------------------------------------
    my $self    = shift;
    my $phrases = shift or return shift;
    my $results = shift || {};

    my $tmp = $self->_phrase_query ( $phrases, $results );
    keys %$results or return $tmp;
    foreach my $key ( keys %$results ) {
        $tmp->{$key} and delete $results->{$key};
    }
}

sub _get_words {
# ------------------------------------------------------------------------------
    my $self     = shift;
    my $words    = shift or return $_[0] || {};
    my $results  = shift || {};
    my $mode     = lc shift;

    my $tbl      = $self->{table} or $self->error( 'BADARGS', 'FATAL', 'Must have table object defined' );
    my $tname    = $tbl->name();
    my $wordlist = join " ", ( ref $words ? ( ref $words eq 'HASH' ? keys %$words : @$words ) : $words ) ;
    my ($pk)     = $tbl->pk;

    my %weights  = $tbl->_weight_cols();
    my $cols     = join(",", keys %weights);
    my $qwrds    = quotemeta( $wordlist );
    my $where    = ( $results and keys %$results )
        ? ("AND $pk IN(" . join(',', keys %$results) . ")")
        : '';
    my $query = qq!
        SELECT $pk, MATCH($cols) AGAINST ('$qwrds') AS SCORE
        FROM  $tname
        WHERE MATCH($cols) AGAINST ('$qwrds')
        $where
    !;
    my $sth = $tbl->do_query( $query ) or return;

    if ( $mode eq 'disjoin' ) {
        while ( my $result = $sth->fetchrow ) {
            delete $results->{$result};
        }
    }
    elsif ( $mode eq 'intersect' ) {
        my $tmp = {};
        while ( my $aref = $sth->fetchrow_arrayref ) {
            $tmp->{$aref->[0]} = $aref->[1];
        }
        if ( $results and keys %$results ) {
            while (my ($id, $score) = each %$results) {
                if (not defined $tmp->{$id}) {
                    delete $results->{$id};
                    next;
                }
                $results->{$id} += $score;
            }
        }
        else {
            $results = $tmp;
        }
    }
    else {
        while ( my $aref = $sth->fetchrow_arrayref ) {
            $results->{$aref->[0]} += $aref->[1];
        }
    }
    return $results;
}

1;