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

HTML-EP-Glimpse documentation Contained in the HTML-EP-Glimpse distribution.

Index

Code Index:

NAME

Top

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

SYNOPSIS

Top

  <!-- 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>

DESCRIPTION

Top

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.

INSTALLATION

Top

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 perl Makefile.PL in the HTML::EP::Glimpse directory, you'll be prompted some questions. These are explained in the CONFIGURATION section below. See CONFIGURATION.

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

CONFIGURATION

Top

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

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

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.

html_base_dir

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

vardir

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

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 nobody, which is fine on a Red Hat Linux box again.

glimpse_path
glimpseindex_path

Path of the glimpse and glimpseindex binaries.

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:

Web servers root directory

This is your web servers home directory, for example

  /home/httpd/html

on a Red Hat Linux box.

Directories being indexed

Usually you just put the value / 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 /manual and want to index the manual directory only, then enter

  /manual

The directory names are relative to the servers root directory.

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.

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 .htm and .html are indexed. If you want your EP files being indexed as well, add a .ep. Likewise you might want to add .php for PHP3 files or .txt for text files.

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 $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.

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 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!

AUTHOR AND COPYRIGHT

Top

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.

SEE ALSO

Top

DBI(3), CGI(3), HTML::Parser(3)

HTML-EP-Glimpse documentation Contained in the HTML-EP-Glimpse distribution. 
# -*- 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.05';
@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 = ($self->{'glimpse_config'}->{'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__