/[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 27 by dpavlin, Thu Jan 5 15:21:29 2006 UTC revision 33 by dpavlin, Thu Jan 5 17:54:18 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/;
665    use URI;
666    use URI::Escape qw/uri_escape/;
667    use IO::Socket::INET;
668    
669  =head1 Search::Estraier::Node  =head1 Search::Estraier::Node
670    
671  =head2 new  =head2 new
# Line 673  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 687  sub new { Line 692  sub new {
692          $self ? return $self : return undef;          $self ? return $self : return undef;
693  }  }
694    
695  package Search::Estraier::Master;  =head2 set_url
696    
697    Specify URL to node server
698    
699      $node->set_url('http://localhost:1978');
700    
701  use Carp;  =cut
702    
703    sub set_url {
704            my $self = shift;
705            $self->{url} = shift;
706    }
707    
708  =head1 Search::Estraier::Master  =head2 set_proxy
709    
710  Controll node master. This requires user with administration priviledges.  Specify proxy server to connect to node server
711    
712      $node->set_proxy('proxy.example.com', 8080);
713    
714  =cut  =cut
715    
716  {  sub set_proxy {
717          package RequestAgent;          my $self = shift;
718          our @ISA = qw(LWP::UserAgent);          my ($host,$port) = @_;
719            croak "proxy port must be number" unless ($port =~ m/^\d+$/);
720            $self->{pxhost} = $host;
721            $self->{pxport} = $port;
722    }
723    
724          sub new {  =head2 set_timeout
                 my $self = LWP::UserAgent::new(@_);  
                 $self->agent("Search-Estraier/$Search::Estraer::VERSION");  
                 $self;  
         }  
725    
726          sub get_basic_credentials {  Specify timeout of connection in seconds
727                  my($self, $realm, $uri) = @_;  
728  #               return ($user, $password);    $node->set_timeout( 15 );
729          }  
730    =cut
731    
732    sub set_timeout {
733            my $self = shift;
734            my $sec = shift;
735            croak "timeout must be number" unless ($sec =~ m/^\d+$/);
736            $self->{timeout} = $sec;
737  }  }
738    
739    =head2 set_auth
740    
741    Specify name and password for authentication to node server.
742    
743  =head2 new    $node->set_auth('clint','eastwood');
744    
745  Create new connection to node master.  =cut
746    
747    my $master = new Search::Estraier::Master(  sub set_auth {
748          url => 'http://localhost:1978',          my $self = shift;
749          user => 'admin',          my ($login,$passwd) = @_;
750          passwd => 'admin',          $self->{auth} = uri_escape( "$login:$passwd" );
751    );  }
752    
753    =head2 status
754    
755    Return status code of last request.
756    
757      print $res->status;
758    
759    C<-1> means connection failure.
760    
761  =cut  =cut
762    
763  sub new {  sub status {
764          my $class = shift;          my $self = shift;
765          my $self = {@_};          return $self->{status};
766          bless($self, $class);  }
767    
768    =head2 shuttle_url
769    
770    This is method which uses C<IO::Socket::INET> to communicate with Hyper Estraier node
771    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          foreach my $p (qw/url user passwd/) {          my $status = -1;
786                  croak "need $p" unless ($self->{$p});  
787            $url = new URI($url);
788            return unless ($url->scheme ne 'http' || ! $url->host || $url->port < 1);
789    
790            my ($host,$port,$query) = ($url->host, $url->port, $url->path);
791    
792            if ($self->{pxhost}) {
793                    ($host,$port) = ($self->{pxhost}, $self->{pxport});
794                    $query = "http://$host:$port/$query";
795          }          }
796    
797          $self ? return $self : return undef;          $query .= '?' + $url->query if ($url->query && ! $reqbody);
 }  
798    
799            my $sock = IO::Socket::INET->new(
800                    PeerAddr        => $host,
801                    PeerPort        => $port,
802                    Proto           => 'tcp',
803                    Timeout         => $self->{timeout} || 90,
804            ) || return -1;
805    
806            if ($reqbody) {
807                    print $sock "POST $query HTTP/1.0\r\n";
808            } else {
809                    print $sock "GET $query HTTP/1.0\r\n";
810            }
811    
812            print $sock "Host: $url->host:$url->port\r\n";
813            print $sock "Connection: close\r\n";
814            print $sock "User-Agent: Search-Estraier/$Search::Estraier::VERSION\r\n";
815            print $sock "Content-Type $content_type\r\n";
816            print $sock "Authorization: Basic $self->{auth}\r\n";
817            {
818                    use bytes;
819                    print $sock "Content-Length: ", length($reqbody), "\r\n";
820            }
821            print $sock "\r\n";
822    
823            print $sock $$reqbody if ($reqbody);
824    
825            my $line = <$sock>;
826            chomp($line);
827            my ($schema, $res_status, undef) = split(/  */, $line, 3);
828            return if ($schema !~ /^HTTP/ || ! $res_status);
829    
830            $self->{status} = $res_status;
831    
832            # skip rest of headers
833            do {
834                    $line = <$sock>;
835                    chomp($line);
836            } until ($line eq '');
837    
838            # read body
839            my $len = 0;
840            do {
841                    $len = read($sock, my $buf, 8192);
842                    $$resbody .= $buf if ($resbody);
843            } while ($len);
844    
845            return $status;
846    }
847    
848  ###  ###
849    
Legend:
Removed from v.27  
changed lines
  Added in v.33
  ViewVC Help
Powered by ViewVC 1.1.26