--- trunk/Estraier.pm 2006/01/05 15:21:29 27 +++ trunk/Estraier.pm 2006/01/05 21:51:54 36 @@ -661,6 +661,11 @@ package Search::Estraier::Node; +use Carp qw/croak/; +use URI; +use MIME::Base64; +use IO::Socket::INET; + =head1 Search::Estraier::Node =head2 new @@ -673,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, @@ -687,59 +692,160 @@ $self ? return $self : return undef; } -package Search::Estraier::Master; +=head2 set_url + +Specify URL to node server + + $node->set_url('http://localhost:1978'); + +=cut + +sub set_url { + my $self = shift; + $self->{url} = shift; +} -use Carp; +=head2 set_proxy -=head1 Search::Estraier::Master +Specify proxy server to connect to node server -Controll node master. This requires user with administration priviledges. + $node->set_proxy('proxy.example.com', 8080); =cut -{ - package RequestAgent; - our @ISA = qw(LWP::UserAgent); +sub set_proxy { + my $self = shift; + my ($host,$port) = @_; + croak "proxy port must be number" unless ($port =~ m/^\d+$/); + $self->{pxhost} = $host; + $self->{pxport} = $port; +} - sub new { - my $self = LWP::UserAgent::new(@_); - $self->agent("Search-Estraier/$Search::Estraer::VERSION"); - $self; - } +=head2 set_timeout - sub get_basic_credentials { - my($self, $realm, $uri) = @_; -# return ($user, $password); - } +Specify timeout of connection in seconds + + $node->set_timeout( 15 ); + +=cut + +sub set_timeout { + my $self = shift; + my $sec = shift; + croak "timeout must be number" unless ($sec =~ m/^\d+$/); + $self->{timeout} = $sec; } +=head2 set_auth +Specify name and password for authentication to node server. -=head2 new + $node->set_auth('clint','eastwood'); -Create new connection to node master. +=cut + +sub set_auth { + my $self = shift; + my ($login,$passwd) = @_; + $self->{auth} = encode_base64( "$login:$passwd" ); +} - my $master = new Search::Estraier::Master( - url => 'http://localhost:1978', - user => 'admin', - passwd => 'admin', - ); +=head2 status + +Return status code of last request. + + print $res->status; + +C<-1> means connection failure. =cut -sub new { - my $class = shift; - my $self = {@_}; - bless($self, $class); +sub status { + my $self = shift; + return $self->{status}; +} + +=head2 shuttle_url + +This is method which uses C to communicate with Hyper Estraier node +master. + + my $rv = shuttle_url( $url, $content_type, \$req_body, \$resbody ); + +C<$resheads> and C<$resbody> booleans controll if response headers and/or response +body will be saved within object. + +=cut + +sub shuttle_url { + my $self = shift; + + my ($url, $content_type, $reqbody, $resbody) = @_; + + my $status = -1; - foreach my $p (qw/url user passwd/) { - croak "need $p" unless ($self->{$p}); + warn $url; + + $url = new URI($url); + return -1 unless ($url && $url->scheme && $url->scheme eq 'http' && $url->host && $url->port > 1); + + my ($host,$port,$query) = ($url->host, $url->port, $url->path); + + if ($self->{pxhost}) { + ($host,$port) = ($self->{pxhost}, $self->{pxport}); + $query = "http://$host:$port/$query"; } - $self ? return $self : return undef; -} + $query .= '?' + $url->query if ($url->query && ! $reqbody); + 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"; + } + 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"; + + 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; +} ###