4 |
use strict; |
use strict; |
5 |
use warnings; |
use warnings; |
6 |
|
|
7 |
our $VERSION = '0.01'; |
our $VERSION = '0.02'; |
8 |
|
|
9 |
=head1 NAME |
=head1 NAME |
10 |
|
|
205 |
|
|
206 |
sub attr_names { |
sub attr_names { |
207 |
my $self = shift; |
my $self = shift; |
208 |
croak "attr_names return array, not scalar" if (! wantarray); |
return unless ($self->{attrs}); |
209 |
|
#croak "attr_names return array, not scalar" if (! wantarray); |
210 |
return sort keys %{ $self->{attrs} }; |
return sort keys %{ $self->{attrs} }; |
211 |
} |
} |
212 |
|
|
222 |
sub attr { |
sub attr { |
223 |
my $self = shift; |
my $self = shift; |
224 |
my $name = shift; |
my $name = shift; |
225 |
|
return unless (defined($name) && $self->{attrs}); |
226 |
return $self->{'attrs'}->{ $name }; |
return $self->{attrs}->{ $name }; |
227 |
} |
} |
228 |
|
|
229 |
|
|
237 |
|
|
238 |
sub texts { |
sub texts { |
239 |
my $self = shift; |
my $self = shift; |
240 |
confess "texts return array, not scalar" if (! wantarray); |
#confess "texts return array, not scalar" if (! wantarray); |
241 |
return @{ $self->{dtexts} }; |
return @{ $self->{dtexts} } if ($self->{dtexts}); |
242 |
} |
} |
243 |
|
|
244 |
|
|
252 |
|
|
253 |
sub cat_texts { |
sub cat_texts { |
254 |
my $self = shift; |
my $self = shift; |
255 |
return join(' ',@{ $self->{dtexts} }); |
return join(' ',@{ $self->{dtexts} }) if ($self->{dtexts}); |
256 |
} |
} |
257 |
|
|
258 |
|
|
461 |
sub attrs { |
sub attrs { |
462 |
my $self = shift; |
my $self = shift; |
463 |
#croak "attrs return array, not scalar" if (! wantarray); |
#croak "attrs return array, not scalar" if (! wantarray); |
464 |
return @{ $self->{attrs} }; |
return @{ $self->{attrs} } if ($self->{attrs}); |
465 |
} |
} |
466 |
|
|
467 |
|
|
525 |
my $self = {@_}; |
my $self = {@_}; |
526 |
bless($self, $class); |
bless($self, $class); |
527 |
|
|
528 |
foreach my $f (qw/uri attrs snippet keywords/) { |
croak "missing uri for ResultDocument" unless defined($self->{uri}); |
|
croak "missing $f for ResultDocument" unless defined($self->{$f}); |
|
|
} |
|
529 |
|
|
530 |
$self ? return $self : return undef; |
$self ? return $self : return undef; |
531 |
} |
} |
699 |
|
|
700 |
my $node = new Search::HyperEstraier::Node; |
my $node = new Search::HyperEstraier::Node; |
701 |
|
|
702 |
|
or optionally with C<url> as parametar |
703 |
|
|
704 |
|
my $node = new Search::HyperEstraier::Node( 'http://localhost:1978/node/test' ); |
705 |
|
|
706 |
=cut |
=cut |
707 |
|
|
708 |
sub new { |
sub new { |
720 |
}; |
}; |
721 |
bless($self, $class); |
bless($self, $class); |
722 |
|
|
723 |
my $args = {@_}; |
if ($#_ == 0) { |
724 |
|
$self->{url} = shift; |
725 |
|
} else { |
726 |
|
my $args = {@_}; |
727 |
|
|
728 |
$self->{debug} = $args->{debug}; |
$self->{debug} = $args->{debug}; |
729 |
warn "## Node debug on\n" if ($self->{debug}); |
warn "## Node debug on\n" if ($self->{debug}); |
730 |
|
} |
731 |
|
|
732 |
$self ? return $self : return undef; |
$self ? return $self : return undef; |
733 |
} |
} |
1183 |
|
|
1184 |
my $rv = $self->shuttle_url( $self->{url} . '/search', |
my $rv = $self->shuttle_url( $self->{url} . '/search', |
1185 |
'application/x-www-form-urlencoded', |
'application/x-www-form-urlencoded', |
1186 |
$self->cond_to_query( $cond ), |
$self->cond_to_query( $cond, $depth ), |
1187 |
\$resbody, |
\$resbody, |
1188 |
); |
); |
1189 |
return if ($rv != 200); |
return if ($rv != 200); |
1277 |
|
|
1278 |
Return URI encoded string generated from Search::Estraier::Condition |
Return URI encoded string generated from Search::Estraier::Condition |
1279 |
|
|
1280 |
my $args = $node->cond_to_query( $cond ); |
my $args = $node->cond_to_query( $cond, $depth ); |
1281 |
|
|
1282 |
=cut |
=cut |
1283 |
|
|
1286 |
|
|
1287 |
my $cond = shift || return; |
my $cond = shift || return; |
1288 |
croak "condition must be Search::Estraier::Condition, not '$cond->isa'" unless ($cond->isa('Search::Estraier::Condition')); |
croak "condition must be Search::Estraier::Condition, not '$cond->isa'" unless ($cond->isa('Search::Estraier::Condition')); |
1289 |
|
my $depth = shift; |
1290 |
|
|
1291 |
my @args; |
my @args; |
1292 |
|
|
1296 |
|
|
1297 |
if (my @attrs = $cond->attrs) { |
if (my @attrs = $cond->attrs) { |
1298 |
for my $i ( 0 .. $#attrs ) { |
for my $i ( 0 .. $#attrs ) { |
1299 |
push @args,'attr' . ($i+1) . '=' . uri_escape( $attrs[$i] ); |
push @args,'attr' . ($i+1) . '=' . uri_escape( $attrs[$i] ) if ($attrs[$i]); |
1300 |
} |
} |
1301 |
} |
} |
1302 |
|
|
1314 |
push @args, 'options=' . $options; |
push @args, 'options=' . $options; |
1315 |
} |
} |
1316 |
|
|
1317 |
push @args, 'depth=' . $self->{depth} if ($self->{depth}); |
push @args, 'depth=' . $depth if ($depth); |
1318 |
push @args, 'wwidth=' . $self->{wwidth}; |
push @args, 'wwidth=' . $self->{wwidth}; |
1319 |
push @args, 'hwidth=' . $self->{hwidth}; |
push @args, 'hwidth=' . $self->{hwidth}; |
1320 |
push @args, 'awidth=' . $self->{awidth}; |
push @args, 'awidth=' . $self->{awidth}; |