4 |
use strict; |
use strict; |
5 |
use warnings; |
use warnings; |
6 |
|
|
7 |
our $VERSION = '0.03_1'; |
our $VERSION = '0.04_1'; |
8 |
|
|
9 |
=head1 NAME |
=head1 NAME |
10 |
|
|
157 |
} elsif ($line =~ m/^$/) { |
} elsif ($line =~ m/^$/) { |
158 |
$in_text = 1; |
$in_text = 1; |
159 |
next; |
next; |
160 |
} elsif ($line =~ m/^(.+)=(.+)$/) { |
} elsif ($line =~ m/^(.+)=(.*)$/) { |
161 |
$self->{attrs}->{ $1 } = $2; |
$self->{attrs}->{ $1 } = $2; |
162 |
next; |
next; |
163 |
} |
} |
164 |
|
|
165 |
warn "draft ignored: $line\n"; |
warn "draft ignored: '$line'\n"; |
166 |
} |
} |
167 |
} |
} |
168 |
|
|
754 |
|
|
755 |
my $node = new Search::HyperEstraier::Node( 'http://localhost:1978/node/test' ); |
my $node = new Search::HyperEstraier::Node( 'http://localhost:1978/node/test' ); |
756 |
|
|
757 |
|
or in more verbose form |
758 |
|
|
759 |
|
my $node = new Search::HyperEstraier::Node( |
760 |
|
url => 'http://localhost:1978/node/test', |
761 |
|
debug => 1, |
762 |
|
croak_on_error => 1 |
763 |
|
); |
764 |
|
|
765 |
|
with following arguments: |
766 |
|
|
767 |
|
=over 4 |
768 |
|
|
769 |
|
=item url |
770 |
|
|
771 |
|
URL to node |
772 |
|
|
773 |
|
=item debug |
774 |
|
|
775 |
|
dumps a B<lot> of debugging output |
776 |
|
|
777 |
|
=item croak_on_error |
778 |
|
|
779 |
|
very helpful during development. It will croak on all errors instead of |
780 |
|
silently returning C<-1> (which is convention of Hyper Estraier API in other |
781 |
|
languages). |
782 |
|
|
783 |
|
=back |
784 |
|
|
785 |
=cut |
=cut |
786 |
|
|
787 |
sub new { |
sub new { |
804 |
} else { |
} else { |
805 |
my $args = {@_}; |
my $args = {@_}; |
806 |
|
|
807 |
$self->{debug} = $args->{debug}; |
%$self = ( %$self, @_ ); |
808 |
|
|
809 |
warn "## Node debug on\n" if ($self->{debug}); |
warn "## Node debug on\n" if ($self->{debug}); |
810 |
} |
} |
811 |
|
|
1447 |
|
|
1448 |
$req->headers->header( 'Host' => $url->host . ":" . $url->port ); |
$req->headers->header( 'Host' => $url->host . ":" . $url->port ); |
1449 |
$req->headers->header( 'Connection', 'close' ); |
$req->headers->header( 'Connection', 'close' ); |
1450 |
$req->headers->header( 'Authorization', 'Basic ' . $self->{auth} ); |
$req->headers->header( 'Authorization', 'Basic ' . $self->{auth} ) if ($self->{auth}); |
1451 |
$req->content_type( $content_type ); |
$req->content_type( $content_type ); |
1452 |
|
|
1453 |
warn $req->headers->as_string,"\n" if ($self->{debug}); |
warn $req->headers->as_string,"\n" if ($self->{debug}); |
1461 |
|
|
1462 |
warn "## response status: ",$res->status_line,"\n" if ($self->{debug}); |
warn "## response status: ",$res->status_line,"\n" if ($self->{debug}); |
1463 |
|
|
|
return -1 if (! $res->is_success); |
|
|
|
|
1464 |
($self->{status}, $self->{status_message}) = split(/\s+/, $res->status_line, 2); |
($self->{status}, $self->{status_message}) = split(/\s+/, $res->status_line, 2); |
1465 |
|
|
1466 |
|
if (! $res->is_success) { |
1467 |
|
if ($self->{croak_on_error}) { |
1468 |
|
croak("can't get $url: ",$res->status_line); |
1469 |
|
} else { |
1470 |
|
return -1; |
1471 |
|
} |
1472 |
|
} |
1473 |
|
|
1474 |
$$resbody .= $res->content; |
$$resbody .= $res->content; |
1475 |
|
|
1476 |
warn "## response body:\n$$resbody\n" if ($resbody && $self->{debug}); |
warn "## response body:\n$$resbody\n" if ($resbody && $self->{debug}); |
1570 |
$reqbody .= '&credit=' . $credit if ($credit > 0); |
$reqbody .= '&credit=' . $credit if ($credit > 0); |
1571 |
|
|
1572 |
$self->shuttle_url( $self->{url} . '/_set_link', |
$self->shuttle_url( $self->{url} . '/_set_link', |
1573 |
'text/plain', |
'application/x-www-form-urlencoded', |
1574 |
$reqbody, |
$reqbody, |
1575 |
undef |
undef |
1576 |
) == 200; |
) == 200; |