view release on metacpan or  search on metacpan

cgi/search.cgi  view on Meta::CPAN

###

$q -> {context} = $cfg->str (qw/SearchContext/);

if ($q -> param_value ('matchcase') =~ /yes/) {
    $q -> {nmatchcase} = 1;
} else {
    $q -> {nmatchcase} = 0;
}

push @{$q->{searchtermlist}}, @searchwords;

my $OPENTAG = qr'^<file path="(.*?)">';

$server = \&s_write;

###
### Search function templates.
### Prototype:
### &{$q->{sfptr}} (actual_query_object, posting_reference);
### 
if ($q -> param_value ('matchtype') =~ /any/) {
    $q -> {sfptr} = sub { 
	my $q1 = shift;
	my $postbufref = shift;
	&$server ($q1 -> {ppid}, $$postbufref);
	return 1;
    };
} elsif ($q -> param_value ('matchtype') =~ /all/) {
    $q -> {sfptr} = sub { 
	my $q1 = shift;
	my $postbufref = shift;
	my $r;
	if ($r = collate ($q1, $$postbufref)) {
	    &$server ($q1 -> {ppid}, $$postbufref);
	}
	return $r;
    };
} elsif ($q -> param_value ('matchtype') =~ /exact/) {
    $q -> {sfptr} = sub {
	my $q1 = shift;
	my $postbufref = shift;
	my ($r, $r1);
	if ($r = collate ($q1, $$postbufref)) {
	    if ($r1 = text_string_search ($q1, $postbufref)) {
		&$server ($q1 -> {ppid}, $$postbufref);
	    }
	}
	return $r1;
    };
}

if ($cfg -> lst ('ExcludeDir')) {
    my @excdirs = $cfg -> lst ('ExcludeDir');
    push @{$q->{excludedirs}}, @excdirs; 
}

my @tlds;

my %volumes = $cfg -> Volumes ();
my $vol_prefs = 'Default';
if ($ENV{HTTP_COOKIE}) {
    @cookies = split /\;\s?/, $ENV{HTTP_COOKIE};
    ($val) = grep (/onsearchvols/, @cookies);
    if ($val) {
	($val) = $val =~ /.*?\=(.*)/ if $val;
	$vol_prefs = $cfg -> get_prefs ($val);
    }
    my @preflist = split /,/, $vol_prefs;
    foreach my $k (keys %volumes) {
	next unless scalar grep /$k/, @preflist;
	push @tlds, ($volumes{$k});
    }
} else {
    push @tlds, ($volumes{Default});
}

my $extcode_s;
if (($extcode_s = perform_search ($q, \@tlds)) == 0) { exit }

$ui -> {ext} = 0;
my $extcode_r;

if (($extcode_r = $ui -> OnSearch::Results::results ($$)) == 0) {
    exit;
}

sub perform_search {
    my $q = $_[0];
    my $tldref = $_[1];

    ### Must be called after read_config.
    save_sid ($q->{ppid});

    ###
    ### $extpid == 0 if search is completed.
    ###
    my $extpid = $q -> OnSearch::Search::search ($tldref);
    # Returning from the child process, so we go.
    if ($q -> {sid}) { return 0 }

    return $extpid;
}