#!/usr/bin/perl -w
#
# Search::Base.pm -- Base class for search engines
#
# Copyright 1996 by Michael J. Heins <mikeh@iac.net>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# $Log: Base.pm,v $
# Revision 1.3  1996/04/29 22:28:22  mike
# Fixed bug in more_matches, developed match_limit from next and last - removed
#
# Revision 1.2  1996/04/29 20:24:46  mike
# minor doc change
#
# Revision 1.1  1996/04/29 20:13:34  mike
# Initial revision
#
# Revision 1.4  1996/04/29 19:56:11  mike
# Added head_skip
#
# Revision 1.3  1996/04/26 04:49:51  mike
# Corrected minor doc problem (mandatory section DESCRIPITON not found)
#
# Revision 1.2  1996/04/26 04:38:11  mike
# Initial Release 0.1
#
# Revision 1.1  1996/04/25 06:40:56  mike
# Initial revision
#
# Revision 1.1  1996/04/25 06:40:26  mike
# Initial revision
#
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

package Search::Base;

$VERSION = substr(q$Revision: 1.3 $, 10);
$DEBUG = 0;

=head1 NAME

Search.pm - provide framework for multiple searches

=head1 SYNOPSIS

    use Search::TextSearch;
    use Search::Glimpse;

=cut

=head1 DESCRIPTION

This module is a base class interfacing to search engines. It defines an
interface that can be used by any of the Search search modules, such as
Search::Glimpse or Search::TextSearch, which are the standard ones included
with the module.

It exports no routines, just provides methods for the other classes.

=head2 Search Comparisons

                         Text           Glimpse 
                        -------        --------
 Speed                   Medium        Dependent on uniqueness of terms
 Requires add'l software No            Yes   
 Search individually     Yes           Yes
  for fields               
 Search multiple files   Yes           Yes
 Allows spelling errors  No            Yes
 Fully grouped matching  No            No


=head1 Methods

Only virtual methods are supported by the Search::Base class. Those search
modules that inherit from it may export static methods if desired. There are
the L<Global Parameter Method>, L<Column Setting Functions>, and 
L<Row Setting Functions>. L<SEE ALSO> Search::Glimpse, Search::TextSearch.

=head2 Global Parameter Method

    $s->global(param,val); 
    $status = $s->global(param); 
    %globals = $s->global();

Allows setting of the parameters that are global to the search. The standard
ones are listed below.

=over 4

=item base_directory

Those engines which look for matches in index files can read this
to get the base directory of the images.

=item case_sensitive

This is a global version of the I<cases> field. If set, the search
engine should return only matches which exactly match, including
distinction between lower- and upper-case letters.  The default is not
set, to ignore case.

=item error_page

A page or filename to be displayed when a user error occurs.
Passed along with a single string parameter to the error_routine,
as in:
  
     &{$self->{global}->{error_routine}}
        ($self->{global}->{error_page}, $msg);

=item error_routine

Reference to a subroutine which will send errors to the user. The
default is '\&croak'.

=item first_match

The number of the first match returned in a of I<more_matches>. This
tells the calling program where to start their increment.

=item history

The number of searches to keep in the history.

=item head_skip

Used for the TextSearch module to indicate lines that should be skipped
at the beginning of the file. Allows a header to be skipped if
it should not be searched.

The number of searches to keep in the history.

=item index_delim

The delimiter character to terminate the return code in an ascii
index file. In Search::Glimpse and Search::TextSearch, the default
is "\t", or TAB.  This is also the default for {return_delim}
if that is not set.

If field-matching is being used, this the character/string used
for splitting the fields.  If properly escaped, and {return_delim}
is used for joining fields, it can be a regular expression -- Perl
style.

=item index_file

A specification of an index file (or files) to search.  The usage
is left to the module -- it could, for example, be an anonymous array
(as in Search::TextSearch) or wild-card specification for multiple indices
(as in Search::Glimpse).

=item log_routine

