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

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

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