CPAN-WAIT
view release on metacpan or search on metacpan
lib/WAIT/Client.pm view on Meta::CPAN
@_ == 2 or croak 'usage: $wait->info( HIT-NUMBER )';
my $wait = shift;
$wait->_GET(@_)
? $wait->read_until_dot()
: undef;
}
sub database
{
@_ == 2 or croak 'usage: $wait->database( DBNAME )';
my $wait = shift;
$wait->_DATABASE(@_);
}
sub table
{
@_ == 2 or croak 'usage: $wait->table( TABLE )';
my $wait = shift;
$wait->_TABLE(@_);
}
sub hits
{
@_ == 2 or croak 'usage: $wait->hits( NUM-MAX-HITS )';
my $wait = shift;
$wait->_HITS(@_);
}
sub _SEARCH { shift->command('SEARCH', @_)->response == CMD_OK }
sub _INFO { shift->command('INFO', @_)->response == CMD_OK }
sub _GET { shift->command('GET', @_)->response == CMD_OK }
sub _DATABASE { shift->command('DATABASE', @_)->response == CMD_OK }
sub _TABLE { shift->command('TABLE', @_)->response == CMD_OK }
sub _HITS { shift->command('HITS', @_)->response == CMD_OK }
# The following is a real hack. Don't look at it ;-) It tries to
# emulate a stateful protocol over HTTP which is weird and slow.
package WAIT::Client::HTTP;
use Net::Cmd;
use vars qw(@ISA);
use Carp;
@ISA = qw(WAIT::Client);
sub new {
my $type = shift;
my $host = shift;
my %parm = @_;
my ($proxy, $port) = ($parm{Proxy} =~ m{^(?:http://)(\S+)(?::(\d+))});
$port = 80 unless $port;
my $self = {
proxy_host => $proxy,
proxy_port => $port,
wais_host => $host,
wais_port => $parm{Port},
timeout => $parm{Timeout}||120,
};
bless $self, $type;
my $con;
if ($con = $self->command('HELP') and $con->response == CMD_INFO) {
return $self;
} else {
return;
}
}
sub command {
my $self = shift;
my $con = # Constructor inherited from IO::Socket::INET
WAIT::Client::HTTP::Handle->new
(
PeerAddr => $self->{proxy_host},
PeerPort => $self->{proxy_port},
Proto => 'tcp',
);
return unless $con;
$con->timeout($self->{timeout}) if defined $self->{timeout};
my $cmd = join ' ', @_;
if ($self->{hits}) {
$cmd = "HITS $self->{hits}:$cmd";
}
$cmd = "Command: $cmd";
$con->autoflush(1);
$con->printf("POST http://$self->{wais_host}:$self->{wais_port} ".
"HTTP/1.0\nContent-Length: %d\n\n$cmd",
length($cmd));
unless ($con->response == CMD_OK) {
warn "No greeting from server\n";
}
if ($self->{hits}) {
unless ($con->response == CMD_OK) {
warn "Hits not aknowledged\n";
}
}
$self->{con} = $con;
$con;
}
# We map here raw document id's to rank numbers and back for
# convenience. Besides that the following search(), info(), and get()
# are obsolete.
sub search
{
my $wait = shift;
if ($wait->_SEARCH(@_)) {
my $r = $wait->read_until_dot();
my $i = 1;
delete $wait->{'map'};
( run in 0.484 second using v1.01-cache-2.11-cpan-5a3173703d6 )