/[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 32 by dpavlin, Thu Jan 5 15:38:34 2006 UTC revision 36 by dpavlin, Thu Jan 5 21:51:54 2006 UTC
# Line 662  sub hint { Line 662  sub hint {
662  package Search::Estraier::Node;  package Search::Estraier::Node;
663    
664  use Carp qw/croak/;  use Carp qw/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  =head2 status  =head2 status
# Line 762  sub status { Line 765  sub status {
765          return $self->{status};          return $self->{status};
766  }  }
767    
768    =head2 shuttle_url
769    
770  package Search::Estraier::Master;  This is method which uses C<IO::Socket::INET> to communicate with Hyper Estraier node
771    master.
772    
773  use Carp;    my $rv = shuttle_url( $url, $content_type, \$req_body, \$resbody );
774    
775  =head1 Search::Estraier::Master  C<$resheads> and C<$resbody> booleans controll if response headers and/or response
776    body will be saved within object.
 Controll node master. This requires user with administration priviledges.  
777    
778  =cut  =cut
779    
780  {  sub shuttle_url {
781          package RequestAgent;          my $self = shift;
         our @ISA = qw(LWP::UserAgent);  
   
         sub new {  
                 my $self = LWP::UserAgent::new(@_);  
                 $self->agent("Search-Estraier/$Search::Estraer::VERSION");  
                 $self;  
         }  
782    
783          sub get_basic_credentials {          my ($url, $content_type, $reqbody, $resbody) = @_;
                 my($self, $realm, $uri) = @_;  
 #               return ($user, $password);  
         }  
 }  
784    
785            my $status = -1;
786    
787            warn $url;
788    
789  =head2 new          $url = new URI($url);
790            return -1 unless ($url && $url->scheme && $url->scheme eq 'http' && $url->host && $url->port > 1);
791    
792  Create new connection to node master.          my ($host,$port,$query) = ($url->host, $url->port, $url->path);
793    
794    my $master = new Search::Estraier::Master(          if ($self->{pxhost}) {
795          url => 'http://localhost:1978',                  ($host,$port) = ($self->{pxhost}, $self->{pxport});
796          user => 'admin',                  $query = "http://$host:$port/$query";
797          passwd => 'admin',          }
   );  
798    
799  =cut          $query .= '?' + $url->query if ($url->query && ! $reqbody);
800    
801  sub new {          my $sock = IO::Socket::INET->new(
802          my $class = shift;                  PeerAddr        => $host,
803          my $self = {@_};                  PeerPort        => $port,
804          bless($self, $class);                  Proto           => 'tcp',
805                    Timeout         => $self->{timeout} || 90,
806            ) || return -1;
807    
808            if ($reqbody) {
809                    print $sock "POST $query HTTP/1.0\r\n";
810            } else {
811                    print $sock "GET $query HTTP/1.0\r\n";
812            }
813    
814          foreach my $p (qw/url user passwd/) {          print $sock "Host: $url->host:$url->port\r\n";
815                  croak "need $p" unless ($self->{$p});          print $sock "Connection: close\r\n";
816            print $sock "User-Agent: Search-Estraier/$Search::Estraier::VERSION\r\n";
817            print $sock "Content-Type $content_type\r\n";
818            print $sock "Authorization: Basic $self->{auth}\r\n";
819            {
820                    use bytes;
821                    print $sock "Content-Length: ", length($reqbody), "\r\n";
822          }          }
823            print $sock "\r\n";
824    
825          $self ? return $self : return undef;          print $sock $$reqbody if ($reqbody);
 }  
826    
827            my $line = <$sock>;
828            chomp($line);
829            my ($schema, $res_status, undef) = split(/  */, $line, 3);
830            return if ($schema !~ /^HTTP/ || ! $res_status);
831    
832            $self->{status} = $res_status;
833    
834            # skip rest of headers
835            do {
836                    $line = <$sock>;
837                    chomp($line);
838            } until ($line eq '');
839    
840            # read body
841            my $len = 0;
842            do {
843                    $len = read($sock, my $buf, 8192);
844                    $$resbody .= $buf if ($resbody);
845            } while ($len);
846    
847            return $status;
848    }
849    
850  ###  ###
851    
Legend:
Removed from v.32  
changed lines
  Added in v.36
  ViewVC Help
Powered by ViewVC 1.1.26