lib/WAIT/Client.pm

#                              -*- Mode: Cperl -*- 
# Client.pm --
# ITIID           : $ITI$ $Header $__Header$
# Author          : Ulrich Pfeifer
# Created On      : Fri Jan 31 10:49:37 1997
# Last Modified By: Ulrich Pfeifer
# Last Modified On: Tue Feb 11 15:32:14 1997
# Language        : CPerl
# Update Count    : 85
# Status          : Unknown, Use with caution!
#
# (C) Copyright 1997, Universität Dortmund, all rights reserved.
#

package WAIT::Client;
use Net::NNTP ();
use Net::Cmd qw(CMD_OK);
use Carp;
use strict;
use vars qw(@ISA);

@ISA = qw(Net::NNTP);

sub search
{
  my $wait = shift;

  $wait->_SEARCH(@_)
    ? $wait->read_until_dot()
      : undef;
}

sub info
{
  @_ == 2 or croak 'usage: $wait->info( HIT-NUMBER )';
  my $wait = shift;

  $wait->_INFO(@_)
    ? $wait->read_until_dot()
      : undef;
}

sub get
{
  @_ == 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},
             };
  bless $self, $type;

  if ($self->command('HELP')->response == CMD_INFO) {
    return $self;
  } else {
    return;
  }
}

sub command {
  my $self = shift;
  my $con  =
    WAIT::Client::HTTP::Handle->new
      (
       PeerAddr => $self->{proxy_host},
       PeerPort => $self->{proxy_port},
       Proto    => 'tcp',
      );
  return unless $con;
  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'};
    for (@$r) {
      if (s/^(\d+)/sprintf("%4d",$i)/e) {
        $wait->{'map'}->[$i++] = $1;
      } 
    }
    return $r;
  }
  return undef;
}

sub info
{
  @_ == 2 or croak 'usage: $wait->info( HIT-NUMBER )';
  my $wait = shift;
  my $num  = shift;

  unless ($wait->{'map'}->[$num]) {
    print "No such hit: $num\n";
    return;
  }
  $wait->_INFO($wait->{'map'}->[$num])
    ? $wait->read_until_dot()
      : undef;
}

sub get
{
  @_ == 2 or croak 'usage: $wait->info( HIT-NUMBER )';
  my $wait = shift;
  my $num  = shift;

  unless ($wait->{'map'}->[$num]) {
    print "No such hit: $num\n";
    return;
  }
  $wait->_GET($wait->{'map'}->[$num])
    ? $wait->read_until_dot()
      : undef;
}

# We must store the hit count locally
sub _HITS {
  my $self = shift;
  my $hits = shift;

  $self->{hits} = $hits;
  ["Setting maximum hit count to $hits"];
}

# We should use AUTOLOAD here. I know ;-)
sub read_until_dot {shift->{con}->read_until_dot(@_)}
sub message        {shift->{con}->message(@_)}

package WAIT::Client::HTTP::Handle;
use vars qw(@ISA);

@ISA = qw(Net::Cmd IO::Socket::INET);


