view release on metacpan or  search on metacpan

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

}

sub str_in_list {
    my $s = shift;
    my $listref = shift;
    my $match_case = shift;

    $s = lc $s unless $match_case;
    foreach my $l (@{$listref}) { 
	$l = lc $l unless $match_case; 
	return 1 if $l eq $s; 
    }
    return undef;
}

sub valid_lock {
    my $lockfn = shift;

    my ($l, $r, $lockfh);

    return undef unless (-f $lockfn);
    local $!;
    ###
    ### Suppress warnings about opening standard I/O channels
    ###
    no warnings;
    open $lockfh, "$lockfn" or warn "valid_lock $lockfn: $!";
    use warnings;
    while (defined ($l = <$lockfh>)) {
	chomp $l;
	$r = kill 0, $l;
	if (!$r) {
	    OnSearch::WebLog::clf ('notice', 
                "Removing stale lock $lockfn ID $l");
	      unlink $l;
	}
    }
    close ($lockfh);
    return $r;
}

sub basename {
    my $pathname = shift;

    my $basename;

    if ($pathname =~ /\\/) {
	$basename = substr ($pathname, rindex ($pathname, '\\') + 1);
    } elsif ($pathname =~ /\//) {
	$basename = substr ($pathname, rindex ($pathname, '/') + 1);
    } else {
	$basename = $pathname;
    }
    
    return $basename
}

sub sigwrapper {
    my ($signame, $sigsub, $wrapsub, @args) = @_;
    
    my $oldsig = $SIG{$signame} if $SIG{$signame}; 
    $SIG{$signame} = ($sigsub ? $sigsub : 'IGNORE');
    &$wrapsub (@args);
    $SIG{$signame} = $oldsig if $oldsig;
}

###
### TO DO - this so far is the most reliable way to index
### immediately.  Try to clean up this implementation.
###
sub run_onindex {
    my $txt = `/usr/local/etc/init.d/onindex index`;
    OnSearch::WebLog::clf ('notice', "Onindex: $txt");
}

sub signumber {
    my $signame = $_[0];
    my (%sigs, $number, $name);
    $number = 0;
    foreach $name (split (' ', $Config{sig_name})) {
	$sigs{$name} = $number++;
    }
    return $sigs{$signame};
}

sub client_write {
    my $session_id = shift;
    my $buf = shift;
    my ($name, $clientfh, $serverfh);
    $name = '/tmp/.onsearch.sock.' . $session_id;
    socket ($serverfh, PF_UNIX, SOCK_STREAM, 0) || 
	die "OnSearch: client_write socket: $!";
    if (-S $name && ! unlink ($name)) {	
	&$logfunc ('error', "client_write unlink: $!\n"); 
      }
    bind ($serverfh, sockaddr_un($name)) || 
	warn ("client_write bind: $!."); 
    listen ($serverfh, SOMAXCONN) || 
	warn ("client_write listen: $!."); 
    accept ($clientfh, $serverfh) ||
	warn ("client_write $$ accept: $!."); 
    if (fileno ($clientfh)) {
	syswrite ($clientfh, $buf);
	close $clientfh;
	close $serverfh;
    }
    return;
}

1;