A reference to a subroutine to log an error or status indication.
By default, it is '\&Carp::carp';

=item match_limit

The number of matches to return.  Not to be confused with max_matches,
at which number the search will terminate. Additional matches will be
stored in the file pointed to by I<save_dir>, I<session_id>, and I<search_mod>.
The default is 50.

=item matches

Set by the search routine to indicate the number of matches in the
last search. If the engine can return the total number of matches
(without the data) then that is the result.

=item min_string

The minimum size of search string that is supported. Using a size of less
than 4 for Glimpse, for example, is not wise.  

=item next_pointer

The pointer to the next list of matches. This is for engines that
can return only a subset of the elements starting from an element.
For making a next match list.

=item next_url

The base URL that should be used to invoke the I<more_matches>
function. Provided as an object-contained scratchpad value for
the calling routine -- it will not be used or modified by Search::Base.

There are a couple of useful ways to use this to invoke the 
proper I<more_matches> search that are shown in the example
search CGI provided with this module set. Both involve setting
the next_url and combining it with a random I<session_id> and
I<search_mod>.

=item or_search

If set, the search engine should return matches which match any of the
search patterns.  The default is not set, requiring matches to all
of the keywords for a match return.

=item overflow

Set by the search routine if it matched the maximum number before reaching
the end of the search. Set to undef if not supported.

=item record_delim 

This sets the type of record that will be searched. For the
Search::TextSearch module, this is the same as Perl -- in fact,
the default is to use $/ (at the time of object creation) as
the default.

For the Search::Glimpse module, the following mappings occur:

    $/ = "\n"        Glimpse default
    $/ = "\n\n"      -d '$$'
    $/ = ""          -d '$$'
    $/ = undef       -d 'NeVAiRbE'
    anything else    passed on as is (-d 'whatever')

One useful pattern is '^From ', which will make each email
message in a folder a separate record.

If you are doing this, and expect to be doing field returns,
it will probably be useful to set "\n\n" or "\n" as the
default I<index_delim>. If used in combination with the obscure
anonymous hash definition of I<return_fields>, you can
search and return mail headers on each message that matches.

=item return_delim

The delimiter character to join fields that are cut out of
the matched line/paragraph/page. The default is to set it
to be the same as {index_delim} if not explicitly set.

=item return_fields 

The fields that will be returned from the line/paragraph/page
matched.  This is not to be confused with the I<fields> setting --
it will not affect the matching, only the returned fields.
The default (when it is undefined) is to return only the first
field.  There are several options for this field.

If the value is an ARRAY reference, an integer list of the columns to be
returned is assumed.

If the value is a HASH reference, then all words found AFTER the
I<key> of the hash (with assumed but not required whitespace as a separator)
up to the I<value> of the item (used as a delimiter).  The following  example
will print the value of the From:, Reply-to: and Date: headers from any
message in your (UNIX) system mailbox that contains 'foobar'.

    $s = new Search::TextSearch
            return_fields => {
                            From: => "\n",
                            Reply-To: => "\n",
                            Date: => "\n",
                            },
            record_delim    => "\nFrom ",
            search_file     => $ENV{MAIL};

    print $s->search('foobar');

=item return_file_name

All return options will be ignored, and the file names of any matches
will be returned instead. The limit match-to-field routines are still
enabled for Search::TextSearch, but not for Glimpse, since the 'glimpse B<-l>'
option is used for that.

=item save_dir

The directory that search caches (for the I<more_matches> function)
will be saved in.  Only applies to file save mode.

=item search_history 

An anonymous array [size I<history>] of 'unevaled' strings that contain
the search history.  When evaled by the Search::Base module, will
create an environment in the object that duplicates previous searches.
It is up to the application to save the value.

=item search_mod

This is used to develop a unique search save id for a user with
a consistent I<session_id>.  For the I<more_matches> function.

=item search_port

The port (passed to glimpse with the B<-K> option) that is to be
used for a network-attached search server.

