/[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 23 by dpavlin, Thu Jan 5 14:30:42 2006 UTC revision 37 by dpavlin, Thu Jan 5 22:16:21 2006 UTC
# Line 478  sub options { Line 478  sub options {
478    
479  package Search::Estraier::ResultDocument;  package Search::Estraier::ResultDocument;
480    
481  use Carp qw/confess croak/;  use Carp qw/croak/;
482    
483  use Search::Estraier;  #use Search::Estraier;
484  our @ISA = qw/Search::Estraier/;  #our @ISA = qw/Search::Estraier/;
485    
486  =head1 Search::Estraier::ResultDocument  =head1 Search::Estraier::ResultDocument
487    
# Line 580  sub keywords { Line 580  sub keywords {
580  }  }
581    
582    
583  package Search::Estraier::Master;  package Search::Estraier::NodeResult;
584    
585  use Carp;  use Carp qw/croak/;
586    
587  =head1 Search::Estraier::Master  #use Search::Estraier;
588    #our @ISA = qw/Search::Estraier/;
589    
590  Controll node master. This requires user with administration priviledges.  =head1 Search::Estraier::NodeResult
591    
592    =head2 new
593    
594      my $res = new Search::HyperEstraier::NodeResult(
595            docs => @array_of_rdocs,
596            hits => %hash_with_hints,
597      );
598    
599  =cut  =cut
600    
601  {  sub new {
602          package RequestAgent;          my $class = shift;
603          our @ISA = qw(LWP::UserAgent);          my $self = {@_};
604            bless($self, $class);
605    
606          sub new {          foreach my $f (qw/docs hints/) {
607                  my $self = LWP::UserAgent::new(@_);                  croak "missing $f for ResultDocument" unless defined($self->{$f});
                 $self->agent("Search-Estraier/$Search::Estraer::VERSION");  
                 $self;  
608          }          }
609    
610          sub get_basic_credentials {          $self ? return $self : return undef;
                 my($self, $realm, $uri) = @_;  
 #               return ($user, $password);  
         }  
611  }  }
612    
613    =head2 doc_num
614    
615    Return number of documents
616    
617  =head2 new    print $res->doc_num;
618    
619  Create new connection to node master.  =cut
620    
621    my $master = new Search::Estraier::Master(  sub doc_num {
622          url => 'http://localhost:1978',          my $self = shift;
623          user => 'admin',          return $#{$self->{docs}};
624          passwd => 'admin',  }
625    );  
626    =head2 get_doc
627    
628    Return single document
629    
630      my $doc = $res->get_doc( 42 );
631    
632    Returns undef if document doesn't exist.
633    
634    =cut
635    
636    sub get_doc {
637            my $self = shift;
638            my $num = shift;
639            croak "expect number as argument" unless ($num =~ m/^\d+$/);
640            return undef if ($num < 0 || $num > $self->{docs});
641            return $self->{docs}->[$num];
642    }
643    
644    =head2 hint
645    
646    Return specific hint from results.
647    
648      print $rec->hint( 'VERSION' );
649    
650    Possible hints are: C<VERSION>, C<NODE>, C<HIT>, C<HINT#n>, C<DOCNUM>, C<WORDNUM>,
651    C<TIME>, C<LINK#n>, C<VIEW>.
652    
653    =cut
654    
655    sub hint {
656            my $self = shift;
657            my $key = shift || return;
658            return $self->{hints}->{$key};
659    }
660    
661    
662    package Search::Estraier::Node;
663    
664    use Carp qw/carp croak/;
665    use URI;
666    use MIME::Base64;
667    use IO::Socket::INET;
668    
669    =head1 Search::Estraier::Node
670    
671    =head2 new
672    
673      my $node = new Search::HyperEstraier::Node;
674    
675  =cut  =cut
676    
677  sub new {  sub new {
678          my $class = shift;          my $class = shift;
679          my $self = {@_};          my $self = {
680                    pxport => -1,
681                    timeout => 0,   # this used to be -1
682                    dnum => -1,
683                    wnum => -1,
684                    size => -1.0,
685                    wwidth => 480,
686                    hwidth => 96,
687                    awidth => 96,
688                    status => -1,
689            };
690          bless($self, $class);          bless($self, $class);
691    
         foreach my $p (qw/url user passwd/) {  
                 croak "need $p" unless ($self->{$p});  
         }  
   
692          $self ? return $self : return undef;          $self ? return $self : return undef;
693  }  }
694    
695    =head2 set_url
696    
697    Specify URL to node server
698    
699      $node->set_url('http://localhost:1978');
700    
701    =cut
702    
703    sub set_url {
704            my $self = shift;
705            $self->{url} = shift;
706    }
707    
708    =head2 set_proxy
709    
710    Specify proxy server to connect to node server
711    
712      $node->set_proxy('proxy.example.com', 8080);
713    
714    =cut
715    
716    sub set_proxy {
717            my $self = shift;
718            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    =head2 set_timeout
725    
726    Specify timeout of connection in seconds
727    
728      $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      $node->set_auth('clint','eastwood');
744    
745    =cut
746    
747    sub set_auth {
748            my $self = shift;
749            my ($login,$passwd) = @_;
750            $self->{auth} = encode_base64( "$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
762    
763    sub status {
764            my $self = shift;
765            return $self->{status};
766    }
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            my $status = -1;
786    
787            warn $url;
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            $query .= '?' . $url->query if ($url->query && ! $reqbody);
806    
807            my $headers;
808    
809            if ($reqbody) {
810                    $headers .= "POST $query HTTP/1.0\r\n";
811            } else {
812                    $headers .= "GET $query HTTP/1.0\r\n";
813            }
814    
815            $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            my $sock = IO::Socket::INET->new(
829                    PeerAddr        => $host,
830                    PeerPort        => $port,
831                    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            print $sock $headers or
841                    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            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            do {
857                    $line = <$sock>;
858                    chomp($line);
859            } until ($line eq '');
860    
861            # read body
862            my $len = 0;
863            do {
864                    $len = read($sock, my $buf, 8192);
865                    $$resbody .= $buf if ($resbody);
866            } while ($len);
867    
868            return $status;
869    }
870    
871  ###  ###
872    
Legend:
Removed from v.23  
changed lines
  Added in v.37
  ViewVC Help
Powered by ViewVC 1.1.26