1;
1	ulpfr	13	# -- Mode: Cperl --
2			# Client.pm --
3	ulpfr	10	# ITIID : $ITI$ $Header $__Header$
4			# Author : Ulrich Pfeifer
5			# Created On : Fri Jan 31 10:49:37 1997
6			# Last Modified By: Ulrich Pfeifer
7			# Last Modified On: Tue Feb 11 15:32:14 1997
8			# Language : CPerl
9			# Update Count : 85
10			# Status : Unknown, Use with caution!
11	ulpfr	13	#
12	ulpfr	10	# (C) Copyright 1997, Universität Dortmund, all rights reserved.
13	ulpfr	13	#
14	ulpfr	10
15			package WAIT::Client;
16			use Net::NNTP ();
17			use Net::Cmd qw(CMD_OK);
18			use Carp;
19			use strict;
20			use vars qw(@ISA);
21
22			@ISA = qw(Net::NNTP);
23
24			sub search
25			{
26			my $wait = shift;
27	ulpfr	13
28	ulpfr	10	$wait->_SEARCH(@_)
29			? $wait->read_until_dot()
30			: undef;
31			}
32
33			sub info
34			{
35			@_ == 2 or croak 'usage: $wait->info( HIT-NUMBER )';
36			my $wait = shift;
37	ulpfr	13
38	ulpfr	10	$wait->_INFO(@_)
39			? $wait->read_until_dot()
40			: undef;
41			}
42
43			sub get
44			{
45			@_ == 2 or croak 'usage: $wait->info( HIT-NUMBER )';
46			my $wait = shift;
47	ulpfr	13
48	ulpfr	10	$wait->_GET(@_)
49			? $wait->read_until_dot()
50			: undef;
51			}
52
53			sub database
54			{
55			@_ == 2 or croak 'usage: $wait->database( DBNAME )';
56			my $wait = shift;
57	ulpfr	13
58	ulpfr	10	$wait->_DATABASE(@_);
59			}
60
61			sub table
62			{
63			@_ == 2 or croak 'usage: $wait->table( TABLE )';
64			my $wait = shift;
65	ulpfr	13
66	ulpfr	10	$wait->_TABLE(@_);
67			}
68
69			sub hits
70			{
71			@_ == 2 or croak 'usage: $wait->hits( NUM-MAX-HITS )';
72			my $wait = shift;
73	ulpfr	13
74	ulpfr	10	$wait->_HITS(@_);
75			}
76
77			sub _SEARCH { shift->command('SEARCH', @_)->response == CMD_OK }
78			sub _INFO { shift->command('INFO', @_)->response == CMD_OK }
79			sub _GET { shift->command('GET', @_)->response == CMD_OK }
80			sub _DATABASE { shift->command('DATABASE', @_)->response == CMD_OK }
81			sub _TABLE { shift->command('TABLE', @_)->response == CMD_OK }
82			sub _HITS { shift->command('HITS', @_)->response == CMD_OK }
83
84			# The following is a real hack. Don't look at it ;-) It tries to
85			# emulate a stateful protocol over HTTP which is weird and slow.
86			package WAIT::Client::HTTP;
87			use Net::Cmd;
88			use vars qw(@ISA);
89			use Carp;
90
91			@ISA = qw(WAIT::Client);
92
93			sub new {
94			my $type = shift;
95			my $host = shift;
96			my %parm = @_;
97			my ($proxy, $port) = ($parm{Proxy} =~ m{^(?:http://)(\S+)(?::(\d+))});
98			$port = 80 unless $port;
99	ulpfr	13
100	ulpfr	10	my $self = {
101			proxy_host => $proxy,
102			proxy_port => $port,
103			wais_host => $host,
104			wais_port => $parm{Port},
105			};
106			bless $self, $type;
107	ulpfr	13
108	ulpfr	10	if ($self->command('HELP')->response == CMD_INFO) {
109			return $self;
110			} else {
111			return;
112			}
113			}
114
115			sub command {
116			my $self = shift;
117			my $con =
118			WAIT::Client::HTTP::Handle->new
119			(
120			PeerAddr => $self->{proxy_host},
121			PeerPort => $self->{proxy_port},
122			Proto => 'tcp',
123			);
124			return unless $con;
125			my $cmd = join ' ', @_;
126	ulpfr	13
127	ulpfr	10	if ($self->{hits}) {
128			$cmd = "HITS $self->{hits}:$cmd";
129			}
130			$cmd = "Command: $cmd";
131			$con->autoflush(1);
132	ulpfr	13
133	ulpfr	10	$con->printf("POST http://$self->{wais_host}:$self->{wais_port} ".
134			"HTTP/1.0\nContent-Length: %d\n\n$cmd",
135			length($cmd));
136	ulpfr	13
137	ulpfr	10	unless ($con->response == CMD_OK) {
138			warn "No greeting from server\n";
139			}
140			if ($self->{hits}) {
141			unless ($con->response == CMD_OK) {
142			warn "Hits not aknowledged\n";
143			}
144			}
145			$self->{con} = $con;
146			$con;
147			}
148
149			# We map here raw document id's to rank numbers and back for
150			# convenience. Besides that the following search(), info(), and get()
151			# are obsolete.
152
153			sub search
154			{
155			my $wait = shift;
156	ulpfr	13
157	ulpfr	10	if ($wait->_SEARCH(@_)) {
158			my $r = $wait->read_until_dot();
159			my $i = 1;
160	ulpfr	13
161	ulpfr	10	delete $wait->{'map'};
162			for (@$r) {
163			if (s/^(\d+)/sprintf("%4d",$i)/e) {
164			$wait->{'map'}->[$i++] = $1;
165			}
166			}
167			return $r;
168			}
169			return undef;
170			}
171
172			sub info
173			{
174			@_ == 2 or croak 'usage: $wait->info( HIT-NUMBER )';
175			my $wait = shift;
176			my $num = shift;
177
178			unless ($wait->{'map'}->[$num]) {
179			print "No such hit: $num\n";
180			return;
181			}
182			$wait->_INFO($wait->{'map'}->[$num])
183			? $wait->read_until_dot()
184			: undef;
185			}
186
187			sub get
188			{
189			@_ == 2 or croak 'usage: $wait->info( HIT-NUMBER )';
190			my $wait = shift;
191			my $num = shift;
192
193			unless ($wait->{'map'}->[$num]) {
194			print "No such hit: $num\n";
195			return;
196			}
197			$wait->_GET($wait->{'map'}->[$num])
198			? $wait->read_until_dot()
199			: undef;
200			}
201
202			# We must store the hit count locally
203			sub _HITS {
204			my $self = shift;
205			my $hits = shift;
206
207			$self->{hits} = $hits;
208			["Setting maximum hit count to $hits"];
209			}
210
211			# We should use AUTOLOAD here. I know ;-)
212			sub read_until_dot {shift->{con}->read_until_dot(@_)}
213			sub message {shift->{con}->message(@_)}
214
215			package WAIT::Client::HTTP::Handle;
216			use vars qw(@ISA);
217
218			@ISA = qw(Net::Cmd IO::Socket::INET);
219
220
221			1;