view release on metacpan or  search on metacpan

site/apps/search/global.asa  view on Meta::CPAN

use lib qw(../../eg);

use File::stat;
use File::Basename;
use MLDBM::Sync;
use File::Find qw(find);
use DemoASP;
use Fcntl qw(O_RDWR O_CREAT);
use Cwd qw(cwd);

use vars qw(%CONF %SDB $title %TEMP_SDB);

sub Script_OnStart {
    %TEMP_SDB = ();
    for('DB', 'FileRoot', 'SiteRoot', 'RefreshPeriod', 'FileMatch') {
	$CONF{$_} = $Server->Config('Search'.$_) || die("no config for $_");
    }
    $CONF{FileRoot} =~ /\W/ or 
      die("The FileRoot config must have a non word character in it ".
	  "that matches \W, like '/', so a local dir may be specified ".
	  "with ./");
    if($CONF{FileRoot} !~ m,^(/|[a-z]:[\\/])$,) {
	$CONF{FileRoot} = cwd().'/'.$CONF{FileRoot};
    }
    $Response->Debug('Search %CONF', \%CONF);

    # only one person allowed to search at a time, this is
    # in case we ever have to update a stale database
    {
	local $MLDBM::UseDB = 'MLDBM::Sync::SDBM_File';
	my $sdb_object = tie(%SDB, 'MLDBM::Sync', $CONF{DB}, O_RDWR | O_CREAT, 0640)
	  || die("can't tie to $CONF{DB}: $!");
	$sdb_object->Lock;
	$Server->RegisterCleanup(sub { 
				     if(%TEMP_SDB) {
					 $Response->Debug("start saving TEMP_SDB to SDB");
					 %SDB = %TEMP_SDB;
					 $Response->Debug("done saving TEMP_SDB to SDB");
				     }
				     untie %SDB;
				     $sdb_object->UnLock;
				 });
    }
    &refresh_db(\%CONF);
}

sub search_words {
    my $input = shift;

    $input =~ s/(\,\s|[\s\{\}\(\)%:;=\$\"\'\/\#]+)/ /sg;
    my @words = split(/\s+/, $input);
    my @dropped;
    my @final;
    my %final;
    for(@words) {
	if(length($_) < 3) {
	    push(@dropped, $_);
	} else {
	    $_ = lc $_;
	    push(@final, $_);	
	    $final{$_}++;