=item search_server

The host name of a network-attached search server, passed to glimpse
with the B<-J> option.

=item session_id

This is used to determine the save file name or hash key used to
cache a search (for the I<more_matches>) function.

=item speed

The speed of search desired, in an integer value from one to 10. Those engines
that have a faster method to search (possibly at a cost of comprensivity) can
adjust their routines accordingly.

=item spelling_errors

Those engines that support "tolerant matching" can honor this parameter
to set the number of spelling errors that they will allow for.
I<This can slow search dramatically on big databases.> Ignored by
search engines that don't have the capability.

=item substring_match

If set, the search engine should return partial, or substring, matches.
The default is not set, to indicate whole word matching.
I<This can slow search dramatically on big databases.> 

=item uneval_routine

A reference to a subroutine to save the search history to a cache.
By default, it is '\&uneval', the routine supplied with Search::Base.

=back

=head1 METHODS

=head2 Virtual methods provided

=item more_matches

Given a file with return codes from previous searches, one per line,
returns an array with the correct matches in the array.  Opens the
file in directory I<save_dir>, with session information appended
(the I<session_id> and I<search_mod>), and returns I<match_limit> matches,
starting at I<next_pointer>.

=item search

This is the main method defined in the individual search engine.
You can submit a single parameter for a quick search, which will
be interpreted as the one and only search specification, overriding
any settings residing in the I<specs> array.  Options can be specified
at object creation, or separately with the I<global> method. Or a
I<search_spec> can be specified, which will temporarily override
the setting in I<specs> (for that invocation only).

Otherwise, the parameters are named search options as documented
above.  Examples:

    # Simple search with default options for 'foobar' in the named file
    $s = new Search::TextSearch search_file => '/var/adm/messages');
    @found = $s->search('foobar');

    # Search for 'foobar' in /var/adm/messages, return only fields 0 and 2
    # where fields are separated by spaces
    $s = new Search::TextSearch;
    @found = $s->search( search_file   => '/var/adm/messages',
                         search_spec   => 'foobar',
                         return_fields => [0,2],
                         return_delim  => ' ',
                         index_delim   => '\s+'                 );

    # Search for 'foobar' in any file containing 'messages' in
    # the default glimpse index, return the file names
    $s = new Search::Glimpse;
    @found = $s->search( search_spec   => 'foobar',
                         search_file   => 'messages',
                         return_file_name  => 1,       );

    # Same as above except use glimpse index located in /var directory
    $s = new Search::Glimpse;
    @found = $s->search( search_spec       => 'foobar',
                         base_directory    => '/var',
                         search_file       => 'messages',
                         return_file_name  => 1,       );

    # Search all files in /etc
    # Return file names with  lines that have 'foo' in field 1
    # and 'bar' in field 3, with case sensitivity
    # (using the default field delimiter of \t)
    $s = new Search::TextSearch;
    $s->rowpush('foo', 1);
    $s->rowpush('bar', 3);
    chop(@files = `ls /etc`);
    @found = $s->search( search_file   => [@files],
                         case_sensitive  => 1,
                         return_file_name  => 1,       );

    # Same as above using direct access to specs/fields
    $s = new Search::TextSearch;
    $s->specs('foo', 'bar');
    $s->fields(1, 3);
    chop(@files = `ls /etc`);
    @found = $s->search( search_file   => [@files],
                         case_sensitive  => 1,
                         return_file_name  => 1,       );
    # Repeat search with above settings, except for specs,
    # if less than 4 matches are found
    if(@found < 4) {
        @found = $s->search('foo');
    }


=head2 Column Setting Methods

Column setting functions allow the setting of a series of columns of
match criteria:

    $search->specs('foo', 'foo bar', 'foobar');
    $search->fields(1, 3, 4);

This is an example for the I<specs> and I<fields> match criteria, which
are the search specifications and  the the fields to search,
respectively. Similar functions are provided for I<mods>, I<links>,
I<cases>, I<negates>, I<open_parens>, and I<close_parens>.

