/[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 42 by dpavlin, Thu Jan 5 23:38:32 2006 UTC revision 44 by dpavlin, Fri Jan 6 01:12:10 2006 UTC
# Line 387  sub set_order { Line 387  sub set_order {
387  sub set_max {  sub set_max {
388          my $self = shift;          my $self = shift;
389          my $max = shift;          my $max = shift;
390          croak "set_max needs number" unless ($max =~ m/^\d+$/);          croak "set_max needs number, not '$max'" unless ($max =~ m/^\d+$/);
391          $self->{max} = $max;          $self->{max} = $max;
392  }  }
393    
# Line 662  Returns undef if document doesn't exist. Line 662  Returns undef if document doesn't exist.
662  sub get_doc {  sub get_doc {
663          my $self = shift;          my $self = shift;
664          my $num = shift;          my $num = shift;
665          croak "expect number as argument" unless ($num =~ m/^\d+$/);          croak "expect number as argument, not '$num'" unless ($num =~ m/^\d+$/);
666          return undef if ($num < 0 || $num > $self->{docs});          return undef if ($num < 0 || $num > $self->{docs});
667          return $self->{docs}->[$num];          return $self->{docs}->[$num];
668  }  }
# Line 688  sub hint { Line 688  sub hint {
688    
689  package Search::Estraier::Node;  package Search::Estraier::Node;
690    
691  use Carp qw/carp croak/;  use Carp qw/carp croak confess/;
692  use URI;  use URI;
693  use MIME::Base64;  use MIME::Base64;
694  use IO::Socket::INET;  use IO::Socket::INET;
# Line 750  Specify proxy server to connect to node Line 750  Specify proxy server to connect to node
750  sub set_proxy {  sub set_proxy {
751          my $self = shift;          my $self = shift;
752          my ($host,$port) = @_;          my ($host,$port) = @_;
753          croak "proxy port must be number" unless ($port =~ m/^\d+$/);          croak "proxy port must be number, not '$port'" unless ($port =~ m/^\d+$/);
754          $self->{pxhost} = $host;          $self->{pxhost} = $host;
755          $self->{pxport} = $port;          $self->{pxport} = $port;
756  }  }
# Line 767  Specify timeout of connection in seconds Line 767  Specify timeout of connection in seconds
767  sub set_timeout {  sub set_timeout {
768          my $self = shift;          my $self = shift;
769          my $sec = shift;          my $sec = shift;
770          croak "timeout must be number" unless ($sec =~ m/^\d+$/);          croak "timeout must be number, not '$sec'" unless ($sec =~ m/^\d+$/);
771          $self->{timeout} = $sec;          $self->{timeout} = $sec;
772  }  }
773    
# Line 841  sub out_doc { Line 841  sub out_doc {
841          my $self = shift;          my $self = shift;
842          my $id = shift || return;          my $id = shift || return;
843          return unless ($self->{url});          return unless ($self->{url});
844          croak "id must be number" unless ($id =~ m/^\d+$/);          croak "id must be number, not '$id'" unless ($id =~ m/^\d+$/);
845          $self->shuttle_url( $self->{url} . '/out_doc',          $self->shuttle_url( $self->{url} . '/out_doc',
846                  'application/x-www-form-urlencoded',                  'application/x-www-form-urlencoded',
847                  "id=$id",                  "id=$id",
# Line 894  sub edit_doc { Line 894  sub edit_doc {
894  }  }
895    
896    
897    =head2 get_doc
898    
899    Retreive document
900    
901      my $doc = $node->get_doc( document_id ) or die "can't get document";
902    
903    Return true on success or false on failture.
904    
905    =cut
906    
907    sub get_doc {
908            my $self = shift;
909            my $id = shift || return;
910            return $self->_fetch_doc( id => $id );
911    }
912    
913    
914    =head2 get_doc_by_uri
915    
916    Retreive document
917    
918      my $doc = $node->get_doc_by_uri( 'file:///document_uri' ) or die "can't get document";
919    
920    Return true on success or false on failture.
921    
922    =cut
923    
924    sub get_doc_by_uri {
925            my $self = shift;
926            my $uri = shift || return;
927            return $self->_fetch_doc( uri => $uri );
928    }
929    
930    
931    =head2 etch_doc
932    
933    Exctract document keywords
934    
935      my $keywords = $node->etch_doc( document_id ) or die "can't etch document";
936    
937    =cut
938    
939    sub erch_doc {
940            my $self = shift;
941            my $id = shift || return;
942            return $self->_fetch_doc( id => $id, etch => 1 );
943    }
944    
945    =head2 etch_doc_by_uri
946    
947    Retreive document
948    
949      my $keywords = $node->etch_doc_by_uri( 'file:///document_uri' ) or die "can't etch document";
950    
951    Return true on success or false on failture.
952    
953    =cut
954    
955    sub etch_doc_by_uri {
956            my $self = shift;
957            my $uri = shift || return;
958            return $self->_fetch_doc( uri => $uri, etch => 1 );
959    }
960    
961    
962    =head2 _fetch_doc
963    
964    Private function used for implementing of C<get_doc>, C<get_doc_by_uri>,
965    C<etch_doc>, C<etch_doc_by_uri>.
966    
967     my $doc = $node->fetch_doc( id => 42, etch => 1 );
968     my $doc = $node->fetch_doc( uri => 'file://uri/42' );
969    
970    =cut
971    
972    sub _fetch_doc {
973            my $self = shift;
974            my $a = {@_};
975            return unless ( ($a->{id} || $a->{uri}) && $self->{url} );
976    
977            my ($arg, $resbody);
978    
979            my $path = '/get_doc';
980            $path = '/etch_doc' if ($a->{etch});
981    
982            if ($a->{id}) {
983                    croak "id must be numberm not '$a->{id}'" unless ($a->{id} =~ m/^\d+$/);
984                    $arg = 'id=' . $a->{id};
985            } elsif ($a->{uri}) {
986                    $arg = 'uri=' . $a->{uri};
987            } else {
988                    confess "unhandled argument. Need id or uri.";
989            }
990    
991            my $rv = $self->shuttle_url( $self->{url} . $path,
992                    'application/x-www-form-urlencoded',
993                    $arg,
994                    $resbody,
995            );
996    
997            return if ($rv != 200);
998    
999            if ($a->{etch}) {
1000                    $self->{kwords} = {};
1001                    return +{} unless ($resbody);
1002                    foreach my $l (split(/\n/, $resbody)) {
1003                            my ($k,$v) = split(/\t/, $l, 2);
1004                            $self->{kwords}->{$k} = $v if ($v);
1005                    }
1006                    return $self->{kwords};
1007            } else {
1008                    return new Search::Estraier::Document($resbody);
1009            }
1010    }
1011    
1012    
1013    
1014    
1015  =head2 shuttle_url  =head2 shuttle_url
1016    
1017  This is method which uses C<IO::Socket::INET> to communicate with Hyper Estraier node  This is method which uses C<IO::Socket::INET> to communicate with Hyper Estraier node
Legend:
Removed from v.42  
changed lines
  Added in v.44
  ViewVC Help
Powered by ViewVC 1.1.26