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 |
} |
} |
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 |
|
|
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 |
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\n"; |
warn "## $url\n"; |
807 |
|
|
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 |
{ |
{ |
856 |
return -1; |
return -1; |
857 |
} |
} |
858 |
|
|
859 |
warn "## headers:\n$headers\n" if ($self->{debug}); |
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 |
warn "## request body:\n$headers\n" if ($self->{debug}); |
warn $reqbody if ($self->{debug}); |
866 |
print $sock $$reqbody or |
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 |
|
|
872 |
my ($schema, $res_status, undef) = split(/ */, $line, 3); |
my ($schema, $res_status, undef) = split(/ */, $line, 3); |
873 |
return if ($schema !~ /^HTTP/ || ! $res_status); |
return if ($schema !~ /^HTTP/ || ! $res_status); |
874 |
|
|
875 |
$status = $res_status; |
$self->{status} = $res_status; |
876 |
warn "## response status: $res_status\n" if ($self->{debug}); |
warn "## response status: $res_status\n" if ($self->{debug}); |
877 |
|
|
878 |
# skip rest of headers |
# skip rest of headers |
880 |
while ($line) { |
while ($line) { |
881 |
$line = <$sock>; |
$line = <$sock>; |
882 |
$line =~ s/[\r\n]+$//; |
$line =~ s/[\r\n]+$//; |
883 |
warn "## ", $line || 'NULL', " ##\n"; |
warn "## ", $line || 'NULL', " ##\n" if ($self->{debug}); |
884 |
}; |
}; |
885 |
|
|
886 |
# read body |
# read body |
890 |
$$resbody .= $buf if ($resbody); |
$$resbody .= $buf if ($resbody); |
891 |
} while ($len); |
} while ($len); |
892 |
|
|
893 |
|
warn "## response body:\n$$resbody\n" if ($resbody && $self->{debug}); |
|
warn "## response body:\n$$resbody\n" if ($self->{debug}); |
|
894 |
|
|
895 |
return $status; |
return $self->{status}; |
896 |
} |
} |
897 |
|
|
898 |
### |
### |