For the included Search::Glimpse and Search::TextSearch modules, an item will
match the above example only if field (or column) 1 contains 'foo',
field 3 contains 'foo' and/or 'bar', and field 4 contains foobar.  The
setting of the case_sensitive, or_search, and substring_match terms will
be honored as well.

For simple searches, only one term need be set, and the grouping
functions I<links>, I<open_parens>, and I<close_parens> are ignored.
In most cases, if the setting for a particular column is not defined
for a row, the value in the global setting is used.

=over 4

=item specs

The search text, raw, per field. This is the only item that
necessarily needs to be set to do a search.

If more than one specification is present, there are three forms of
behavior supported by the included Search::TextSearch and Search::Glimpse
modules. First, if there are multiple search specifications, they are
combined together, just as they would if separated by spaces (and not
quoted).  Second, if the number of specs matches the number of
I<fields>, each spec must match the field that it is associated with
(subject to the I<or_search> and I<case_sensitive> settings within that
field). Last, if there are more I<fields> than I<specs>, only the columns
in I<fields> are searched for the combined specs.

=item fields

The column B<numbers> to search, where a column is a field separated by
I<index_delim>. In the Search::TextSearch and Search::Glimpse modules,
this becomes operative in one of two ways. If the number of I<specs>
match the number of fields, each specification is separately checked
against its associated field.  If the number of fields is different from
the number of I<specs>, all specs are applied, but only to the text in
the specified fields.  Both first match on all of the text in the row,
then filter the match with another routine that checks for matches in
the specified fields.

=item mods        

Modifies the match criteria. Recognized modifications might be:

    start   Matches when the field starts with the spec
    sub     Match substrings.

Not supported in the included modules.

=item links

The link to the previous row. If there are two I<fields> to search, with
two different I<specs>, this determines whether the search is AND, OR,
or NEAR.  For engines that support it, NEAR matches with in
$self->global('near') words of the previous word (forward only). Not
supported in the included modules.

=item cases

For advanced search engines that support full associative
case-sensitivity.  Determines whether the particular match in this set
will be case-sensitive or not.  If the search engine doesn't support
independent case-sensitivity (like the Search::TextSearch and Search::Glimpse
modules), the value in I<or_search> will be used. Not supported in
the included modules.

=item negates

Negates the sense of the match for that term.  Allows searches like 
"spec1 AND NOT spec2" or "NOT spec1 AND spec2". Not supported in
the included modules.

=item open_parens

Determines whether a logical parentheses will be placed on the left 
of the term. Allows grouping of search terms for more expressive matching,
i.e. "(AUTHOR Shakespeare AND TYPE Play ) NOT TITLE Hamlet". Not supported in
the included modules.

=item close_parens

Determines whether a logical parentheses will be placed on the right
of the term. Not supported in the included modules.

=back

=head2 Row Setting Methods

Row setting functions allow the setting of all columns in a row.

    $query->rowpush($field,$spec,$case,$mod,$link,$left,$right);
    ($field,$spec,$case,$mod,$link,$left,$right) = $query->rowpop();
    @oldvals = $query->rowset(n,$field,$spec,$case,$mod,$link,$left,$right);

You can ignore the trailing parameters for a simple search. For example:

    $field = 'author';
    $spec = 'forsythe';
    $limit = 25;
    $query = new Search::Glimpse;
    $query->rowpush($field,$spec);
    @rows = $query->search( match_limit => 25 );

This searches the field 'author' for the name 'forsythe', with all other
options at their defaults (ignore case, match substrings, not negated, no
links, no grouping), and will return 25 matches (sets the matchlimit global).
For a more complex search, you can add the rest of the parameters as needed.

=over 4

=back

=head1 SEE ALSO

glimpse(1), Search::Glimpse(3L), Search::TextSearch(3L)

=head1 AUTHOR

Mike Heins, <mikeh@iac.net>

=cut

