/[wait]/branches/CPAN/lib/WAIT/Client.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /branches/CPAN/lib/WAIT/Client.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 12 by unknown, Fri Apr 28 15:41:10 2000 UTC revision 13 by ulpfr, Fri Apr 28 15:42:44 2000 UTC
# Line 1  Line 1 
1  #                              -*- Mode: Perl -*-  #                              -*- Mode: Cperl -*-
2  # Client.pm --  # Client.pm --
3  # ITIID           : $ITI$ $Header $__Header$  # ITIID           : $ITI$ $Header $__Header$
4  # Author          : Ulrich Pfeifer  # Author          : Ulrich Pfeifer
5  # Created On      : Fri Jan 31 10:49:37 1997  # Created On      : Fri Jan 31 10:49:37 1997
# Line 8  Line 8 
8  # Language        : CPerl  # Language        : CPerl
9  # Update Count    : 85  # Update Count    : 85
10  # Status          : Unknown, Use with caution!  # Status          : Unknown, Use with caution!
11  #  #
12  # (C) Copyright 1997, Universität Dortmund, all rights reserved.  # (C) Copyright 1997, Universität Dortmund, all rights reserved.
13  #  #
14    
15  package WAIT::Client;  package WAIT::Client;
16  use Net::NNTP ();  use Net::NNTP ();
# Line 24  use vars qw(@ISA); Line 24  use vars qw(@ISA);
24  sub search  sub search
25  {  {
26    my $wait = shift;    my $wait = shift;
27      
28    $wait->_SEARCH(@_)    $wait->_SEARCH(@_)
29      ? $wait->read_until_dot()      ? $wait->read_until_dot()
30        : undef;        : undef;
# Line 34  sub info Line 34  sub info
34  {  {
35    @_ == 2 or croak 'usage: $wait->info( HIT-NUMBER )';    @_ == 2 or croak 'usage: $wait->info( HIT-NUMBER )';
36    my $wait = shift;    my $wait = shift;
37      
38    $wait->_INFO(@_)    $wait->_INFO(@_)
39      ? $wait->read_until_dot()      ? $wait->read_until_dot()
40        : undef;        : undef;
# Line 44  sub get Line 44  sub get
44  {  {
45    @_ == 2 or croak 'usage: $wait->info( HIT-NUMBER )';    @_ == 2 or croak 'usage: $wait->info( HIT-NUMBER )';
46    my $wait = shift;    my $wait = shift;
47      
48    $wait->_GET(@_)    $wait->_GET(@_)
49      ? $wait->read_until_dot()      ? $wait->read_until_dot()
50        : undef;        : undef;
# Line 54  sub database Line 54  sub database
54  {  {
55    @_ == 2 or croak 'usage: $wait->database( DBNAME )';    @_ == 2 or croak 'usage: $wait->database( DBNAME )';
56    my $wait = shift;    my $wait = shift;
57      
58    $wait->_DATABASE(@_);    $wait->_DATABASE(@_);
59  }  }
60    
# Line 62  sub table Line 62  sub table
62  {  {
63    @_ == 2 or croak 'usage: $wait->table( TABLE )';    @_ == 2 or croak 'usage: $wait->table( TABLE )';
64    my $wait = shift;    my $wait = shift;
65      
66    $wait->_TABLE(@_);    $wait->_TABLE(@_);
67  }  }
68    
# Line 70  sub hits Line 70  sub hits
70  {  {
71    @_ == 2 or croak 'usage: $wait->hits( NUM-MAX-HITS )';    @_ == 2 or croak 'usage: $wait->hits( NUM-MAX-HITS )';
72    my $wait = shift;    my $wait = shift;
73      
74    $wait->_HITS(@_);    $wait->_HITS(@_);
75  }  }
76    
# Line 96  sub new { Line 96  sub new {
96    my %parm = @_;    my %parm = @_;
97    my ($proxy, $port) = ($parm{Proxy} =~ m{^(?:http://)(\S+)(?::(\d+))});    my ($proxy, $port) = ($parm{Proxy} =~ m{^(?:http://)(\S+)(?::(\d+))});
98    $port = 80 unless $port;    $port = 80 unless $port;
99      
100    my $self = {    my $self = {
101                proxy_host => $proxy,                proxy_host => $proxy,
102                proxy_port => $port,                proxy_port => $port,
# Line 104  sub new { Line 104  sub new {
104                wais_port  => $parm{Port},                wais_port  => $parm{Port},
105               };               };
106    bless $self, $type;    bless $self, $type;
107      
108    if ($self->command('HELP')->response == CMD_INFO) {    if ($self->command('HELP')->response == CMD_INFO) {
109      return $self;      return $self;
110    } else {    } else {
# Line 123  sub command { Line 123  sub command {
123        );        );
124    return unless $con;    return unless $con;
125    my $cmd = join ' ', @_;    my $cmd = join ' ', @_;
126      
127    if ($self->{hits}) {    if ($self->{hits}) {
128      $cmd = "HITS $self->{hits}:$cmd";      $cmd = "HITS $self->{hits}:$cmd";
129    }    }
130    $cmd = "Command: $cmd";    $cmd = "Command: $cmd";
131    $con->autoflush(1);    $con->autoflush(1);
132      
133    $con->printf("POST http://$self->{wais_host}:$self->{wais_port} ".    $con->printf("POST http://$self->{wais_host}:$self->{wais_port} ".
134                 "HTTP/1.0\nContent-Length: %d\n\n$cmd",                 "HTTP/1.0\nContent-Length: %d\n\n$cmd",
135                 length($cmd));                 length($cmd));
136      
137    unless ($con->response == CMD_OK) {    unless ($con->response == CMD_OK) {
138      warn "No greeting from server\n";      warn "No greeting from server\n";
139    }    }
# Line 153  sub command { Line 153  sub command {
153  sub search  sub search
154  {  {
155    my $wait = shift;    my $wait = shift;
156      
157    if ($wait->_SEARCH(@_)) {    if ($wait->_SEARCH(@_)) {
158      my $r = $wait->read_until_dot();      my $r = $wait->read_until_dot();
159      my $i = 1;      my $i = 1;
160        
161      delete $wait->{'map'};      delete $wait->{'map'};
162      for (@$r) {      for (@$r) {
163        if (s/^(\d+)/sprintf("%4d",$i)/e) {        if (s/^(\d+)/sprintf("%4d",$i)/e) {
Legend:
Removed from v.12  
changed lines
  Added in v.13
  ViewVC Help
Powered by ViewVC 1.1.26