--- trunk/Estraier.pm 2006/01/05 15:01:56 25 +++ trunk/Estraier.pm 2006/01/05 23:00:22 40 @@ -272,8 +272,8 @@ $draft .= "\n"; - $draft .= join("\n", @{ $self->{dtexts} }) . "\n"; - $draft .= "\t" . join("\n\t", @{ $self->{htexts} }) . "\n"; + $draft .= join("\n", @{ $self->{dtexts} }) . "\n" if ($self->{dtexts}); + $draft .= "\t" . join("\n\t", @{ $self->{htexts} }) . "\n" if ($self->{htexts}); return $draft; } @@ -659,59 +659,241 @@ } -package Search::Estraier::Master; +package Search::Estraier::Node; -use Carp; +use Carp qw/carp croak/; +use URI; +use MIME::Base64; +use IO::Socket::INET; -=head1 Search::Estraier::Master +=head1 Search::Estraier::Node -Controll node master. This requires user with administration priviledges. +=head2 new + + my $node = new Search::HyperEstraier::Node; =cut -{ - package RequestAgent; - our @ISA = qw(LWP::UserAgent); +sub new { + my $class = shift; + my $self = { + pxport => -1, + timeout => 0, # this used to be -1 + dnum => -1, + wnum => -1, + size => -1.0, + wwidth => 480, + hwidth => 96, + awidth => 96, + status => -1, + }; + bless($self, $class); - sub new { - my $self = LWP::UserAgent::new(@_); - $self->agent("Search-Estraier/$Search::Estraer::VERSION"); - $self; + if (@_) { + $self->{debug} = 1; + warn "## Node debug on\n"; } - sub get_basic_credentials { - my($self, $realm, $uri) = @_; -# return ($user, $password); - } + $self ? return $self : return undef; } +=head2 set_url +Specify URL to node server -=head2 new + $node->set_url('http://localhost:1978'); -Create new connection to node master. +=cut - my $master = new Search::Estraier::Master( - url => 'http://localhost:1978', - user => 'admin', - passwd => 'admin', - ); +sub set_url { + my $self = shift; + $self->{url} = shift; +} + +=head2 set_proxy + +Specify proxy server to connect to node server + + $node->set_proxy('proxy.example.com', 8080); =cut -sub new { - my $class = shift; - my $self = {@_}; - bless($self, $class); +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; +} - foreach my $p (qw/url user passwd/) { - croak "need $p" unless ($self->{$p}); - } +=head2 set_timeout - $self ? return $self : return undef; +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. + + $node->set_auth('clint','eastwood'); + +=cut + +sub set_auth { + my $self = shift; + my ($login,$passwd) = @_; + my $basic_auth = encode_base64( "$login:$passwd" ); + chomp($basic_auth); + $self->{auth} = $basic_auth; +} + +=head2 status + +Return status code of last request. + + print $node->status; + +C<-1> means connection failure. + +=cut + +sub status { + my $self = shift; + return $self->{status}; +} + +=head2 put_doc + + $node->put_doc( $document_draft ); + +=cut + +sub put_doc { + my $self = shift; + my $doc = shift || return; + $self->shuttle_url( $self->{url} . '/put_doc', 'text/x-estraier-draft', $doc->dump_draft, undef); } +=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) = @_; + + $self->{status} = -1; + + warn "## $url\n"; + $url = new URI($url); + if ( + !$url || !$url->scheme || !$url->scheme eq 'http' || + !$url->host || !$url->port || $url->port < 1 + ) { + carp "can't parse $url\n"; + return -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"; + } + + $query .= '?' . $url->query if ($url->query && ! $reqbody); + + my $headers; + + if ($reqbody) { + $headers .= "POST $query HTTP/1.0\r\n"; + } else { + $headers .= "GET $query HTTP/1.0\r\n"; + } + + $headers .= "Host: " . $url->host . ":" . $url->port . "\r\n"; + $headers .= "Connection: close\r\n"; + $headers .= "User-Agent: Search-Estraier/$Search::Estraier::VERSION\r\n"; + $headers .= "Content-Type: $content_type\r\n"; + $headers .= "Authorization: Basic $self->{auth}\r\n"; + my $len = 0; + { + use bytes; + $len = length($reqbody) if ($reqbody); + } + $headers .= "Content-Length: $len\r\n"; + $headers .= "\r\n"; + + my $sock = IO::Socket::INET->new( + PeerAddr => $host, + PeerPort => $port, + Proto => 'tcp', + Timeout => $self->{timeout} || 90, + ); + + if (! $sock) { + carp "can't open socket to $host:$port"; + return -1; + } + + warn $headers if ($self->{debug}); + + print $sock $headers or + carp "can't send headers to network:\n$headers\n" and return -1; + + if ($reqbody) { + warn $reqbody if ($self->{debug}); + print $sock $reqbody or + carp "can't send request body to network:\n$$reqbody\n" and return -1; + } + + my $line = <$sock>; + chomp($line); + my ($schema, $res_status, undef) = split(/ */, $line, 3); + return if ($schema !~ /^HTTP/ || ! $res_status); + + $self->{status} = $res_status; + warn "## response status: $res_status\n" if ($self->{debug}); + + # skip rest of headers + $line = <$sock>; + while ($line) { + $line = <$sock>; + $line =~ s/[\r\n]+$//; + warn "## ", $line || 'NULL', " ##\n" if ($self->{debug}); + }; + + # read body + $len = 0; + do { + $len = read($sock, my $buf, 8192); + $$resbody .= $buf if ($resbody); + } while ($len); + + warn "## response body:\n$$resbody\n" if ($resbody && $self->{debug}); + + return $self->{status}; +} ###