use Carp;
use strict;

sub new {
	my ($class, %options) = @_;
	my $s = {};

	$s->{global} = {
		base_directory		=> '',
		case_sensitive		=> 0,
		error_page			=> '',
		error_routine		=> \&croak,
		record_delim		=> $/,
		head_skip			=> 0,
		index_delim			=> "\t",
		index_file			=> '',
		log_routine			=> \&carp,
		match_limit			=> 50,
		max_matches			=> 2000,
		min_string			=> 1,
		next_pointer		=> 0,
		or_search			=> 0,
		return_delim		=> undef,
		return_fields		=> '',
		return_file_name	=> '',
		save_dir			=> '',
		search_history		=> [],
		search_mod			=> '',
		session_id			=> '',
		spelling_errors		=> 0,
		substring_match		=> 0,
		uneval_routine		=> '\&Search::Base::uneval',
	};

	$s->{specs}       = []; # The search text, raw, per field 
							# Special case is form with only one searchspec,
							# it searches in all columns, takes its
							# options from first position

	$s->{fields}      = [];	# The columns to search, by number

	$s->{mods}        = [];	# i.e. whole_word -> whole words

	$s->{links}       = []; # Can contain 'and', 'or',
							# 'near',
							# undef defaults to AND

	$s->{cases}       = [];	# set for case-sensitive
	$s->{negates}     = [];	# set for NOT

	$s->{open_parens} = [];	# Associated with searchfields
							# Open parentheses to stop association
							# with left-hand column.

	$s->{close_parens}= [];	# Associated with searchfields
							# Close parentheses to stop association
							# with right-hand column.

	bless $s, $class;

}

sub global {
	my ($self,$term,$value) = @_;

	if (defined $value) {
		$self->{global}->{$term} = $value;
	}
	elsif (defined $term) {
		$self->{global}->{$term};
	}
	else {
		%{$self->{global}};
	}
}


sub set_param {

	my($self,$term,@fields) = @_;

	unless (defined $self->{$term}) {
		my $caller = caller();
		my $name = sub {caller()};
		&{$self->{'global'}->{error_routine}}
			("$caller calling $name: accessed non-existent array $term.");
	}

	if(@fields) {
		@{$self->{$term}} = @fields;
	}
	else {
		@{$self->{$term}};
	}

}

sub debug { shift; print(@_) if $Search::Base::DEBUG }

sub version {
	$Search::Base::VERSION;
}

sub fields {
	my ($self,@fields) = @_;
	$self->set_param('fields', @fields);
}

sub specs {
	my ($self,@specs) = @_;
	$self->set_param('specs',@specs);
}

sub cases {
	my ($self,@cases) = @_;
	$self->set_param('cases',@cases);
}

sub negates {
	my ($self,@negates) = @_;
	$self->set_param('negates',@negates);
}

sub links {
	my ($self,@links) = @_;
	$self->set_param('links',@links);
}

sub mods {
	my ($self,@mods) = @_;
	$self->set_param('mods',@mods);
}

sub open_parens {
	my ($self,@open_parens) = @_;
	$self->set_param('open_parens',@open_parens);
}

sub close_parens {
	my ($self,@close_parens) = @_;
	$self->set_param('close_parens',@close_parens);
}

sub rowpush {
	my $self = shift;
	my @out;

	for(field_order()) {
		push @out, push(@{$self->{$_}}, shift @_);
	}
	@out;
}

sub rowpop {
	my $self = shift;
	my @out;

	for(field_order()) {
		push @out, pop(@{$self->{$_}});
	}
	@out;
}

sub rowset {
	my $self = shift;
	my $col = shift;
	my @out;
	my $val;

	for(field_order()) {
		$val = splice(@{$self->{$_}},$col,1,shift);
		push @out, $val;
	}
	@out;
}

sub field_order {
	qw(
		specs
		fields
		mods
		cases
		links 
		negates
		open_parens
		close_parens
	);
}

