From 51d6cd8e2223091f60850c0eecab47a50a21fb30 Mon Sep 17 00:00:00 2001 From: ianb Date: Wed, 20 Sep 2006 01:08:18 +0100 Subject: [PATCH] import of 0.08 --- Changes | 8 + MANIFEST | 2 + META.yml | 2 +- lib/WWW/OpenSearch.pm | 336 +++++++++++++------------- lib/WWW/OpenSearch/Description.pm | 492 ++++++++++++++++++++------------------ lib/WWW/OpenSearch/Image.pm | 55 +++++ lib/WWW/OpenSearch/Query.pm | 51 ++++ lib/WWW/OpenSearch/Response.pm | 402 +++++++++++++++---------------- lib/WWW/OpenSearch/Url.pm | 211 ++++++++-------- t/00_compile.t | 4 +- t/10-description.t | 27 ++- 11 files changed, 879 insertions(+), 711 deletions(-) create mode 100644 lib/WWW/OpenSearch/Image.pm create mode 100644 lib/WWW/OpenSearch/Query.pm diff --git a/Changes b/Changes index 066bf90..b1df0f3 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,13 @@ Revision history for Perl extension WWW::OpenSearch +0.08 Wed Sep 13 2006 + - fix optional attributes for Image + - added strict to Url object + +0.07 Mon Sep 11 2006 + - inflate query and image fields to objects for OSD 1.1 + - pod updates + 0.06_02 Thu Jul 20 2006 - added tests - updated available description info diff --git a/MANIFEST b/MANIFEST index 86e744e..f9d961c 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,6 +1,8 @@ Changes lib/WWW/OpenSearch.pm lib/WWW/OpenSearch/Description.pm +lib/WWW/OpenSearch/Image.pm +lib/WWW/OpenSearch/Query.pm lib/WWW/OpenSearch/Response.pm lib/WWW/OpenSearch/Url.pm Makefile.PL diff --git a/META.yml b/META.yml index 150d3aa..e6677ad 100644 --- a/META.yml +++ b/META.yml @@ -1,7 +1,7 @@ # http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: WWW-OpenSearch -version: 0.06_02 +version: 0.08 version_from: lib/WWW/OpenSearch.pm installdirs: site requires: diff --git a/lib/WWW/OpenSearch.pm b/lib/WWW/OpenSearch.pm index 5985929..e1c0bc8 100644 --- a/lib/WWW/OpenSearch.pm +++ b/lib/WWW/OpenSearch.pm @@ -1,176 +1,176 @@ -package WWW::OpenSearch; - -use strict; -use warnings; - -use base qw( Class::Accessor::Fast ); - -use Carp; -use WWW::OpenSearch::Response; -use WWW::OpenSearch::Description; -use Encode qw( _utf8_off ); - -__PACKAGE__->mk_accessors( qw( description_url agent description ) ); - -our $VERSION = '0.06_02'; - -=head1 NAME - -WWW::OpenSearch - Search A9 OpenSearch compatible engines - -=head1 SYNOPSIS - - use WWW::OpenSearch; - - my $url = "http://bulkfeeds.net/opensearch.xml"; - my $engine = WWW::OpenSearch->new($url); - - my $name = $engine->description->ShortName; - my $tags = $engine->description->Tags; - - # Perform search for "iPod" - my $response = $engine->search("iPod"); - for my $item (@{$response->feed->items}) { - print $item->{description}; - } - - # Retrieve the next page of results - my $next_page = $response->next_page; - for my $item (@{$next_page->feed->items}) { - print $item->{description}; - } - -=head1 DESCRIPTION - -WWW::OpenSearch is a module to search A9's OpenSearch compatible search engines. See http://opensearch.a9.com/ for details. - -=head1 CONSTRUCTOR - -=head2 new( $url [, $useragent] ) - -Constructs a new instance of WWW::OpenSearch using the given -URL as the location of the engine's OpenSearch Description +package WWW::OpenSearch; + +use strict; +use warnings; + +use base qw( Class::Accessor::Fast ); + +use Carp; +use WWW::OpenSearch::Response; +use WWW::OpenSearch::Description; +use Encode qw( _utf8_off ); + +__PACKAGE__->mk_accessors( qw( description_url agent description ) ); + +our $VERSION = '0.08'; + +=head1 NAME + +WWW::OpenSearch - Search A9 OpenSearch compatible engines + +=head1 SYNOPSIS + + use WWW::OpenSearch; + + my $url = "http://bulkfeeds.net/opensearch.xml"; + my $engine = WWW::OpenSearch->new($url); + + my $name = $engine->description->ShortName; + my $tags = $engine->description->Tags; + + # Perform search for "iPod" + my $response = $engine->search("iPod"); + for my $item (@{$response->feed->items}) { + print $item->{description}; + } + + # Retrieve the next page of results + my $next_page = $response->next_page; + for my $item (@{$next_page->feed->items}) { + print $item->{description}; + } + +=head1 DESCRIPTION + +WWW::OpenSearch is a module to search A9's OpenSearch compatible search engines. See http://opensearch.a9.com/ for details. + +=head1 CONSTRUCTOR + +=head2 new( $url [, $useragent] ) + +Constructs a new instance of WWW::OpenSearch using the given +URL as the location of the engine's OpenSearch Description document (retrievable via the description_url accessor). Pass any LWP::UserAgent compatible object if you wish to override the default -agent. - -=head1 METHODS - -=head2 fetch_description( [ $url ] ) - -Fetches the OpenSearch Descsription found either at the given URL -or at the URL specified by the description_url accessor. Fetched -description may be accessed via the description accessor. - -=head2 search( $query [, \%params] ) - -Searches the engine for the given query using the given -search parameters. Valid search parameters include: - -=over 4 - -=item * startPage - -=item * totalResults - -=item * startIndex - -=item * itemsPerPage - -=back - -See http://opensearch.a9.com/spec/1.1/response/#elements for details. - -=head2 do_search( $url [, $method] ) - -Performs a request for the given URL and returns a -WWW::OpenSearch::Response object. Method defaults to 'GET'. - -=head1 ACCESSORS - -=head2 description_url( [$description_url] ) - -=head2 agent( [$agent] ) - -=head2 description( [$description] ) - -=head1 AUTHOR - -=over 4 - -=item * Tatsuhiko Miyagawa Emiyagawa@bulknews.netE - -=item * Brian Cassidy Ebricas@cpan.orgE - -=back - -=head1 COPYRIGHT AND LICENSE - -Copyright 2006 by Tatsuhiko Miyagawa and Brian Cassidy - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -=cut - -sub new { - my( $class, $url, $agent ) = @_; - - croak( "No OpenSearch Description url provided" ) unless $url; - +agent. + +=head1 METHODS + +=head2 fetch_description( [ $url ] ) + +Fetches the OpenSearch Descsription found either at the given URL +or at the URL specified by the description_url accessor. Fetched +description may be accessed via the description accessor. + +=head2 search( $query [, \%params] ) + +Searches the engine for the given query using the given +search parameters. Valid search parameters include: + +=over 4 + +=item * startPage + +=item * totalResults + +=item * startIndex + +=item * itemsPerPage + +=back + +See http://opensearch.a9.com/spec/1.1/response/#elements for details. + +=head2 do_search( $url [, $method] ) + +Performs a request for the given URL and returns a +WWW::OpenSearch::Response object. Method defaults to 'GET'. + +=head1 ACCESSORS + +=head2 description_url( [$description_url] ) + +=head2 agent( [$agent] ) + +=head2 description( [$description] ) + +=head1 AUTHOR + +=over 4 + +=item * Tatsuhiko Miyagawa Emiyagawa@bulknews.netE + +=item * Brian Cassidy Ebricas@cpan.orgE + +=back + +=head1 COPYRIGHT AND LICENSE + +Copyright 2006 by Tatsuhiko Miyagawa and Brian Cassidy + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut + +sub new { + my( $class, $url, $agent ) = @_; + + croak( "No OpenSearch Description url provided" ) unless $url; + my $self = $class->SUPER::new; unless( $agent ) { require LWP::UserAgent; $agent = LWP::UserAgent->new( agent => join( '/', ref $self, $VERSION ) ); } - - $self->description_url( $url ); - $self->agent( $agent ); - - $self->fetch_description; - - return $self; -} - -sub fetch_description { - my( $self, $url ) = @_; - $url ||= $self->description_url; - $self->description_url( $url ); - my $response = $self->agent->get( $url ); - - unless( $response->is_success ) { - croak "Error while fetching $url: " . $response->status_line; - } - - $self->description( WWW::OpenSearch::Description->new( $response->content ) ); -} - -sub search { - my( $self, $query, $params ) = @_; - - $params ||= { }; - $params->{ searchTerms } = $query; - _utf8_off( $params->{ searchTerms } ); - - my $url = $self->description->get_best_url; - return $self->do_search( $url->prepare_query( $params ), $url->method ); -} - -sub do_search { - my( $self, $url, $method ) = @_; - - $method = lc( $method ) || 'get'; - - my $response; - if( $method eq 'post' ) { - $response = $self->agent->post( @$url ); - } - else { - $response = $self->agent->$method( $url ); - } - - return WWW::OpenSearch::Response->new( $self, $response ); -} - -1; + + $self->description_url( $url ); + $self->agent( $agent ); + + $self->fetch_description; + + return $self; +} + +sub fetch_description { + my( $self, $url ) = @_; + $url ||= $self->description_url; + $self->description_url( $url ); + my $response = $self->agent->get( $url ); + + unless( $response->is_success ) { + croak "Error while fetching $url: " . $response->status_line; + } + + $self->description( WWW::OpenSearch::Description->new( $response->content ) ); +} + +sub search { + my( $self, $query, $params ) = @_; + + $params ||= { }; + $params->{ searchTerms } = $query; + _utf8_off( $params->{ searchTerms } ); + + my $url = $self->description->get_best_url; + return $self->do_search( $url->prepare_query( $params ), $url->method ); +} + +sub do_search { + my( $self, $url, $method ) = @_; + + $method = lc( $method ) || 'get'; + + my $response; + if( $method eq 'post' ) { + $response = $self->agent->post( @$url ); + } + else { + $response = $self->agent->$method( $url ); + } + + return WWW::OpenSearch::Response->new( $self, $response ); +} + +1; diff --git a/lib/WWW/OpenSearch/Description.pm b/lib/WWW/OpenSearch/Description.pm index 6ed1e9a..807c576 100644 --- a/lib/WWW/OpenSearch/Description.pm +++ b/lib/WWW/OpenSearch/Description.pm @@ -1,245 +1,269 @@ -package WWW::OpenSearch::Description; - -use strict; -use warnings; - -use base qw( Class::Accessor::Fast ); - -use Carp; -use XML::LibXML; -use WWW::OpenSearch::Url; - -my @columns = qw( - AdultContent Contact Description Developer - Format Image LongName Query - SampleSearch ShortName SyndicationRight Tags +package WWW::OpenSearch::Description; + +use strict; +use warnings; + +use base qw( Class::Accessor::Fast ); + +use Carp; +use XML::LibXML; +use WWW::OpenSearch::Url; +use WWW::OpenSearch::Query; +use WWW::OpenSearch::Image; + +my @columns = qw( + AdultContent Contact Description Developer + Format Image LongName Query + SampleSearch ShortName SyndicationRight Tags Url Attribution InputEncoding OutputEncoding - Language -); - -__PACKAGE__->mk_accessors( qw( version ns ), map { lc } @columns ); - -=head1 NAME - -WWW::OpenSearch::Description - Encapsulate an OpenSearch Description -provided by an A9 OpenSearch compatible engine - -=head1 SYNOPSIS - - use WWW::OpenSearch; - - my $url = "http://bulkfeeds.net/opensearch.xml"; - my $engine = WWW::OpenSearch->new($url); - my $description = $engine->description; - - my $format = $description->Format; # or $description->format - my $longname = $description->LongName; # or $description->longname - -=head1 DESCRIPTION - -WWW::OpenSearch::Description is a module designed to encapsulate an -OpenSearch Description provided by an A9 OpenSearch compatible engine. -See http://opensearch.a9.com/spec/1.1/description/ for details. - -=head1 CONSTRUCTOR - -=head2 new( [ $xml ] ) - -Constructs a new instance of WWW::OpenSearch::Description. If scalar -parameter $xml is provided, data will be automatically loaded from it -using load( $xml ). - -=head1 METHODS - -=head2 load( $xml ) - + Language +); + +__PACKAGE__->mk_accessors( qw( version ns ), map { lc } @columns ); + +=head1 NAME + +WWW::OpenSearch::Description - Encapsulate an OpenSearch Description +provided by an A9 OpenSearch compatible engine + +=head1 SYNOPSIS + + use WWW::OpenSearch; + + my $url = "http://bulkfeeds.net/opensearch.xml"; + my $engine = WWW::OpenSearch->new($url); + my $description = $engine->description; + + my $format = $description->Format; # or $description->format + my $longname = $description->LongName; # or $description->longname + +=head1 DESCRIPTION + +WWW::OpenSearch::Description is a module designed to encapsulate an +OpenSearch Description provided by an A9 OpenSearch compatible engine. +See http://opensearch.a9.com/spec/1.1/description/ for details. + +=head1 CONSTRUCTOR + +=head2 new( [ $xml ] ) + +Constructs a new instance of WWW::OpenSearch::Description. If scalar +parameter $xml is provided, data will be automatically loaded from it +using load( $xml ). + +=head1 METHODS + +=head2 load( $xml ) + Loads description data by parsing provided argument using XML::LibXML. =head2 urls( ) -Return all of the urls associated with this description in an array. - -=head2 get_best_url( ) - -Attempts to retrieve the best URL associated with this description, based -on the following content types (from most preferred to least preferred): - -=over 4 - -=item * application/atom+xml - -=item * application/rss+xml - -=item * text/xml - -=back - -=head2 get_url_by_type( $type ) - -Retrieves the first WWW::OpenSearch::URL associated with this description -whose type is equal to $type. - -=head1 ACCESSORS - -=head2 version( ) - -=head2 ns( ) - -=head2 AdultContent( ) - -=head2 Contact( ) - -=head2 Description( ) - -=head2 Developer( ) - -=head2 Format( ) - -=head2 Image( ) - -=head2 LongName( ) - -=head2 Query( ) - -=head2 SampleSearch( ) - -=head2 ShortName( ) - -=head2 SyndicationRight( ) - -=head2 Tags( ) - -=head2 Url( ) - -=head1 AUTHOR - -=over 4 - -=item * Tatsuhiko Miyagawa Emiyagawa@bulknews.netE - -=item * Brian Cassidy Ebricas@cpan.orgE - -=back - -=head1 COPYRIGHT AND LICENSE - -Copyright 2006 by Tatsuhiko Miyagawa and Brian Cassidy - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -=cut - -for( @columns ) { - no strict 'refs'; - my $col = lc; - *$_ = \&$col; -} - -sub new { - my $class = shift; - my $xml = shift; - - my $self = $class->SUPER::new; - - eval{ $self->load( $xml ); } if $xml; - if( $@ ) { - croak "Error while parsing Description XML: $@"; - } - - return $self; -} - -sub load { - my $self = shift; - my $xml = shift; - - my $parser = XML::LibXML->new; - my $doc = $parser->parse_string( $xml ); - my $element = $doc->documentElement; - my $nodename = $element->nodeName; - - croak "Node should be OpenSearchDescription: $nodename" if $nodename ne 'OpenSearchDescription'; - - my $ns = $element->getNamespace->value; - my $version; - if( $ns eq 'http://a9.com/-/spec/opensearch/1.1/' ) { - $self->ns( $ns ); - $version = '1.1'; - } - else { - $version = '1.0'; - } - $self->version( $version ); - - for my $column ( @columns ) { - my $node = $doc->documentElement->getChildrenByTagName( $column ) or next; - if( $column eq 'Url' ) { - if( $version eq '1.0' ) { - $self->Url( [ WWW::OpenSearch::Url->new( template => $node->string_value, type => 'application/rss+xml' ) ] ); - next; - } - - my @url; - for my $urlnode ( $node->get_nodelist ) { - my $type = $urlnode->getAttributeNode( 'type' )->value; - my $url = $urlnode->getAttributeNode( 'template' )->value; - $url =~ s/\?}/}/g; # optional - my $method = $urlnode->getAttributeNode( 'method' ); - $method = $method->value if $method; - - my %params; - for( $urlnode->getChildrenByTagName( 'Param' ) ) { - my $param = $_->getAttributeNode( 'name' )->value; +Return all of the urls associated with this description in an array. + +=head2 get_best_url( ) + +Attempts to retrieve the best URL associated with this description, based +on the following content types (from most preferred to least preferred): + +=over 4 + +=item * application/atom+xml + +=item * application/rss+xml + +=item * text/xml + +=back + +=head2 get_url_by_type( $type ) + +Retrieves the first WWW::OpenSearch::URL associated with this description +whose type is equal to $type. + +=head1 ACCESSORS + +=head2 version( ) + +=head2 ns( ) + +=head2 AdultContent( ) + +=head2 Contact( ) + +=head2 Description( ) + +=head2 Developer( ) + +=head2 Format( ) + +=head2 Image( ) + +=head2 LongName( ) + +=head2 Query( ) + +=head2 SampleSearch( ) + +=head2 ShortName( ) + +=head2 SyndicationRight( ) + +=head2 Tags( ) + +=head2 Url( ) + +=head1 AUTHOR + +=over 4 + +=item * Tatsuhiko Miyagawa Emiyagawa@bulknews.netE + +=item * Brian Cassidy Ebricas@cpan.orgE + +=back + +=head1 COPYRIGHT AND LICENSE + +Copyright 2006 by Tatsuhiko Miyagawa and Brian Cassidy + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut + +for( @columns ) { + no strict 'refs'; + my $col = lc; + *$_ = \&$col; +} + +sub new { + my $class = shift; + my $xml = shift; + + my $self = $class->SUPER::new; + + eval{ $self->load( $xml ); } if $xml; + if( $@ ) { + croak "Error while parsing Description XML: $@"; + } + + return $self; +} + +sub load { + my $self = shift; + my $xml = shift; + + my $parser = XML::LibXML->new; + my $doc = $parser->parse_string( $xml ); + my $element = $doc->documentElement; + my $nodename = $element->nodeName; + + croak "Node should be OpenSearchDescription: $nodename" if $nodename ne 'OpenSearchDescription'; + + my $ns = $element->getNamespace->value; + my $version; + if( $ns eq 'http://a9.com/-/spec/opensearch/1.1/' ) { + $self->ns( $ns ); + $version = '1.1'; + } + else { + $version = '1.0'; + } + $self->version( $version ); + + for my $column ( @columns ) { + my $node = $doc->documentElement->getChildrenByTagName( $column ) or next; + if( $column eq 'Url' ) { + if( $version eq '1.0' ) { + $self->Url( [ WWW::OpenSearch::Url->new( template => $node->string_value, type => 'application/rss+xml' ) ] ); + next; + } + + my @url; + for my $urlnode ( $node->get_nodelist ) { + my $type = $urlnode->getAttributeNode( 'type' )->value; + my $url = $urlnode->getAttributeNode( 'template' )->value; + $url =~ s/\?}/}/g; # optional + my $method = $urlnode->getAttributeNode( 'method' ); + $method = $method->value if $method; + + my %params; + for( $urlnode->getChildrenByTagName( 'Param' ) ) { + my $param = $_->getAttributeNode( 'name' )->value; my $value = $_->getAttributeNode( 'value' )->value; - $value =~ s/\?}/}/g; # optional - $params{ $param } = $value; - } - - push @url, WWW::OpenSearch::Url->new( template => $url, type => $type, method => $method, params => \%params ); - } - $self->Url( \@url ); - } - elsif( $version eq '1.1' and $column eq 'Query' ) { - my $query = ( $node->get_nodelist )[ 0 ]; - next if $query->getAttributeNode( 'role' )->value eq 'example'; - $self->SampleSearch( $query->getAttributeNode( 'searchTerms' )->value ); - } - elsif( $version eq '1.0' and $column eq 'Format' ) { - $self->Format( $node->string_value ); - $self->ns( $self->Format ); - } - else { - $self->$column( $node->string_value ); - } - } -} - -sub get_best_url { - my $self = shift; - - return $self->get_url_by_type( 'application/atom+xml' ) - || $self->get_url_by_type( 'application/rss+xml' ) - || $self->get_url_by_type( 'text/xml' ) - || $self->url->[ 0 ]; -} - -sub get_url_by_type { - my $self = shift; - my $type = shift; - - my $template; - for( $self->urls ) { - $template = $_ if $_->type eq $type; - last; - }; - - return $template; -} + $value =~ s/\?}/}/g; # optional + $params{ $param } = $value; + } + + push @url, WWW::OpenSearch::Url->new( template => $url, type => $type, method => $method, params => \%params ); + } + $self->Url( \@url ); + } + elsif( $version eq '1.1' and $column eq 'Query' ) { + my $queries = $self->query || []; + + for my $node ( $node->get_nodelist ) { + my $query = WWW::OpenSearch::Query->new( { + map { $_ => $node->getAttributeNode( $_ )->value } qw( role searchTerms ) + } ); + + push @$queries, $query; + } + + $self->query( $queries ); + } + elsif( $version eq '1.1' and $column eq 'Image' ) { + my $images = $self->image || []; + + for my $node ( $node->get_nodelist ) { + my $image = WWW::OpenSearch::Image->new( { + ( map { my $attr = $node->getAttributeNode( $_ ); $attr ? ($_ => $attr->value) : () } qw( height width type ) ), + url => $node->string_value + } ); + + push @$images, $image; + } + + $self->image( $images ); + } + elsif( $version eq '1.0' and $column eq 'Format' ) { + $self->Format( $node->string_value ); + $self->ns( $self->Format ); + } + else { + $self->$column( $node->string_value ); + } + } +} + +sub get_best_url { + my $self = shift; + + return $self->get_url_by_type( 'application/atom+xml' ) + || $self->get_url_by_type( 'application/rss+xml' ) + || $self->get_url_by_type( 'text/xml' ) + || $self->url->[ 0 ]; +} + +sub get_url_by_type { + my $self = shift; + my $type = shift; + + my $template; + for( $self->urls ) { + $template = $_ if $_->type eq $type; + last; + }; + + return $template; +} sub urls { my $self = shift; return @{ $self->url }; } - -1; + +1; diff --git a/lib/WWW/OpenSearch/Image.pm b/lib/WWW/OpenSearch/Image.pm new file mode 100644 index 0000000..945b58e --- /dev/null +++ b/lib/WWW/OpenSearch/Image.pm @@ -0,0 +1,55 @@ +package WWW::OpenSearch::Image; + +use strict; +use warnings; + +use base qw( Class::Accessor::Fast ); + +__PACKAGE__->mk_accessors( qw( height width type url ) ); + +=head1 NAME + +WWW::OpenSearch::Image - Object to represent an image + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head1 CONSTRUCTOR + +=head2 new( [%options] ) + +=head1 ACCESSORS + +=over 4 + +=item * height + +=item * width + +=item * type + +=item * url + +=back + +=head1 AUTHOR + +=over 4 + +=item * Tatsuhiko Miyagawa Emiyagawa@bulknews.netE + +=item * Brian Cassidy Ebricas@cpan.orgE + +=back + +=head1 COPYRIGHT AND LICENSE + +Copyright 2006 by Tatsuhiko Miyagawa and Brian Cassidy + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/WWW/OpenSearch/Query.pm b/lib/WWW/OpenSearch/Query.pm new file mode 100644 index 0000000..52d7eff --- /dev/null +++ b/lib/WWW/OpenSearch/Query.pm @@ -0,0 +1,51 @@ +package WWW::OpenSearch::Query; + +use strict; +use warnings; + +use base qw( Class::Accessor::Fast ); + +__PACKAGE__->mk_accessors( qw( role searchTerms ) ); + +=head1 NAME + +WWW::OpenSearch::Query - Object to represent a sample query + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head1 CONSTRUCTOR + +=head2 new( [%options] ) + +=head1 ACCESSORS + +=over 4 + +=item * role + +=item * searchTerms + +=back + +=head1 AUTHOR + +=over 4 + +=item * Tatsuhiko Miyagawa Emiyagawa@bulknews.netE + +=item * Brian Cassidy Ebricas@cpan.orgE + +=back + +=head1 COPYRIGHT AND LICENSE + +Copyright 2006 by Tatsuhiko Miyagawa and Brian Cassidy + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/WWW/OpenSearch/Response.pm b/lib/WWW/OpenSearch/Response.pm index 1cb653b..816476a 100644 --- a/lib/WWW/OpenSearch/Response.pm +++ b/lib/WWW/OpenSearch/Response.pm @@ -1,192 +1,192 @@ -package WWW::OpenSearch::Response; - -use strict; -use warnings; - -use base qw( HTTP::Response Class::Accessor::Fast ); - +package WWW::OpenSearch::Response; + +use strict; +use warnings; + +use base qw( HTTP::Response Class::Accessor::Fast ); + use XML::Feed; -use URI; -use Data::Page; - -__PACKAGE__->mk_accessors( qw( feed pager parent ) ); - -=head1 NAME - -WWW::OpenSearch::Response - Encapsulate a response received from -an A9 OpenSearch compatible engine - -=head1 SYNOPSIS - - use WWW::OpenSearch; - - my $url = "http://bulkfeeds.net/opensearch.xml"; - my $engine = WWW::OpenSearch->new($url); - - # Retrieve page 4 of search results for "iPod" - my $response = $engine->search("iPod",{ startPage => 4 }); - for my $item (@{$response->feed->items}) { - print $item->{description}; - } - - # Retrieve page 3 of results - $response = $response->previous_page; - - # Retrieve page 5 of results - $response = $response->next_page; - -=head1 DESCRIPTION - -WWW::OpenSearch::Response is a module designed to encapsulate a -response received from an A9 OpenSearch compatible engine. -See http://opensearch.a9.com/spec/1.1/response/ for details. - -=head1 CONSTRUCTOR - -=head2 new( $parent, $response ) - -Constructs a new instance of WWW::OpenSearch::Response. Arguments -include the WWW::OpenSearch object which initiated the search (parent) -and the HTTP::Response returned by the search request. - -=head1 METHODS - -=head2 parse_response( ) - -Parses the content of the HTTP response using XML::Feed. If successful, -parse_feed( ) is also called. - -=head2 parse_feed( ) - -Parses the XML::Feed originally parsed from the HTTP response content. -Sets the pager object appropriately. - -=head2 previous_page( ) / next_page( ) - -Performs another search on the parent object, returning a -WWW::OpenSearch::Response instance containing the previous/next page -of results. If the current response includes a <link rel="previous/next" -href="..." /> tag, the page will simply be the parsed content of the URL -specified by the tag's href attribute. However, if the current response does not -include the appropriate link, a new query is constructed using the startPage -or startIndex query arguments. - -=head2 _get_link( $type ) - -Gets the href attribute of the first link whose rel attribute -is equal to $type. - -=head1 ACCESSORS - -=head2 feed( ) - -=head2 pager( ) - -=head2 parent( ) - -=head1 AUTHOR - -=over 4 - -=item * Tatsuhiko Miyagawa Emiyagawa@bulknews.netE - -=item * Brian Cassidy Ebricas@cpan.orgE - -=back - -=head1 COPYRIGHT AND LICENSE - -Copyright 2006 by Tatsuhiko Miyagawa and Brian Cassidy - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -=cut - -sub new { - my $class = shift; - my $parent = shift; - my $response = shift; - - my $self = bless $response, $class; - - $self->parent( $parent ); - return $self unless $self->is_success; - - $self->parse_response; - - return $self; -} - -sub parse_response { - my $self = shift; - - my $content = $self->content; - my $feed = XML::Feed->parse( \$content ); - - return if XML::Feed->errstr; - $self->feed( $feed ); - - $self->parse_feed; -} - -sub parse_feed { - my $self = shift; - my $pager = Data::Page->new; - - my $feed = $self->feed; - my $format = $feed->format; - my $ns = $self->parent->description->ns; - - # TODO - # adapt these for any number of opensearch elements in - # the feed or in each entry - - if( my $atom = $feed->{ atom } ) { - my $total = $atom->get( $ns, 'totalResults' ); - my $perpage = $atom->get( $ns, 'itemsPerPage' ); - my $start = $atom->get( $ns, 'startIndex' ); - - $pager->total_entries( $total ); - $pager->entries_per_page( $perpage ); - $pager->current_page( $start ? ( $start - 1 ) / $perpage + 1 : 0 ) - } - elsif( my $rss = $feed->{ rss } ) { - if ( my $page = $rss->channel->{ $ns } ) { - $pager->total_entries( $page->{ totalResults } ); - $pager->entries_per_page( $page->{ itemsPerPage } ); - my $start = $page->{ startIndex }; - $pager->current_page( $start ? ( $start - 1 ) / $page->{ itemsPerPage } + 1 : 0 ) - } - } - $self->pager( $pager ); -} - -sub next_page { - my $self = shift; - return $self->_get_page( 'next' ); -} - -sub previous_page { +use URI; +use Data::Page; + +__PACKAGE__->mk_accessors( qw( feed pager parent ) ); + +=head1 NAME + +WWW::OpenSearch::Response - Encapsulate a response received from +an A9 OpenSearch compatible engine + +=head1 SYNOPSIS + + use WWW::OpenSearch; + + my $url = "http://bulkfeeds.net/opensearch.xml"; + my $engine = WWW::OpenSearch->new($url); + + # Retrieve page 4 of search results for "iPod" + my $response = $engine->search("iPod",{ startPage => 4 }); + for my $item (@{$response->feed->items}) { + print $item->{description}; + } + + # Retrieve page 3 of results + $response = $response->previous_page; + + # Retrieve page 5 of results + $response = $response->next_page; + +=head1 DESCRIPTION + +WWW::OpenSearch::Response is a module designed to encapsulate a +response received from an A9 OpenSearch compatible engine. +See http://opensearch.a9.com/spec/1.1/response/ for details. + +=head1 CONSTRUCTOR + +=head2 new( $parent, $response ) + +Constructs a new instance of WWW::OpenSearch::Response. Arguments +include the WWW::OpenSearch object which initiated the search (parent) +and the HTTP::Response returned by the search request. + +=head1 METHODS + +=head2 parse_response( ) + +Parses the content of the HTTP response using XML::Feed. If successful, +parse_feed( ) is also called. + +=head2 parse_feed( ) + +Parses the XML::Feed originally parsed from the HTTP response content. +Sets the pager object appropriately. + +=head2 previous_page( ) / next_page( ) + +Performs another search on the parent object, returning a +WWW::OpenSearch::Response instance containing the previous/next page +of results. If the current response includes a <link rel="previous/next" +href="..." /> tag, the page will simply be the parsed content of the URL +specified by the tag's href attribute. However, if the current response does not +include the appropriate link, a new query is constructed using the startPage +or startIndex query arguments. + +=head2 _get_link( $type ) + +Gets the href attribute of the first link whose rel attribute +is equal to $type. + +=head1 ACCESSORS + +=head2 feed( ) + +=head2 pager( ) + +=head2 parent( ) + +=head1 AUTHOR + +=over 4 + +=item * Tatsuhiko Miyagawa Emiyagawa@bulknews.netE + +=item * Brian Cassidy Ebricas@cpan.orgE + +=back + +=head1 COPYRIGHT AND LICENSE + +Copyright 2006 by Tatsuhiko Miyagawa and Brian Cassidy + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut + +sub new { + my $class = shift; + my $parent = shift; + my $response = shift; + + my $self = bless $response, $class; + + $self->parent( $parent ); + return $self unless $self->is_success; + + $self->parse_response; + + return $self; +} + +sub parse_response { + my $self = shift; + + my $content = $self->content; + my $feed = XML::Feed->parse( \$content ); + + return if XML::Feed->errstr; + $self->feed( $feed ); + + $self->parse_feed; +} + +sub parse_feed { + my $self = shift; + my $pager = Data::Page->new; + + my $feed = $self->feed; + my $format = $feed->format; + my $ns = $self->parent->description->ns; + + # TODO + # adapt these for any number of opensearch elements in + # the feed or in each entry + + if( my $atom = $feed->{ atom } ) { + my $total = $atom->get( $ns, 'totalResults' ); + my $perpage = $atom->get( $ns, 'itemsPerPage' ); + my $start = $atom->get( $ns, 'startIndex' ); + + $pager->total_entries( $total ); + $pager->entries_per_page( $perpage ); + $pager->current_page( $start ? ( $start - 1 ) / $perpage + 1 : 0 ) + } + elsif( my $rss = $feed->{ rss } ) { + if ( my $page = $rss->channel->{ $ns } ) { + $pager->total_entries( $page->{ totalResults } ); + $pager->entries_per_page( $page->{ itemsPerPage } ); + my $start = $page->{ startIndex }; + $pager->current_page( $start ? ( $start - 1 ) / $page->{ itemsPerPage } + 1 : 0 ) + } + } + $self->pager( $pager ); +} + +sub next_page { + my $self = shift; + return $self->_get_page( 'next' ); +} + +sub previous_page { my $self = shift; - return $self->_get_page( 'previous' ); + return $self->_get_page( 'previous' ); } sub _get_page { my( $self, $direction ) = @_; my $pager = $self->pager; - my $pagermethod = "${direction}_page"; - my $page = $pager->$pagermethod; - return unless $page; + my $pagermethod = "${direction}_page"; + my $page = $pager->$pagermethod; + return unless $page; my $request = $self->request; my $method = lc $request->method; - if( $method ne 'post' ) { # force query build on POST - my $link = $self->_get_link( $direction ); + if( $method ne 'post' ) { # force query build on POST + my $link = $self->_get_link( $direction ); return $self->parent->do_search( $link, $method ) if $link; - } - + } + my $template = $self->parent->description->get_best_url; my( $param, $query ); if( $method eq 'post' ) { @@ -195,11 +195,11 @@ sub _get_page { } else { $query = { $self->request->uri->query_form }; - } - - if( $param = $template->macros->{ startPage } ) { - $query->{ $param } = $pager->$pagermethod - } + } + + if( $param = $template->macros->{ startPage } ) { + $query->{ $param } = $pager->$pagermethod + } elsif( $param = $template->macros->{ startIndex } ) { if( $query->{ $param } ) { $query->{ $param } = $direction eq 'previous' @@ -210,24 +210,24 @@ sub _get_page { $query->{ $param } = $direction eq 'previous' ? 1 : $pager->entries_per_page + 1; - } - } - - return $self->parent->do_search( $template->prepare_query( $query ), $method ); -} - -sub _get_link { - my $self = shift; - my $type = shift; - my $feed = $self->feed->{ atom }; - - return unless $feed; - - for( $feed->link ) { - return $_->get( 'href' ) if $_->get( 'rel' ) eq $type; + } } - return; -} - -1; + return $self->parent->do_search( $template->prepare_query( $query ), $method ); +} + +sub _get_link { + my $self = shift; + my $type = shift; + my $feed = $self->feed->{ atom }; + + return unless $feed; + + for( $feed->link ) { + return $_->get( 'href' ) if $_->get( 'rel' ) eq $type; + } + + return; +} + +1; diff --git a/lib/WWW/OpenSearch/Url.pm b/lib/WWW/OpenSearch/Url.pm index 33cbd0a..5303930 100644 --- a/lib/WWW/OpenSearch/Url.pm +++ b/lib/WWW/OpenSearch/Url.pm @@ -1,108 +1,125 @@ -package WWW::OpenSearch::Url; - -use base qw( Class::Accessor::Fast ); - -use URI; -use URI::Escape; - -__PACKAGE__->mk_accessors( qw( type template method params macros ) ); - -=head1 NAME - -WWW::OpenSearch::Url - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -=head1 CONSTRUCTOR - -=head2 new( [%options] ) - -=head1 METHODS - -=head2 parse_macros( ) - -=head2 prepare_query( [ \%params ] ) - -=head1 ACCESSORS - -=head1 AUTHOR - -=over 4 - -=item * Tatsuhiko Miyagawa Emiyagawa@bulknews.netE - -=item * Brian Cassidy Ebricas@cpan.orgE - -=back - -=head1 COPYRIGHT AND LICENSE - -Copyright 2006 by Tatsuhiko Miyagawa and Brian Cassidy - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -=cut - -sub new { - my( $class, %options ) = @_; - - $options{ method } ||= 'GET'; - $options{ template } = URI->new( $options{ template } ); - +package WWW::OpenSearch::Url; + +use strict; +use warnings; + +use base qw( Class::Accessor::Fast ); + +use URI; +use URI::Escape; + +__PACKAGE__->mk_accessors( qw( type template method params macros ) ); + +=head1 NAME + +WWW::OpenSearch::Url - Object to represent a target URL + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head1 CONSTRUCTOR + +=head2 new( [%options] ) + +=head1 METHODS + +=head2 parse_macros( ) + +=head2 prepare_query( [ \%params ] ) + +=head1 ACCESSORS + +=over 4 + +=item * type + +=item * template + +=item * method + +=item * params + +=item * macros + +=back + +=head1 AUTHOR + +=over 4 + +=item * Tatsuhiko Miyagawa Emiyagawa@bulknews.netE + +=item * Brian Cassidy Ebricas@cpan.orgE + +=back + +=head1 COPYRIGHT AND LICENSE + +Copyright 2006 by Tatsuhiko Miyagawa and Brian Cassidy + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut + +sub new { + my( $class, %options ) = @_; + + $options{ method } ||= 'GET'; + $options{ template } = URI->new( $options{ template } ); + my $self = $class->SUPER::new( \%options ); - $self->parse_macros; - - return $self; -} - -sub parse_macros { - my $self = shift; - + $self->parse_macros; + + return $self; +} + +sub parse_macros { + my $self = shift; + my %query = $self->method eq 'post' ? %{ $self->params } - : $self->template->query_form; - - my %macros; - for( keys %query ) { - if( $query{ $_ } =~ /^{(.+)}$/ ) { - $macros{ $1 } = $_; - } - } - - $self->macros( \%macros ); -} - -sub prepare_query { - my( $self, $params ) = @_; - my $url = $self->template->clone; - - $params->{ startIndex } ||= 1; - $params->{ startPage } ||= 1; - $params->{ language } ||= '*'; - $params->{ outputEncoding } ||= 'UTF-8'; - $params->{ inputEncoding } ||= 'UTF-8'; - - my $macros = $self->macros; + : $self->template->query_form; + + my %macros; + for( keys %query ) { + if( $query{ $_ } =~ /^{(.+)}$/ ) { + $macros{ $1 } = $_; + } + } + + $self->macros( \%macros ); +} + +sub prepare_query { + my( $self, $params ) = @_; + my $url = $self->template->clone; + + $params->{ startIndex } ||= 1; + $params->{ startPage } ||= 1; + $params->{ language } ||= '*'; + $params->{ outputEncoding } ||= 'UTF-8'; + $params->{ inputEncoding } ||= 'UTF-8'; + + my $macros = $self->macros; # attempt to handle POST if( $self->method eq 'post' ) { my $post = $self->params; - for( keys %macros ) { - $post->{ $macros->{ $_ } } = $params->{ $_ }; + for( keys %$macros ) { + $post->{ $macros->{ $_ } } = $params->{ $_ }; } return [ $url, $post ]; } - my $query = { $url->query_form }; - for( keys %$macros ) { - $query->{ $macros->{ $_ } } = $params->{ $_ }; - } - - $url->query_form( $query ); - return $url; -} - -1; + my $query = { $url->query_form }; + for( keys %$macros ) { + $query->{ $macros->{ $_ } } = $params->{ $_ }; + } + + $url->query_form( $query ); + return $url; +} + +1; diff --git a/t/00_compile.t b/t/00_compile.t index 208a797..32a1ed5 100644 --- a/t/00_compile.t +++ b/t/00_compile.t @@ -1,9 +1,11 @@ use strict; -use Test::More tests => 4; +use Test::More tests => 6; BEGIN { use_ok 'WWW::OpenSearch'; use_ok 'WWW::OpenSearch::Description'; use_ok 'WWW::OpenSearch::Response'; use_ok 'WWW::OpenSearch::Url'; + use_ok 'WWW::OpenSearch::Query'; + use_ok 'WWW::OpenSearch::Image'; } diff --git a/t/10-description.t b/t/10-description.t index 4270b3b..4e23a8c 100644 --- a/t/10-description.t +++ b/t/10-description.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 38; +use Test::More tests => 48; use_ok( 'WWW::OpenSearch::Description' ); @@ -27,7 +27,7 @@ use_ok( 'WWW::OpenSearch::Description' ); is( $osd->contact, 'admin@example.com' ); # count the urls - is( $osd->urls, 1 ); + is( $osd->urls, 1, 'number of url objects' ); } # complex 1.1 OSD @@ -83,15 +83,24 @@ use_ok( 'WWW::OpenSearch::Description' ); is( $osd->adultcontent, 'false' ); is( $osd->syndicationright, 'open' ); - is( $osd->image, 'http://example.com/websearch.png' ); - -SKIP: { - skip 'Test Query', 1; - is( $osd->query, undef ); - }; + my $queries = $osd->query; + is( scalar @$queries, 1, 'number of query objects' ); + is( $queries->[ 0 ]->role, 'example' ); + is( $queries->[ 0 ]->searchTerms, 'cat' ); + + my $images = $osd->image; + is( scalar @$images, 2, 'number of image objects' ); + is( $images->[ 0 ]->height, 64 ); + is( $images->[ 0 ]->width, 64 ); + is( $images->[ 0 ]->type, 'image/png' ); + is( $images->[ 0 ]->url, 'http://example.com/websearch.png' ); + is( $images->[ 1 ]->height, 16 ); + is( $images->[ 1 ]->width, 16 ); + is( $images->[ 1 ]->type, 'image/vnd.microsoft.icon' ); + is( $images->[ 1 ]->url, 'http://example.com/websearch.ico' ); # count the urls - is( $osd->urls, 3 ); + is( $osd->urls, 3, 'number of url objects' ); } # 1.0 OSD -- 2.11.0