/[Search-Estraier]/trunk/Estraier.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 /trunk/Estraier.pm

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

revision 31 by dpavlin, Thu Jan 5 15:36:25 2006 UTC revision 38 by dpavlin, Thu Jan 5 22:27:03 2006 UTC
# Line 661  sub hint { Line 661  sub hint {
661    
662  package Search::Estraier::Node;  package Search::Estraier::Node;
663    
664  use Carp qw/croak/;  use Carp qw/carp croak/;
665    use URI;
666    use MIME::Base64;
667    use IO::Socket::INET;
668    
669  =head1 Search::Estraier::Node  =head1 Search::Estraier::Node
670    
# Line 675  sub new { Line 678  sub new {
678          my $class = shift;          my $class = shift;
679          my $self = {          my $self = {
680                  pxport => -1,                  pxport => -1,
681                  timeout => -1,                  timeout => 0,   # this used to be -1
682                  dnum => -1,                  dnum => -1,
683                  wnum => -1,                  wnum => -1,
684                  size => -1.0,                  size => -1.0,
# Line 744  Specify name and password for authentica Line 747  Specify name and password for authentica
747  sub set_auth {  sub set_auth {
748          my $self = shift;          my $self = shift;
749          my ($login,$passwd) = @_;          my ($login,$passwd) = @_;
750          $self->{auth} = "$login:$passwd";          $self->{auth} = encode_base64( "$login:$passwd" );
751  }  }
752    
753  package Search::Estraier::Master;  =head2 status
754    
755  use Carp;  Return status code of last request.
756    
757  =head1 Search::Estraier::Master    print $res->status;
758    
759  Controll node master. This requires user with administration priviledges.  C<-1> means connection failure.
760    
761  =cut  =cut
762    
763  {  sub status {
764          package RequestAgent;          my $self = shift;
765          our @ISA = qw(LWP::UserAgent);          return $self->{status};
766    }
767    
768          sub new {  =head2 shuttle_url
769                  my $self = LWP::UserAgent::new(@_);  
770                  $self->agent("Search-Estraier/$Search::Estraer::VERSION");  This is method which uses C<IO::Socket::INET> to communicate with Hyper Estraier node
771                  $self;  master.
772          }  
773      my $rv = shuttle_url( $url, $content_type, \$req_body, \$resbody );
774    
775    C<$resheads> and C<$resbody> booleans controll if response headers and/or response
776    body will be saved within object.
777    
778    =cut
779    
780    sub shuttle_url {
781            my $self = shift;
782    
783            my ($url, $content_type, $reqbody, $resbody) = @_;
784    
785          sub get_basic_credentials {          my $status = -1;
786                  my($self, $realm, $uri) = @_;  
787  #               return ($user, $password);          warn "## $url\n";
788    
789            $url = new URI($url);
790            if (
791                            !$url || !$url->scheme || !$url->scheme eq 'http' ||
792                            !$url->host || !$url->port || $url->port < 1
793                    ) {
794                    carp "can't parse $url\n";
795                    return -1;
796          }          }
 }  
797    
798            my ($host,$port,$query) = ($url->host, $url->port, $url->path);
799    
800            if ($self->{pxhost}) {
801                    ($host,$port) = ($self->{pxhost}, $self->{pxport});
802                    $query = "http://$host:$port/$query";
803            }
804    
805  =head2 new          $query .= '?' . $url->query if ($url->query && ! $reqbody);
806    
807  Create new connection to node master.          my $headers;
808    
809    my $master = new Search::Estraier::Master(          if ($reqbody) {
810          url => 'http://localhost:1978',                  $headers .= "POST $query HTTP/1.0\r\n";
811          user => 'admin',          } else {
812          passwd => 'admin',                  $headers .= "GET $query HTTP/1.0\r\n";
813    );          }
814    
815  =cut          $headers .= "Host: $url->host:$url->port\r\n";
816            $headers .= "Connection: close\r\n";
817            $headers .= "User-Agent: Search-Estraier/$Search::Estraier::VERSION\r\n";
818            $headers .= "Content-Type $content_type\r\n";
819            $headers .= "Authorization: Basic $self->{auth}\r\n";
820            my $len = 0;
821            {
822                    use bytes;
823                    $len = length($reqbody) if ($reqbody);
824            }
825            $headers .= "Content-Length: $len\r\n";
826            $headers .= "\r\n";
827    
828  sub new {          my $sock = IO::Socket::INET->new(
829          my $class = shift;                  PeerAddr        => $host,
830          my $self = {@_};                  PeerPort        => $port,
831          bless($self, $class);                  Proto           => 'tcp',
832                    Timeout         => $self->{timeout} || 90,
833            );
834    
835            if (! $sock) {
836                    carp "can't open socket to $host:$port";
837                    return -1;
838            }
839    
840          foreach my $p (qw/url user passwd/) {          print $sock $headers or
841                  croak "need $p" unless ($self->{$p});                  carp "can't send headers to network:\n$headers\n" and return -1;
842    
843            if ($reqbody) {
844                    print $sock $$reqbody or
845                            carp "can't send request body to network:\n$$reqbody\n" and return -1;
846          }          }
847    
848          $self ? return $self : return undef;          my $line = <$sock>;
849  }          chomp($line);
850            my ($schema, $res_status, undef) = split(/  */, $line, 3);
851            return if ($schema !~ /^HTTP/ || ! $res_status);
852    
853            $self->{status} = $res_status;
854    
855            # skip rest of headers
856            $line = <$sock>;
857            while ($line) {
858                    $line = <$sock>;
859                    $line =~ s/[\r\n]+$//;
860                    warn "## ", $line || 'NULL', " ##\n";
861            };
862    
863            # read body
864            $len = 0;
865            do {
866                    $len = read($sock, my $buf, 8192);
867                    $$resbody .= $buf if ($resbody);
868            } while ($len);
869    
870            return $status;
871    }
872    
873  ###  ###
874    
Legend:
Removed from v.31  
changed lines
  Added in v.38
  ViewVC Help
Powered by ViewVC 1.1.26