sub more_matches {
	my($self,$next,$last,$mod) = @_;
	my $g = $self->{'global'};
	my @out;
	my $count = 0;
	my $filemod;
	my $id = $g->{session_id};
	$mod = defined $mod ? $mod : 1;
	$g->{search_mod} = $mod;
	$id = ref $id ? $$id : $id;
	$id .= ":$mod";
	
	my $file = $g->{save_dir} . '/' . $id if $g->{save_dir};

	if($file) {
		open(Search::Base::MORE, $file) or
			&{$g->{error_routine}}("couldn't open $file: $!\n");

		while (<Search::Base::MORE>) {
			next unless $count++ >= $next;
			next if ($count - 1) > $last;
			push(@out, $_);
		}
		close Search::Base::MORE;
	}
	elsif (ref $g->{save_hash}) {
		my $h = $g->{save_hash};
		return undef unless exists $h->{$id};
		$count = (@out = split /\n/, $h->{$id});
		@out = splice(@out,$next,$g->{match_limit});
	}
	else {
		$g->{matches} = -1;
		my $msg = <<EOF;
MISCONFIGURATION: No save method was specified to enable paging of
matches.  Please re-do the search with a tighter specification, and
contact the webmaster.
EOF
     &{$g->{error_routine}} ($g->{error_page}, $msg);
		return undef;
	}

	$g->{matches} = $count;
	$g->{first_match} = $next;
	if( $last >= ($g->{matches} - 1) ) {
		$g->{next_pointer} = 0;
	}
	else {
		$g->{next_pointer} = $last + 1;
	}
	@out;
}

sub saved_params {
	qw(
		next_pointer
		first_match
		matches
		save_dir
		session_id
		search_mod
	);
}

# Returns a string representation of an anonymous array, hash, or scaler
# that can be eval'ed to produce the same value.
# uneval([1, 2, 3, [4, 5]]) -> '[1,2,3,[4,5,],]'

sub uneval {
    my($o) = @_;        # recursive
    my($r, $s, $i, $key, $value);

    $r = ref $o;
    if (!$r) {
    $o =~ s/[\\"\$@]/\\$&/g;
    $s = '"' . $o . '"';
    } elsif ($r eq 'ARRAY') {
    $s = "[";
    foreach $i (0 .. $#$o) {
        $s .= uneval($o->[$i]) . ",";
    }
    $s .= "]";
    } elsif ($r eq 'HASH') {
    $s = "{";
    while (($key, $value) = each %$o) {
        $s .= "'$key' => " . uneval($value) . ",";
    }
    $s .= "}";
    } else {
    $s = "'something else'";
    }

    $s;
}

sub create_search_and {

	my ($case) = shift(@_) ? '' : 'i';
	my ($bound) = shift(@_) ? '' : '\b';
	die "create_search_and: create_search_and case_sens sub_match patterns" 
		unless @_;
	my $pat;

    my $code = <<EOCODE;
sub {
EOCODE

    $code .= <<EOCODE if @_ > 5;
    study;
EOCODE

    for $pat (@_) {
	$code .= <<EOCODE;
    return 0 unless /$bound$pat$bound/$case;
EOCODE
    } 

    $code .= "}\n";

    my $func = eval $code;
    die "bad pattern: $@" if $@;

    return $func;
} 

sub create_search_or {

	my ($case) = shift(@_) ? '' : 'i';
	my ($bound) = shift(@_) ? '' : '\b';
	die "create_search_or: create_search_or case_sens sub_match patterns" 
		unless @_;
	my $pat;

    my $code = <<EOCODE;
sub {
EOCODE

    $code .= <<EOCODE if @_ > 5;
    study;
EOCODE

    for $pat (@_) {
	$code .= <<EOCODE;
    return 1 if /$bound$pat$bound/$case;
EOCODE
    } 

    $code .= "}\n";

    my $func = eval $code;
    die "bad pattern: $@" if $@;

    return $func;
} 

1;

__END__
