#!/usr/bin/perl -w # Copyright (C) 2000,2001 Gecko. http://www.gecko.fr/ # Copyright (C) 1999,2000,2001 mnoGoSearch developers team # Copyright (C) 2004 Maxim Zakharov, Datapark corp. http://www.dataparksearch.org/ # You may distribute under the terms of either the GNU General Public # License or the Artistic License, as specified in the Perl README file. use strict; use vars qw( %templates %config %mt ); # with modperl, load template only once. use POSIX qw( strftime ); use Dataparksearch; $| = 1; print "Content-type: text/html\n\n"; my $tformat = '%a, %d %b %Y %H:%M:%S %Z'; my %params = (); my %data = (); # # EDIT ME # # templates basedir for template file and for "if(filename.htm)" clause my $basedir = '/usr/local/dpsearch/etc'; # template filename my $template = 'search.htm'; # remove useless spaces my $autocleanup = 0; # update title with DataparkSearch version my $updatetitle = 1; # maxrandom like MAXRANDOM from search.h my $maxrandom = 128; # default words highlight my $hlbeg = ''; my $hlend = ''; # # END OF EDIT ME # unless( -f "$basedir/$template" ){ print "Cant load template [$template]!\n"; exit;} # # local functions # # return template from name & number 'o' my $template_read = sub($$){ $templates{shift()}[shift()] || 'Error' }; # url encode my $encode = sub($){ my $str=shift || return ''; $str =~ s/(\W)/sprintf('%%%02x',ord($1))/ge; return $str; }; # return file contents & update $mt{filename} my $slurp = sub($) { my $f = $basedir.'/'.shift; open(F,$f) || return "Cant load file [$f]"; local $/=undef; my$r=; close F; $mt{$f}=(stat($f))[9]; return $r; }; # # loads cgi params # foreach my $token (split('&', $ENV{'QUERY_STRING'})){ my ($name,$value) = $token =~ /^(\w+)=(.*)$/; next unless $name; $value =~ s/\+/%20/g; $value =~ s/%([0-9A-Z][0-9A-Z])/$1 ne '00' ? pack('H2',$1) : ' '/gie; $params{$name} = $value || undef; } # # update %data # $data{'self'} = $ENV{'SCRIPT_NAME'}; $data{'Q'} = $params{'q'} || ''; $data{'q'} = $encode->($data{'Q'}); $data{'pn'} = $params{'pn'} || 0; $data{'ps'} = $params{'ps'} || 10; $data{'m'} = $params{'m'} || 'all'; $data{'o'} = $params{'o'} || 0; $data{'ul'} = $params{'ul'} || ''; $data{'wf'} = $params{'wf'} || ''; $data{'wm'} = $params{'wm'} || ''; # # (re)load templates. # if ( not defined %templates or not defined %config or not defined %mt or scalar(grep{exists $mt{$_} && $mt{$_}==(stat($_))[9] } keys %mt) != scalar(keys %mt) ){ # cleanup or define hashs %config = (); %templates = (); %mt = (); # load template my $html = $slurp->($template); # update if() clause $html =~ s/\$if\(([^\)]+)\)/$slurp->($1)/ge; # read config my ($config) = $html =~ //s; while ( $config =~ /^(\w+)\s+(.+)\s*$/mg){ push @{$config{$1}},$2 } # read templates foreach my $name ( keys %{{ map { $_ => 1 } $html =~ //g }} ) { @{$templates{$name}} = $html =~ /(.+?)/gs } # cleanup templates if ( $autocleanup ){ foreach my $name (keys %templates) { for(0..$#{$templates{$name}}) { $templates{$name}[0] =~ s/\s+/ /g } } } } # # the head. # my $head = $template_read->('top',0); # create randoms foreach my $random ( keys %{{ map { $_ => 1 } $head=~ /\$r(\d+)/g }}) {$data{"r$random"} = int(rand($config{"R$random"}[0] || $maxrandom))} # update selects foreach my $param ( qw( ps o m ul wm wf ) ) { $head =~ s// $data{$param} ne $1 ? "