# -*- perl -*-
#
#   HTML::EP::Glimpse - A simple search engine using Glimpse
#
#
#   Copyright (C) 1998    Jochen Wiedmann
#                         Am Eisteich 9
#                         72555 Metzingen
#                         Germany
#
#                         Phone: +49 7123 14887
#                         Email: joe@ispsoft.de
#
#   All rights reserved.
#
#   You may distribute this module under the terms of either
#   the GNU General Public License or the Artistic License, as
#   specified in the Perl README file.
#
############################################################################

require 5.005;
use strict;

use HTML::EP ();
use HTML::EP::Locale ();
use HTML::EP::Glimpse::Config ();

package HTML::EP::Glimpse;

$HTML::EP::Glimpse::VERSION = '0.03';
@HTML::EP::Glimpse::ISA = qw(HTML::EP::Locale HTML::EP);


sub _prefs {
    my $self = shift; my $attr = shift; my $prefs = shift;
    $self->{'glimpse_config'} ||= $HTML::EP::Glimpse::Config::config;
    my $config = $self->{'glimpse_config'};
    my $vardir = $config->{'vardir'};
    die "A directory $vardir does not exist. Please create it, with write "
        . " permissions for the web server, or modify the value of "
        . " vardir in $INC{'HTML/EP/Glimpse/Config.pm'}."
            unless -d $vardir;
    my $prefs_file = "$vardir/prefs";
    if (!$prefs) {
        # Load Prefs
	require Safe;
	my $cpt = Safe->new();
        $prefs = $self->{'prefs'} = $cpt->rdo($prefs_file) || {};

        $prefs->{'rootdir'} = $ENV{'DOCUMENT_ROOT'}
            unless exists($prefs->{'rootdir'});
        $prefs->{'dirs'} = "/"
            unless exists($prefs->{'dirs'});
        $prefs->{'dirs_ignored'} =
            (($ENV{'PATH_INFO'} =~ /(.*)\//) ? $1 : "")
                unless exists($prefs->{'dirs_ignored'});
        $prefs->{'suffix'} = ".html .htm"
            unless exists($prefs->{'suffix'});
    } else {
        # Save Prefs
        require Data::Dumper;
        my $d = Data::Dumper->new([$prefs])->Indent(1)->Terse(1)->Dump();
        require Symbol;
        my $fh = Symbol::gensym();
        if ($self->{'debug'}) {
            print "Saving Preferences to $prefs_file.\n";
            $self->print("Saving data:\n$d\n");
        }
        die "Could not save data into $prefs_file: $!. Please verify whether"
            . " the web server has write permissions in $vardir and on"
            . " $prefs_file."
                unless open($fh, ">$prefs_file")  and  (print $fh "$d\n")
                    and close($fh);
    }
    $self->{'glimpse_prefs'} = $prefs;
}


sub _ep_glimpse_load {
    my $self = shift; my $attr = shift;
    my $cgi = $self->{'cgi'};
    my $prefs = $self->_prefs($attr);

    if ($cgi->param('modify')) {
        my $modified = 0;
        foreach my $p ($cgi->param()) {
            if ($p =~ /^glimpse_prefs_(.*)/) {
                my $sp = $1;
                my $old = $prefs->{$sp};
                my $new = $cgi->param($p);
                if (!defined($old)) {
                    if (defined($new)) {
                        $modified = 1;
                        $prefs->{$sp} = $new;
                    }
                } elsif (!defined($new)) {
                    $modified = 1;
                    $prefs->{$sp} = $new;
                } else {
                    $modified = ($new ne $old);
                    $prefs->{$sp} = $new;
                }
            }
        }
        if ($self->{'debug'}) {
            $self->print("Modifications detected.\n");
        }
        $self->_prefs($attr, $prefs);
    }
    '';
}


sub _ep_glimpse_create {
    my $self = shift; my $attr = shift;
    my $prefs = $self->_prefs($attr);
    my $vardir = $self->{'glimpse_config'}->{'vardir'};
    my $debug = $self->{'debug'};
    my $cfg = $self->{'glimpse_config'};

    my $rootdir = $prefs->{'rootdir'};
    my $dirlist = $prefs->{'dirs'};
    $dirlist =~ s/\s+/ /sg;
    $dirlist =~ s/^\s+//;
    $dirlist =~ s/\s+$//;
    my @dirs = map { "$rootdir/$_" } split(/ /, $dirlist);
    $dirlist = $prefs->{'dirs_ignored'};
    $dirlist =~ s/\s+/ /sg;
    $dirlist =~ s/^\s+//;
    $dirlist =~ s/\s+$//;
    my @dirs_ignored = map { "$rootdir/$_" } split(/ /, $dirlist);

    my $matchesDirsIgnored;
    if (@dirs_ignored) {
        my $dirsIgnoredRe = join("|", map { "\\Q$_\\E" } @dirs_ignored);
        my $func = "sub { shift() =~ m[^(?:$dirsIgnoredRe)] }";
        $matchesDirsIgnored = eval $func;
        $self->print("Making function for directory match: $func",
                     " ($matchesDirsIgnored))\n") if $debug;
    } else {
        $matchesDirsIgnored = sub { 0 }
    }
    my $suffixList = $prefs->{'suffix'};
    $suffixList =~ s/\s+/ /sg;
    $suffixList =~ s/^\s+//;
    $suffixList =~ s/\s+$//;
    my @suffix = split(/ /, $suffixList);
    my $matchesSuffix;
    if (@suffix) {
        my $suffixRe = join("|", map { "\\Q$_\\E" } @suffix);
        my $func = "sub { shift() =~ m[(?:$suffixRe)\$] }";
        $matchesSuffix = eval $func;
        $self->print("Making function for suffix match: $func",
                     "($matchesSuffix)\n") if $debug;
    } else {
        $matchesSuffix = sub { 1 }
    }

    my $fileList = '';
    require File::Find;
    File::Find::find
        (sub {
             if (&$matchesDirsIgnored($File::Find::dir)) {
                 $self->print("Skipping directory $File::Find::dir.\n")
                     if $debug;
                 $File::Find::prune = 1;
             } else {
                 my $f = $File::Find::name;
                 my $ok = ((-f $f)  and  &$matchesSuffix($f));
                 $self->print("    $f: $ok\n") if $debug;
                 $fileList .= "$f\n" if $ok;
             }
         }, @dirs);

    die "No files found" unless $fileList;

    my $fh = Symbol::gensym();
    my $cmd = "$cfg->{'glimpseindex_path'} -b -F -H $vardir -X";
    $self->print("Creating pipe to command $cmd\n") if $debug;
    die "Error while creating index: $!"
        unless (open($fh, "| $cmd >$vardir/.glimpse_output 2>&1")  and
                (print $fh $fileList)  and  close($fh));

    $fileList;
}


sub _ep_glimpse_matchline {
    my $self = shift; my $attr = shift;
    my $template = defined($attr->{'template'}) ?
        $attr->{'template'} : return undef;
    $self->print("Setting matchline template to $template\n")
        if $self->{'debug'};
    $self->{'line_template'} = $template;
    '';
}

sub _format_MATCHLINE {
    my $self = shift; my $f = shift;
    my $debug = $self->{'debug'};
    my $template = $self->{'line_template'};
    my $lines = $f->{'lines'};
    $self->print("MATCHLINE: f = $f, lines = $lines (", @$lines, ")\n",
                 "line_template = $template\n") if $debug;
    my $output = $self->_ep_list({'items' => $lines,
                                  'item' => 'l',
                                  'template' => $template});
    $self->print("output = ", (defined($output) ? $output : "undef"), "\n")
        if $debug;
    $output;
}

sub _ep_glimpse_search {
    my $self = shift; my $attr = shift;
    my $prefs = $self->_prefs($attr);
    my $vardir = $self->{'glimpse_config'}->{'vardir'};
    my $cgi = $self->{'cgi'};
    my $debug = $self->{'debug'};
    my $start = ($cgi->param('start')  or  0);
    my $max = ($cgi->param('max')  or  $attr->{'max'}  or  20);
    my @opts = ($prefs->{'glimpse_path'}, '-UOnbqy', '-L',
                "0:" . ($start+$max), '-H', $vardir);
    my $case_sensitive = $cgi->param('opt_case_sensitive') ? 1 : 0;
    push(@opts, '-i') unless $case_sensitive;
    my $word_boundary = $cgi->param('word_boundary') ? 1 : 0;
    push(@opts, '-w') if $word_boundary;
    my $whole_file = $cgi->param('opt_whole_file') ? 1 : 0;
    push(@opts, '-W') unless $whole_file;
    my $opt_regex = $cgi->param('opt_regex') ? 1 : 0;
    push(@opts, $opt_regex ? '-e' : '-k');
    my $opt_or = $cgi->param('opt_or') ? 1 : 0;

    # Now for the hard part: Split the search string into words
    my $search = $cgi->param('search');
    $self->{'link_opts'} = $self->{'env'}->{'PATH_INFO'} . "?"
        . join("&", "search=" . CGI->escape($search),
               "max=$max", "opt_case_sensitive=$case_sensitive",
               "word_boundary=$word_boundary", "opt_whole_file=$whole_file",
               "opt_regex=$opt_regex", "opt_or=$opt_or");
    my @words;
    while (length($search)) {
        $search =~ s/^\s+//s;
        if ($search =~ /^"/s) {
            if ($search =~ /"(.*?)"\s+(.*)/s) {
                push(@words, $1);
                $search = $2;
            } else {
                $search =~ s/^"//s;
                $search =~ s/"$//s;
                push(@words, $search);
                last;
            }
        } else {
            $search =~ s/^(\S+)//s;
            push(@words, $1) if $1;
        }
    }
    if (!@words) {
        my $language = $self->{'_ep_language'};
        my $msg;
        if ($language eq 'de') {
            $msg = "Keine Suchbegriffe gefunden";
        } else {
            $msg = "No search strings found";
        }
        $self->_ep_error({'type' => 'user', 'msg' => $msg});
    }
    my $sep = $opt_or ? ';' : ',';

    push(@opts, join($sep, @words));

    # First try using fork() and system() for security reasons.
    my $ok;
    my $tmpnam;
    my $fh = eval {
        my $infh = Symbol::gensym();
        my $outfh = Symbol::gensym();
        pipe ($infh, $outfh) or die "Failed to create pipe: $!";
        my $pid = fork();
        die "Failed to fork: $!" unless defined($pid);
        if (!$pid) {
            # This is the child
            close $infh;
            open(STDOUT, ">&=" . fileno($outfh))
                or die "Failed to reopen STDOUT: $!";
            exec @opts;
            exit 0;
        }
        close $outfh;
        $self->printf("Forked command %s\n", join(" ", @opts)) if $debug;
        $infh;
    } || eval {
        # Rats, doesn't work. :-( Run glimpse by storing the output in
        # a file and read from that file. We need to be aware of shell
        # metacharacters and the like.
        require POSIX;
        $tmpnam = "$vardir/" . POSIX::tmpnam();
        my $command = join(" ", map{ quotemeta $_ } @opts). " >$tmpnam";
        $self->print("Running command $command\n") if $debug;
        system $command or die "system() failed: $!";
        my $infh = Symbol::gensym();
        open($infh, "<$tmpnam")
            or die "Failed to open $tmpnam: $!";
        $infh;
    };
    $self->print("fh = $fh\n") if $debug;
    eval {
        my $blank_seen;
        my (@files, @lines, $file, $title, $lineNum, $byteOffset, $offsetStart,
            $offsetEnd);
        my $fileNum = $start;
        my $ignoreFiles = $start;
        while (defined(my $line = <$fh>)) {
            #$self->print("Glimpse output: $line") if $debug;
            if ($line =~ /^\s*$/) {
                $blank_seen = 1;
                if ($file) {
                    if ($ignoreFiles) {
                        --$ignoreFiles
                    } else {
                        push(@files, {'file' => $file,
                                      'fileNum' => ++$fileNum,
                                      'title' => $title,
                                      'lines' => [@lines]})
                    }
                }
                undef $file;
                undef $lineNum;
                @lines = ();
                #$self->print("Blank line detected\n") if $debug;
            } elsif ($blank_seen) {
                $blank_seen = 0;
                if ($line =~ /^(\S+)\s+(\S.*?)\s+$/) {
                    $file = $1;
                    $title = $2;
                    #$self->print("New file detected: $file, $title\n")
                    #    if $debug;
                } elsif ($line =~ /^(\S+)\:\s*$/) {
                    $file = $title = $1;
                } else {
                    $self->print("Cannot parse file line: $line") if $debug;
                }
            } elsif ($file) {
                if ($lineNum) {
                    push(@lines, {'line' => $line,
                                  'lineNum' => $lineNum,
                                  'byteOffset' => $byteOffset,
                                  'offsetStart' => $offsetStart,
                                  'offsetEnd' => $offsetEnd});
                    #$self->print("Match line detected: $lineNum, $line\n")
                    #    if $debug;
                    undef $lineNum;
                } elsif ($line =~ /^(\d+)\:\s+(\d+)\=\s+\@(\d+)\{(\d+)\}/) {
                    $lineNum = $1;
                    $byteOffset = $2;
                    $offsetStart = $3;
                    $offsetEnd = $4;
                } else {
                    $self->print("Cannot parse line: $line\n") if $debug;
                }
            } else {
                $self->print("Unexpected line: $line\n") if $debug;
            }
        }
        if ($file) {
            if ($ignoreFiles) {
                --$ignoreFiles
            } else {
                push(@files, {'file' => $file,
                              'fileNum' => ++$fileNum,
                              'title' => $title,
                              'lines' => [@lines]})
            }
        }
        $self->print("Found " . scalar(@files) . " files\n") if $debug;
        foreach my $file (@files) {
            my $url = $file->{'file'};
            $url =~ s/^\Q$prefs->{'rootdir'}\E//;
            $url =~ s/^\/+/\//;
            $file->{'url'} = $url;
        }
        $self->{'files'} = \@files;
        if (@files == $max) {
            $self->{'next'} = $start + $max;
        }
        $self->{'prev'} = $start ? $start - $max : -1;
    } unless $@;
    close $fh if $fh;
    undef $fh;
    unlink $tmpnam if $tmpnam;
    '';
}


1;


__END__

=pod

=head1 NAME

HTML::EP::Glimpse - A simple search engine using Glimpse


=head1 SYNOPSIS

  <!-- Put the following in your EP page: -->
  <!-- Load the Glimpse package: -->
  <ep-package name="HTML::EP::Glimpse">
  <!-- Run glimpse: -->
  <ep-glimpse-search>
  <!-- List the hits: -->
    <ep-list items=files item=f>
      <tr><td><a href="$f->url$">$f->title$</a></td>
    </ep-list>


=head1 DESCRIPTION

This is a simple search engine I wrote for the movie pages of a friend,
Anne Haasis.

It is based on HTML::EP, my embedded Perl system and Glimpse, the well
known indexing system, as a backend.


=head1 INSTALLATION

First of all, you have to install the latest version of HTML::EP, 0.20
or later, and it's prerequisites. Next you have to install this package,
HTML::EP::Glimpse. If you don't know how to install Perl packages, it's
fairly simple: Fetch the required archives from any CPAN mirror, for
example

  ftp://ftp.funet.fi/pub/languages/perl/CPAN/modules/by-module/HTML

and then do, for example

  gzip -cd HTML-EP-0.20.tar.gz | tar xf -
  perl Makefile.PL
  make
  make test
  make install

It's even more simple, if you have the CPAN module available:

  perl -MCPAN -e shell
  install HTML::EP
  install HTML::EP::Glimpse

While running B<perl Makefile.PL> in the HTML::EP::Glimpse directory,
you'll be prompted some questions. These are explained in the
CONFIGURATION section below. See L<CONFIGURATION>.

Your web server must be ready for serving EP pages. See the HTML::EP
docs for details of the web server configuration. L<HTML::EP(3)>.


=head1 CONFIGURATION

The module is configured at installation time when running B<perl
Makefile.PL>. However, you can repeat the configuration at any
later time by running B<perl -MHTML::EP::Glimpse::Install -e Config>.

Configuration will create a module I<HTML::EP::Glimpse::Config>, which
holds a single hash ref with the following keys:

=over

=item install_html_files

A TRUE (yes) value means, that the HTML examples will be copied to
your web servers document root. This is recommended, unless you have
an existing installation with own modifications in the HTML files.
Of course you wouln't want to overwrite your own files.

=item html_base_dir

Base directory, where you put your HTML files to. The default is
F</home/httpd/html/Glimpse>, which is fine on a Red Hat Linux box.

=item vardir

A directory, where the web server is allowed to create files, in
particular your preferences and the Glimpse index. By default the
subdirectory F<admin/var> of the base directory is choosen.

=item httpd_user

The UID under which your web server is running CGI binaries. The
vardir must have read, execute and write permissions for this user.
The default is I<nobody>, which is fine on a Red Hat Linux box
again.

=item glimpse_path

=item glimpseindex_path

Path of the I<glimpse> and I<glimpseindex> binaries.

=back


=head2 The Preferences

All other settings are fixed via the Web browser. Assuming your base directory
is accessible via

  http://localhost/Glimpse/

point your browser to

  http://localhost/Glimpse/admin/index.ep

and enter the preferences page. The following items must be entered here:

=over

=item Web servers root directory

This is your web servers home directory, for example

  /home/httpd/html

on a Red Hat Linux box.

=item Directories being indexed

Usually you just put the value F</> here, because you want your whole
web server being indexed. However, if you want restrict the index to
some directories, enter them here. For example, if you have a manual
in F</manual> and want to index the manual directory only, then enter

  /manual

The directory names are relative to the servers root directory.

=item Directories being excluded

If you don't want your whole directory tree being indexed, you can
also exclude some directories. For example, there's not much sense
in indexing the Glimpse directory, so I usually enter

  /Glimpse

here.

=item Suffixes of files being indexed

Of course you don't want all files being indexed. For example, there's not
much sense in indexing GIF's or JPEG's. By default only files with the
extensions I<.htm> and I<.html> are indexed. If you want your EP files
being indexed as well, add a I<.ep>. Likewise you might want to add
I<.php> for PHP3 files or I<.txt> for text files.

=back


=head2 Running glimpseindex

As soon as you modified your preferences, you should create an index.
This is done by returning to the admin menu and calling the index
page.

The same procedure should be repeated each time you modify your HTML
files. If this is happening frequently, you might prefer using a cron
job, for example

  su - nobody -c "/usr/bin/glimpseindex -b -H $vardir -X"

with B<$vardir> being the vardir from above. Note that your job shouln't
run as root, unless you want to disable a manual recreation via the
web browser.


=head2 Configuring for multiple virtual servers or multiple directories

So far configuration is fine, but can you use multiple instances of
HTML::EP::Glimpse on one machine? Of course you can!

It is quite simple: Just copy the base directory to another location.
Then create a subdirectory F<admin/lib/HTML/EP/Glimpse> of the new
base directory. Create a new configuration by running

  cd $basedir/admin/lib/HTML/EP/Glimpse
  perl -MHTML::EP::Glimpse::Install -e Config Config.pm

That's it!


=head1 AUTHOR AND COPYRIGHT

This module is

    Copyright (C) 1998-1999	Jochen Wiedmann
                          	Am Eisteich 9
                          	72555 Metzingen
                          	Germany

                          	Phone: +49 7123 14887
                          	Email: joe@ispsoft.de

All rights reserved.

You may distribute this module under the terms of either
the GNU General Public License or the Artistic License, as
specified in the Perl README file.


=head1 SEE ALSO

L<DBI(3)>, L<CGI(3)>, L<HTML::Parser(3)>

=cut
