view release on metacpan or  search on metacpan

lib/OnSearch/Results.pm  view on Meta::CPAN

	    ### Return from the grandchild process with exit code
            ### so the calling script can exit.
	    return 0;
	} elsif ($! =~ /No more processes|Resource temporarily unavailable/) {
	    &$logfunc ('warning', "Results () unable to fork: $! PID $$.");
	    sleep 2;
	    redo FORK2;
	} else {
	    die "results () error PID $chldpid: $!";
	}
    } elsif ($! =~ /No more processes|Resource temporarily unavailable/) {
	&$logfunc ('warning', "Results () unable to fork: $! PID $$.");
	sleep 2;
	redo FORK;
    } else {
	die "results () error PID $chldpid: $!";
    }

    ### Return code from child process so the calling script can
    ### exit.
    return 0;
}

###
### In order to hold connection with the client open during long 
### searches, collect_results () sends a space character to the 
### client periodically.  Collect_results () sets SIGALRM to expire 
### after 30 seconds, then client_ping () sends a space character
### and resets the SIGALRM handler.  The collector stops holding 
### the connection open (by setting SIGALRM to 0) after it displays 
### the first page of results.
###
sub client_ping {
    my $u = OnSearch::UI->new;
    $u -> {text} = ' ';
    $u -> wprint;
    undef $u;  # Quicker than garbage collection.
    alarm 30;
    $SIG{ALRM} = \&client_ping;
}

my $searchstr = \&OnSearch::StringSearch::_strindex;

###
### Collect_results () displays only the first $PageSize of
### matched documents but reads data sent by Search.pm until 
### it receives a </results> tag.  
###
sub collect_results {
    my $ui_obj = shift;
    my $ppid = $_[0];
    my $resultspid = $_[1];


    my ($l, $rec, $r, $q, $buf, @lines, $linebuf);
    $q = $ui_obj -> {q};
    $ui_obj -> {firstpagedisplayed} = 0;

    # Expire cookie in a year.
    my $yearexpdate = OnSearch::Utils::http_date (31536000);
    $ui_obj -> header_cookie ('OnSearch', 'onsearchprefs', 
			  OnSearch::AppConfig->prefs_val ($ui_obj -> {q}),
			  $yearexpdate) 
	-> wprint;

    local $SIG{ALRM} = \&client_ping;
    alarm 30;

    ###
    ### Try to save the results before exiting if the Web server sends 
    ### a SIGINT.
    ###
    local $SIG{INT} = sub {
	if (! ($r = store_result ($ui_obj))) {
	    warn ('error', 
		  "collect_results: SIGINT. Couldn't save session $ppid: $!");
	}
	exit 1;
    };

    ###
    ### The comments in results.cgi describe the result queue 
    ### indexes.
    ###
    $ui_obj -> {head} = 0;
    $ui_obj -> {pagenth} = 0;
    $ui_obj -> {pageno} = 1;
    display_header ($ui_obj);

    while (1) {
	$linebuf = _receive ($ppid);
	next unless $linebuf && length ($linebuf);

	if (defined (&$searchstr ('</results>', $linebuf))) {
	    $ui_obj -> {completed} = 1;
	    $r = store_result ($ui_obj);
	    return 0;
	}

	@lines = split /\n/, $linebuf;

####
#### FIXME - This should not occur.
####
	next if $#lines <= 1;  # Empty record.

	###
	### Create a new array for each record.
	###
	$rec = _new_array_ref ();
	push @{$rec}, @lines;

	push @{$ui_obj -> {r}}, ($rec);

	###
	### Note here if the first page has been 
	### displayed. This saves a lot of effort when 
	### trying to display pages from results.cgi.
	###
	unless ($ui_obj -> {firstpagedisplayed}) {
	    display_result ($ui_obj);
	    $ui_obj -> {head} += 1;