--- trunk/Estraier.pm 2006/01/05 15:38:34 32 +++ trunk/Estraier.pm 2006/01/05 17:54:18 33 @@ -662,6 +662,9 @@ package Search::Estraier::Node; use Carp qw/croak/; +use URI; +use URI::Escape qw/uri_escape/; +use IO::Socket::INET; =head1 Search::Estraier::Node @@ -675,7 +678,7 @@ my $class = shift; my $self = { pxport => -1, - timeout => -1, + timeout => 0, # this used to be -1 dnum => -1, wnum => -1, size => -1.0, @@ -744,7 +747,7 @@ sub set_auth { my $self = shift; my ($login,$passwd) = @_; - $self->{auth} = "$login:$passwd"; + $self->{auth} = uri_escape( "$login:$passwd" ); } =head2 status @@ -762,60 +765,85 @@ return $self->{status}; } +=head2 shuttle_url -package Search::Estraier::Master; +This is method which uses C to communicate with Hyper Estraier node +master. -use Carp; + my $rv = shuttle_url( $url, $content_type, \$req_body, \$resbody ); -=head1 Search::Estraier::Master - -Controll node master. This requires user with administration priviledges. +C<$resheads> and C<$resbody> booleans controll if response headers and/or response +body will be saved within object. =cut -{ - package RequestAgent; - our @ISA = qw(LWP::UserAgent); +sub shuttle_url { + my $self = shift; - sub new { - my $self = LWP::UserAgent::new(@_); - $self->agent("Search-Estraier/$Search::Estraer::VERSION"); - $self; - } + my ($url, $content_type, $reqbody, $resbody) = @_; - sub get_basic_credentials { - my($self, $realm, $uri) = @_; -# return ($user, $password); - } -} + my $status = -1; + $url = new URI($url); + return unless ($url->scheme ne 'http' || ! $url->host || $url->port < 1); + my ($host,$port,$query) = ($url->host, $url->port, $url->path); -=head2 new - -Create new connection to node master. + if ($self->{pxhost}) { + ($host,$port) = ($self->{pxhost}, $self->{pxport}); + $query = "http://$host:$port/$query"; + } - my $master = new Search::Estraier::Master( - url => 'http://localhost:1978', - user => 'admin', - passwd => 'admin', - ); + $query .= '?' + $url->query if ($url->query && ! $reqbody); -=cut - -sub new { - my $class = shift; - my $self = {@_}; - bless($self, $class); + my $sock = IO::Socket::INET->new( + PeerAddr => $host, + PeerPort => $port, + Proto => 'tcp', + Timeout => $self->{timeout} || 90, + ) || return -1; + + if ($reqbody) { + print $sock "POST $query HTTP/1.0\r\n"; + } else { + print $sock "GET $query HTTP/1.0\r\n"; + } - foreach my $p (qw/url user passwd/) { - croak "need $p" unless ($self->{$p}); + print $sock "Host: $url->host:$url->port\r\n"; + print $sock "Connection: close\r\n"; + print $sock "User-Agent: Search-Estraier/$Search::Estraier::VERSION\r\n"; + print $sock "Content-Type $content_type\r\n"; + print $sock "Authorization: Basic $self->{auth}\r\n"; + { + use bytes; + print $sock "Content-Length: ", length($reqbody), "\r\n"; } + print $sock "\r\n"; - $self ? return $self : return undef; -} + print $sock $$reqbody if ($reqbody); + my $line = <$sock>; + chomp($line); + my ($schema, $res_status, undef) = split(/ */, $line, 3); + return if ($schema !~ /^HTTP/ || ! $res_status); + + $self->{status} = $res_status; + + # skip rest of headers + do { + $line = <$sock>; + chomp($line); + } until ($line eq ''); + + # read body + my $len = 0; + do { + $len = read($sock, my $buf, 8192); + $$resbody .= $buf if ($resbody); + } while ($len); + return $status; +} ###