/[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 37 by dpavlin, Thu Jan 5 22:16:21 2006 UTC revision 40 by dpavlin, Thu Jan 5 23:00:22 2006 UTC
# Line 272  sub dump_draft { Line 272  sub dump_draft {
272    
273          $draft .= "\n";          $draft .= "\n";
274    
275          $draft .= join("\n", @{ $self->{dtexts} }) . "\n";          $draft .= join("\n", @{ $self->{dtexts} }) . "\n" if ($self->{dtexts});
276          $draft .= "\t" . join("\n\t", @{ $self->{htexts} }) . "\n";          $draft .= "\t" . join("\n\t", @{ $self->{htexts} }) . "\n" if ($self->{htexts});
277    
278          return $draft;          return $draft;
279  }  }
# Line 689  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 747  Specify name and password for authentica Line 752  Specify name and password for authentica
752  sub set_auth {  sub set_auth {
753          my $self = shift;          my $self = shift;
754          my ($login,$passwd) = @_;          my ($login,$passwd) = @_;
755          $self->{auth} = encode_base64( "$login:$passwd" );          my $basic_auth = encode_base64( "$login:$passwd" );
756            chomp($basic_auth);
757            $self->{auth} = $basic_auth;
758  }  }
759    
760  =head2 status  =head2 status
761    
762  Return status code of last request.  Return status code of last request.
763    
764    print $res->status;    print $node->status;
765    
766  C<-1> means connection failure.  C<-1> means connection failure.
767    
# Line 765  sub status { Line 772  sub status {
772          return $self->{status};          return $self->{status};
773  }  }
774    
775    =head2 put_doc
776    
777      $node->put_doc( $document_draft );
778    
779    =cut
780    
781    sub put_doc {
782            my $self = shift;
783            my $doc = shift || return;
784            $self->shuttle_url( $self->{url} . '/put_doc', 'text/x-estraier-draft', $doc->dump_draft, undef);
785    }
786    
787  =head2 shuttle_url  =head2 shuttle_url
788    
789  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
# Line 782  sub shuttle_url { Line 801  sub shuttle_url {
801    
802          my ($url, $content_type, $reqbody, $resbody) = @_;          my ($url, $content_type, $reqbody, $resbody) = @_;
803    
804          my $status = -1;          $self->{status} = -1;
805    
806          warn $url;          warn "## $url\n";
807    
808          $url = new URI($url);          $url = new URI($url);
809          if (          if (
# Line 812  sub shuttle_url { Line 831  sub shuttle_url {
831                  $headers .= "GET $query HTTP/1.0\r\n";                  $headers .= "GET $query HTTP/1.0\r\n";
832          }          }
833    
834          $headers .= "Host: $url->host:$url->port\r\n";          $headers .= "Host: " . $url->host . ":" . $url->port . "\r\n";
835          $headers .= "Connection: close\r\n";          $headers .= "Connection: close\r\n";
836          $headers .= "User-Agent: Search-Estraier/$Search::Estraier::VERSION\r\n";          $headers .= "User-Agent: Search-Estraier/$Search::Estraier::VERSION\r\n";
837          $headers .= "Content-Type $content_type\r\n";          $headers .= "Content-Type: $content_type\r\n";
838          $headers .= "Authorization: Basic $self->{auth}\r\n";          $headers .= "Authorization: Basic $self->{auth}\r\n";
839          my $len = 0;          my $len = 0;
840          {          {
# Line 837  sub shuttle_url { Line 856  sub shuttle_url {
856                  return -1;                  return -1;
857          }          }
858    
859            warn $headers if ($self->{debug});
860    
861          print $sock $headers or          print $sock $headers or
862                  carp "can't send headers to network:\n$headers\n" and return -1;                  carp "can't send headers to network:\n$headers\n" and return -1;
863    
864          if ($reqbody) {          if ($reqbody) {
865                  print $sock $$reqbody or                  warn $reqbody if ($self->{debug});
866                    print $sock $reqbody or
867                          carp "can't send request body to network:\n$$reqbody\n" and return -1;                          carp "can't send request body to network:\n$$reqbody\n" and return -1;
868          }          }
869    
# Line 851  sub shuttle_url { Line 873  sub shuttle_url {
873          return if ($schema !~ /^HTTP/ || ! $res_status);          return if ($schema !~ /^HTTP/ || ! $res_status);
874    
875          $self->{status} = $res_status;          $self->{status} = $res_status;
876            warn "## response status: $res_status\n" if ($self->{debug});
877    
878          # skip rest of headers          # skip rest of headers
879          do {          $line = <$sock>;
880            while ($line) {
881                  $line = <$sock>;                  $line = <$sock>;
882                  chomp($line);                  $line =~ s/[\r\n]+$//;
883          } until ($line eq '');                  warn "## ", $line || 'NULL', " ##\n" if ($self->{debug});
884            };
885    
886          # read body          # read body
887          my $len = 0;          $len = 0;
888          do {          do {
889                  $len = read($sock, my $buf, 8192);                  $len = read($sock, my $buf, 8192);
890                  $$resbody .= $buf if ($resbody);                  $$resbody .= $buf if ($resbody);
891          } while ($len);          } while ($len);
892    
893          return $status;          warn "## response body:\n$$resbody\n" if ($resbody && $self->{debug});
894    
895            return $self->{status};
896  }  }
897    
898  ###  ###
Legend:
Removed from v.37  
changed lines
  Added in v.40
  ViewVC Help
Powered by ViewVC 1.1.26