--- /dev/null
+Revision history for Perl extension WWW::OpenSearch
+
+0.06_02 Thu Jul 20 2006
+ - added tests
+ - updated available description info
+ - try to handle POST urls better
+ - update XML::Atom calls to latest release API
+ - added option to override the useragent from new()
+ - fix undef warning
+ - turn utf8 flag off for queries
+
+0.06_01 Thu May 18 2006
+ - Complete re-write to handle OpenSearch 1.1/Atom
+ - Now uses XML::Feed to abstract RSS and Atom
+ - Improved OpenSearch Description/Url handling
+ - Encapsulate returns in a Response object
+
+0.05 Mon Jan 9 18:30:18 UTC 2006
+ - Added partial support of OpenSearch 1.1. There's no API change and
+ old elements just work as before, with 1.1 OpenSearch document as
+ well. See http://opensearch.a9.com/docs/upgrading10.jsp
+ (Thanks to Masaaki Hirose)
+
+0.04 Sat Jul 29 18:34:31 PDT 2005
+ - Drop off XML::Simple for efficiency.
+ LibXMLify everything. Now you need XML::RSS::LibXML
+
+0.03 Sun Jul 24 02:36:46 PDT 2005
+ - Hacked current_page so you can specify page number correctly
+ (Thanks to Naoya Ito)
+
+0.02 Sat Mar 26 14:14:58 JST 2005
+ - Added accessors for attributes
+ - Fixed POD
+
+0.01 Thu Mar 17 20:45:13 2005
+ - original version
--- /dev/null
+Changes
+lib/WWW/OpenSearch.pm
+lib/WWW/OpenSearch/Description.pm
+lib/WWW/OpenSearch/Response.pm
+lib/WWW/OpenSearch/Url.pm
+Makefile.PL
+MANIFEST This list of files\r
+META.yml Module meta-data (added by MakeMaker)
+README
+t/00_compile.t
+t/01_live.t
+t/10-description.t
+t/11-url.t
+t/12-response.t
+t/98_pod.t
+t/99_pod_coverage.t
--- /dev/null
+# 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_from: lib/WWW/OpenSearch.pm
+installdirs: site
+requires:
+ Data::Page: 2
+ Encode: 0
+ LWP: 5.6
+ Test::More: 0.32
+ URI: 0
+ XML::Feed: 0.08
+ XML::LibXML: 1.58
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
--- /dev/null
+use ExtUtils::MakeMaker;
+WriteMakefile(
+ 'NAME' => 'WWW::OpenSearch',
+ 'VERSION_FROM' => 'lib/WWW/OpenSearch.pm',
+ 'PREREQ_PM' => {
+ 'Data::Page' => 2.00,
+ 'Encode' => 0,
+ 'LWP' => 5.60,
+ 'Test::More' => 0.32,
+ 'URI' => 0,
+ 'XML::Feed' => 0.08,
+ 'XML::LibXML' => 1.58
+ },
+);
--- /dev/null
+NAME\r
+ WWW::OpenSearch - Search A9 OpenSearch compatible engines\r
+\r
+SYNOPSIS\r
+ use WWW::OpenSearch;\r
+ \r
+ my $url = "http://bulkfeeds.net/opensearch.xml";\r
+ my $engine = WWW::OpenSearch->new($url);\r
+ \r
+ my $name = $engine->description->ShortName;\r
+ my $tags = $engine->description->Tags;\r
+ \r
+ # Perform search for "iPod"\r
+ my $response = $engine->search("iPod");\r
+ for my $item (@{$response->feed->items}) {\r
+ print $item->{description};\r
+ }\r
+ \r
+ # Retrieve the next page of results\r
+ my $next_page = $response->next_page;\r
+ for my $item (@{$next_page->feed->items}) {\r
+ print $item->{description};\r
+ }\r
+\r
+DESCRIPTION\r
+ WWW::OpenSearch is a module to search A9's OpenSearch compatible search\r
+ engines. See http://opensearch.a9.com/ for details.\r
+\r
+CONSTRUCTOR\r
+ new( $url )\r
+ Constructs a new instance of WWW::OpenSearch using the given URL as the\r
+ location of the engine's OpenSearch Description document (retrievable\r
+ via the description_url accessor).\r
+\r
+METHODS\r
+ fetch_description( [ $url ] )\r
+ Fetches the OpenSearch Descsription found either at the given URL or at\r
+ the URL specified by the description_url accessor. Fetched description\r
+ may be accessed via the description accessor.\r
+\r
+ search( $query [, \%params] )\r
+ Searches the engine for the given query using the given search\r
+ parameters. Valid search parameters include:\r
+\r
+ * startPage\r
+ * totalResults\r
+ * startIndex\r
+ * itemsPerPage\r
+\r
+ See http://opensearch.a9.com/spec/1.1/response/#elements for details.\r
+\r
+ do_search( $url [, $method] )\r
+ Performs a request for the given URL and returns a\r
+ WWW::OpenSearch::Response object. Method defaults to 'GET'.\r
+\r
+ACCESSORS\r
+ description_url( [$description_url] )\r
+ agent( [$agent] )\r
+ description( [$description] )\r
+AUTHOR\r
+ * Tatsuhiko Miyagawa <miyagawa@bulknews.net>\r
+ * Brian Cassidy <bricas@cpan.org>\r
+\r
+COPYRIGHT AND LICENSE\r
+ Copyright 2006 by Tatsuhiko Miyagawa and Brian Cassidy\r
+\r
+ This library is free software; you can redistribute it and/or modify it\r
+ under the same terms as Perl itself.\r
+\r
--- /dev/null
+package WWW::OpenSearch;\r
+\r
+use strict;\r
+use warnings;\r
+\r
+use base qw( Class::Accessor::Fast );\r
+\r
+use Carp;\r
+use WWW::OpenSearch::Response;\r
+use WWW::OpenSearch::Description;\r
+use Encode qw( _utf8_off ); \r
+\r
+__PACKAGE__->mk_accessors( qw( description_url agent description ) );\r
+\r
+our $VERSION = '0.06_02';\r
+\r
+=head1 NAME\r
+\r
+WWW::OpenSearch - Search A9 OpenSearch compatible engines\r
+\r
+=head1 SYNOPSIS\r
+\r
+ use WWW::OpenSearch;\r
+ \r
+ my $url = "http://bulkfeeds.net/opensearch.xml";\r
+ my $engine = WWW::OpenSearch->new($url);\r
+ \r
+ my $name = $engine->description->ShortName;\r
+ my $tags = $engine->description->Tags;\r
+ \r
+ # Perform search for "iPod"\r
+ my $response = $engine->search("iPod");\r
+ for my $item (@{$response->feed->items}) {\r
+ print $item->{description};\r
+ }\r
+ \r
+ # Retrieve the next page of results\r
+ my $next_page = $response->next_page;\r
+ for my $item (@{$next_page->feed->items}) {\r
+ print $item->{description};\r
+ }\r
+\r
+=head1 DESCRIPTION\r
+\r
+WWW::OpenSearch is a module to search A9's OpenSearch compatible search engines. See http://opensearch.a9.com/ for details.\r
+\r
+=head1 CONSTRUCTOR\r
+\r
+=head2 new( $url [, $useragent] )\r
+\r
+Constructs a new instance of WWW::OpenSearch using the given\r
+URL as the location of the engine's OpenSearch Description\r
+document (retrievable via the description_url accessor). Pass any
+LWP::UserAgent compatible object if you wish to override the default
+agent.\r
+\r
+=head1 METHODS\r
+\r
+=head2 fetch_description( [ $url ] )\r
+\r
+Fetches the OpenSearch Descsription found either at the given URL\r
+or at the URL specified by the description_url accessor. Fetched\r
+description may be accessed via the description accessor.\r
+\r
+=head2 search( $query [, \%params] )\r
+\r
+Searches the engine for the given query using the given \r
+search parameters. Valid search parameters include:\r
+\r
+=over 4\r
+\r
+=item * startPage\r
+\r
+=item * totalResults\r
+\r
+=item * startIndex\r
+\r
+=item * itemsPerPage\r
+\r
+=back\r
+\r
+See http://opensearch.a9.com/spec/1.1/response/#elements for details.\r
+\r
+=head2 do_search( $url [, $method] )\r
+\r
+Performs a request for the given URL and returns a\r
+WWW::OpenSearch::Response object. Method defaults to 'GET'.\r
+\r
+=head1 ACCESSORS\r
+\r
+=head2 description_url( [$description_url] )\r
+\r
+=head2 agent( [$agent] )\r
+\r
+=head2 description( [$description] )\r
+\r
+=head1 AUTHOR\r
+\r
+=over 4\r
+\r
+=item * Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>\r
+\r
+=item * Brian Cassidy E<lt>bricas@cpan.orgE<gt>\r
+\r
+=back\r
+\r
+=head1 COPYRIGHT AND LICENSE\r
+\r
+Copyright 2006 by Tatsuhiko Miyagawa and Brian Cassidy\r
+\r
+This library is free software; you can redistribute it and/or modify\r
+it under the same terms as Perl itself. \r
+\r
+=cut\r
+\r
+sub new {\r
+ my( $class, $url, $agent ) = @_;\r
+ \r
+ croak( "No OpenSearch Description url provided" ) unless $url;\r
+ \r
+ my $self = $class->SUPER::new;
+
+ unless( $agent ) {
+ require LWP::UserAgent;
+ $agent = LWP::UserAgent->new( agent => join( '/', ref $self, $VERSION ) );
+ }
+\r
+ $self->description_url( $url );\r
+ $self->agent( $agent );\r
+\r
+ $self->fetch_description;\r
+ \r
+ return $self;\r
+}\r
+\r
+sub fetch_description {\r
+ my( $self, $url ) = @_;\r
+ $url ||= $self->description_url;\r
+ $self->description_url( $url );\r
+ my $response = $self->agent->get( $url );\r
+ \r
+ unless( $response->is_success ) {\r
+ croak "Error while fetching $url: " . $response->status_line;\r
+ }\r
+\r
+ $self->description( WWW::OpenSearch::Description->new( $response->content ) );\r
+}\r
+\r
+sub search {\r
+ my( $self, $query, $params ) = @_;\r
+\r
+ $params ||= { };\r
+ $params->{ searchTerms } = $query;\r
+ _utf8_off( $params->{ searchTerms } ); \r
+ \r
+ my $url = $self->description->get_best_url;\r
+ return $self->do_search( $url->prepare_query( $params ), $url->method );\r
+}\r
+\r
+sub do_search {\r
+ my( $self, $url, $method ) = @_;\r
+ \r
+ $method = lc( $method ) || 'get';\r
+ \r
+ my $response;\r
+ if( $method eq 'post' ) {\r
+ $response = $self->agent->post( @$url );\r
+ }\r
+ else {\r
+ $response = $self->agent->$method( $url );\r
+ }\r
+ \r
+ return WWW::OpenSearch::Response->new( $self, $response ); \r
+}\r
+\r
+1;\r
--- /dev/null
+package WWW::OpenSearch::Description;\r
+\r
+use strict;\r
+use warnings;\r
+\r
+use base qw( Class::Accessor::Fast );\r
+\r
+use Carp;\r
+use XML::LibXML;\r
+use WWW::OpenSearch::Url;\r
+\r
+my @columns = qw(\r
+ AdultContent Contact Description Developer\r
+ Format Image LongName Query\r
+ SampleSearch ShortName SyndicationRight Tags\r
+ Url Attribution InputEncoding OutputEncoding
+ Language\r
+);\r
+\r
+__PACKAGE__->mk_accessors( qw( version ns ), map { lc } @columns );\r
+\r
+=head1 NAME\r
+\r
+WWW::OpenSearch::Description - Encapsulate an OpenSearch Description\r
+provided by an A9 OpenSearch compatible engine\r
+\r
+=head1 SYNOPSIS\r
+ \r
+ use WWW::OpenSearch;\r
+ \r
+ my $url = "http://bulkfeeds.net/opensearch.xml";\r
+ my $engine = WWW::OpenSearch->new($url);\r
+ my $description = $engine->description;\r
+ \r
+ my $format = $description->Format; # or $description->format\r
+ my $longname = $description->LongName; # or $description->longname\r
+ \r
+=head1 DESCRIPTION\r
+\r
+WWW::OpenSearch::Description is a module designed to encapsulate an\r
+OpenSearch Description provided by an A9 OpenSearch compatible engine.\r
+See http://opensearch.a9.com/spec/1.1/description/ for details.\r
+\r
+=head1 CONSTRUCTOR\r
+\r
+=head2 new( [ $xml ] )\r
+\r
+Constructs a new instance of WWW::OpenSearch::Description. If scalar\r
+parameter $xml is provided, data will be automatically loaded from it\r
+using load( $xml ).\r
+\r
+=head1 METHODS\r
+\r
+=head2 load( $xml )\r
+\r
+Loads description data by parsing provided argument using XML::LibXML.
+
+=head2 urls( )
+
+Return all of the urls associated with this description in an array.\r
+\r
+=head2 get_best_url( )\r
+\r
+Attempts to retrieve the best URL associated with this description, based\r
+on the following content types (from most preferred to least preferred):\r
+\r
+=over 4\r
+\r
+=item * application/atom+xml\r
+\r
+=item * application/rss+xml\r
+\r
+=item * text/xml\r
+\r
+=back\r
+\r
+=head2 get_url_by_type( $type )\r
+\r
+Retrieves the first WWW::OpenSearch::URL associated with this description\r
+whose type is equal to $type.\r
+\r
+=head1 ACCESSORS\r
+\r
+=head2 version( )\r
+\r
+=head2 ns( )\r
+\r
+=head2 AdultContent( )\r
+\r
+=head2 Contact( )\r
+\r
+=head2 Description( )\r
+\r
+=head2 Developer( )\r
+\r
+=head2 Format( )\r
+\r
+=head2 Image( )\r
+\r
+=head2 LongName( )\r
+\r
+=head2 Query( )\r
+\r
+=head2 SampleSearch( )\r
+\r
+=head2 ShortName( )\r
+\r
+=head2 SyndicationRight( )\r
+\r
+=head2 Tags( )\r
+\r
+=head2 Url( )\r
+\r
+=head1 AUTHOR\r
+\r
+=over 4\r
+\r
+=item * Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>\r
+\r
+=item * Brian Cassidy E<lt>bricas@cpan.orgE<gt>\r
+\r
+=back\r
+\r
+=head1 COPYRIGHT AND LICENSE\r
+\r
+Copyright 2006 by Tatsuhiko Miyagawa and Brian Cassidy\r
+\r
+This library is free software; you can redistribute it and/or modify\r
+it under the same terms as Perl itself. \r
+\r
+=cut\r
+\r
+for( @columns ) {\r
+ no strict 'refs';\r
+ my $col = lc;\r
+ *$_ = \&$col;\r
+}\r
+\r
+sub new {\r
+ my $class = shift;\r
+ my $xml = shift;\r
+ \r
+ my $self = $class->SUPER::new;\r
+ \r
+ eval{ $self->load( $xml ); } if $xml;\r
+ if( $@ ) {\r
+ croak "Error while parsing Description XML: $@";\r
+ }\r
+\r
+ return $self;\r
+}\r
+\r
+sub load {\r
+ my $self = shift;\r
+ my $xml = shift;\r
+ \r
+ my $parser = XML::LibXML->new;\r
+ my $doc = $parser->parse_string( $xml );\r
+ my $element = $doc->documentElement;\r
+ my $nodename = $element->nodeName;\r
+\r
+ croak "Node should be OpenSearchDescription: $nodename" if $nodename ne 'OpenSearchDescription';\r
+\r
+ my $ns = $element->getNamespace->value;\r
+ my $version;\r
+ if( $ns eq 'http://a9.com/-/spec/opensearch/1.1/' ) {\r
+ $self->ns( $ns );\r
+ $version = '1.1';\r
+ }\r
+ else {\r
+ $version = '1.0';\r
+ }\r
+ $self->version( $version );\r
+\r
+ for my $column ( @columns ) {\r
+ my $node = $doc->documentElement->getChildrenByTagName( $column ) or next;\r
+ if( $column eq 'Url' ) {\r
+ if( $version eq '1.0' ) {\r
+ $self->Url( [ WWW::OpenSearch::Url->new( template => $node->string_value, type => 'application/rss+xml' ) ] );\r
+ next;\r
+ }\r
+\r
+ my @url;\r
+ for my $urlnode ( $node->get_nodelist ) {\r
+ my $type = $urlnode->getAttributeNode( 'type' )->value;\r
+ my $url = $urlnode->getAttributeNode( 'template' )->value;\r
+ $url =~ s/\?}/}/g; # optional\r
+ my $method = $urlnode->getAttributeNode( 'method' );\r
+ $method = $method->value if $method;\r
+
+ my %params;\r
+ for( $urlnode->getChildrenByTagName( 'Param' ) ) {\r
+ my $param = $_->getAttributeNode( 'name' )->value;\r
+ my $value = $_->getAttributeNode( 'value' )->value;
+ $value =~ s/\?}/}/g; # optional\r
+ $params{ $param } = $value;\r
+ }\r
+\r
+ push @url, WWW::OpenSearch::Url->new( template => $url, type => $type, method => $method, params => \%params );\r
+ }\r
+ $self->Url( \@url );\r
+ }\r
+ elsif( $version eq '1.1' and $column eq 'Query' ) {\r
+ my $query = ( $node->get_nodelist )[ 0 ];\r
+ next if $query->getAttributeNode( 'role' )->value eq 'example';\r
+ $self->SampleSearch( $query->getAttributeNode( 'searchTerms' )->value );\r
+ }\r
+ elsif( $version eq '1.0' and $column eq 'Format' ) {\r
+ $self->Format( $node->string_value );\r
+ $self->ns( $self->Format );\r
+ }\r
+ else {\r
+ $self->$column( $node->string_value );\r
+ }\r
+ }\r
+}\r
+\r
+sub get_best_url {\r
+ my $self = shift;\r
+ \r
+ return $self->get_url_by_type( 'application/atom+xml' )\r
+ || $self->get_url_by_type( 'application/rss+xml' )\r
+ || $self->get_url_by_type( 'text/xml' )\r
+ || $self->url->[ 0 ];\r
+}\r
+\r
+sub get_url_by_type {\r
+ my $self = shift;\r
+ my $type = shift;\r
+ \r
+ my $template;\r
+ for( $self->urls ) {\r
+ $template = $_ if $_->type eq $type;\r
+ last;\r
+ };\r
+ \r
+ return $template;\r
+}\r
+
+sub urls {
+ my $self = shift;
+ return @{ $self->url };
+}
+\r
+1;\r
--- /dev/null
+package WWW::OpenSearch::Response;\r
+\r
+use strict;\r
+use warnings;\r
+\r
+use base qw( HTTP::Response Class::Accessor::Fast );\r
+\r
+use XML::Feed;
+use URI;\r
+use Data::Page;\r
+\r
+__PACKAGE__->mk_accessors( qw( feed pager parent ) );\r
+\r
+=head1 NAME\r
+\r
+WWW::OpenSearch::Response - Encapsulate a response received from\r
+an A9 OpenSearch compatible engine\r
+\r
+=head1 SYNOPSIS\r
+ \r
+ use WWW::OpenSearch;\r
+ \r
+ my $url = "http://bulkfeeds.net/opensearch.xml";\r
+ my $engine = WWW::OpenSearch->new($url);\r
+ \r
+ # Retrieve page 4 of search results for "iPod"\r
+ my $response = $engine->search("iPod",{ startPage => 4 });\r
+ for my $item (@{$response->feed->items}) {\r
+ print $item->{description};\r
+ }\r
+ \r
+ # Retrieve page 3 of results\r
+ $response = $response->previous_page;\r
+ \r
+ # Retrieve page 5 of results\r
+ $response = $response->next_page;\r
+ \r
+=head1 DESCRIPTION\r
+\r
+WWW::OpenSearch::Response is a module designed to encapsulate a\r
+response received from an A9 OpenSearch compatible engine.\r
+See http://opensearch.a9.com/spec/1.1/response/ for details.\r
+\r
+=head1 CONSTRUCTOR\r
+\r
+=head2 new( $parent, $response )\r
+\r
+Constructs a new instance of WWW::OpenSearch::Response. Arguments\r
+include the WWW::OpenSearch object which initiated the search (parent)\r
+and the HTTP::Response returned by the search request.\r
+\r
+=head1 METHODS\r
+\r
+=head2 parse_response( )\r
+\r
+Parses the content of the HTTP response using XML::Feed. If successful,\r
+parse_feed( ) is also called.\r
+\r
+=head2 parse_feed( )\r
+\r
+Parses the XML::Feed originally parsed from the HTTP response content.\r
+Sets the pager object appropriately.\r
+\r
+=head2 previous_page( ) / next_page( )\r
+\r
+Performs another search on the parent object, returning a\r
+WWW::OpenSearch::Response instance containing the previous/next page\r
+of results. If the current response includes a <link rel="previous/next"\r
+href="..." /> tag, the page will simply be the parsed content of the URL\r
+specified by the tag's href attribute. However, if the current response does not\r
+include the appropriate link, a new query is constructed using the startPage\r
+or startIndex query arguments.\r
+\r
+=head2 _get_link( $type )\r
+\r
+Gets the href attribute of the first link whose rel attribute\r
+is equal to $type.\r
+\r
+=head1 ACCESSORS\r
+\r
+=head2 feed( )\r
+\r
+=head2 pager( )\r
+\r
+=head2 parent( )\r
+\r
+=head1 AUTHOR\r
+\r
+=over 4\r
+\r
+=item * Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>\r
+\r
+=item * Brian Cassidy E<lt>bricas@cpan.orgE<gt>\r
+\r
+=back\r
+\r
+=head1 COPYRIGHT AND LICENSE\r
+\r
+Copyright 2006 by Tatsuhiko Miyagawa and Brian Cassidy\r
+\r
+This library is free software; you can redistribute it and/or modify\r
+it under the same terms as Perl itself. \r
+\r
+=cut\r
+\r
+sub new {\r
+ my $class = shift;\r
+ my $parent = shift;\r
+ my $response = shift;\r
+ \r
+ my $self = bless $response, $class;\r
+\r
+ $self->parent( $parent );\r
+ return $self unless $self->is_success;\r
+ \r
+ $self->parse_response;\r
+ \r
+ return $self;\r
+}\r
+\r
+sub parse_response {\r
+ my $self = shift;\r
+\r
+ my $content = $self->content;\r
+ my $feed = XML::Feed->parse( \$content );\r
+\r
+ return if XML::Feed->errstr;\r
+ $self->feed( $feed );\r
+ \r
+ $self->parse_feed;\r
+}\r
+\r
+sub parse_feed {\r
+ my $self = shift;\r
+ my $pager = Data::Page->new;\r
+\r
+ my $feed = $self->feed;\r
+ my $format = $feed->format;\r
+ my $ns = $self->parent->description->ns;\r
+ \r
+ # TODO\r
+ # adapt these for any number of opensearch elements in\r
+ # the feed or in each entry\r
+ \r
+ if( my $atom = $feed->{ atom } ) {\r
+ my $total = $atom->get( $ns, 'totalResults' );\r
+ my $perpage = $atom->get( $ns, 'itemsPerPage' );\r
+ my $start = $atom->get( $ns, 'startIndex' );\r
+ \r
+ $pager->total_entries( $total );\r
+ $pager->entries_per_page( $perpage );\r
+ $pager->current_page( $start ? ( $start - 1 ) / $perpage + 1 : 0 )\r
+ }\r
+ elsif( my $rss = $feed->{ rss } ) {\r
+ if ( my $page = $rss->channel->{ $ns } ) {\r
+ $pager->total_entries( $page->{ totalResults } );\r
+ $pager->entries_per_page( $page->{ itemsPerPage } );\r
+ my $start = $page->{ startIndex };\r
+ $pager->current_page( $start ? ( $start - 1 ) / $page->{ itemsPerPage } + 1 : 0 )\r
+ }\r
+ } \r
+ $self->pager( $pager );\r
+}\r
+\r
+sub next_page {\r
+ my $self = shift;\r
+ return $self->_get_page( 'next' );\r
+}\r
+\r
+sub previous_page {\r
+ my $self = shift;
+ return $self->_get_page( 'previous' );\r
+}
+
+sub _get_page {
+ my( $self, $direction ) = @_;
+ my $pager = $self->pager;
+ my $pagermethod = "${direction}_page";\r
+ my $page = $pager->$pagermethod;\r
+ return unless $page;\r
+
+ my $request = $self->request;
+ my $method = lc $request->method;
+
+ if( $method ne 'post' ) { # force query build on POST\r
+ my $link = $self->_get_link( $direction );\r
+ return $self->parent->do_search( $link, $method ) if $link;
+ }\r
+ \r
+ my $template = $self->parent->description->get_best_url;
+ my( $param, $query );
+ if( $method eq 'post' ) {
+ my $uri = URI->new( 'http://foo.com/?' . $request->content );
+ $query = { $uri->query_form };
+ }
+ else {
+ $query = { $self->request->uri->query_form };
+ }\r
+\r
+ if( $param = $template->macros->{ startPage } ) {\r
+ $query->{ $param } = $pager->$pagermethod\r
+ }\r
+ elsif( $param = $template->macros->{ startIndex } ) {
+ if( $query->{ $param } ) {
+ $query->{ $param } = $direction eq 'previous'
+ ? $query->{ $param } -= $pager->entries_per_page
+ : $query->{ $param } += $pager->entries_per_page;
+ }
+ else {
+ $query->{ $param } = $direction eq 'previous'
+ ? 1
+ : $pager->entries_per_page + 1;
+ }\r
+ }\r
+\r
+ return $self->parent->do_search( $template->prepare_query( $query ), $method );\r
+}\r
+\r
+sub _get_link {\r
+ my $self = shift;\r
+ my $type = shift;\r
+ my $feed = $self->feed->{ atom };\r
+ \r
+ return unless $feed;\r
+ \r
+ for( $feed->link ) {\r
+ return $_->get( 'href' ) if $_->get( 'rel' ) eq $type;\r
+ }
+
+ return;\r
+}\r
+\r
+1;\r
--- /dev/null
+package WWW::OpenSearch::Url;\r
+\r
+use base qw( Class::Accessor::Fast );\r
+\r
+use URI;\r
+use URI::Escape;\r
+\r
+__PACKAGE__->mk_accessors( qw( type template method params macros ) );\r
+\r
+=head1 NAME\r
+\r
+WWW::OpenSearch::Url\r
+\r
+=head1 SYNOPSIS\r
+\r
+=head1 DESCRIPTION\r
+\r
+=head1 CONSTRUCTOR\r
+\r
+=head2 new( [%options] )\r
+\r
+=head1 METHODS\r
+\r
+=head2 parse_macros( )\r
+\r
+=head2 prepare_query( [ \%params ] )\r
+\r
+=head1 ACCESSORS\r
+\r
+=head1 AUTHOR\r
+\r
+=over 4\r
+\r
+=item * Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>\r
+\r
+=item * Brian Cassidy E<lt>bricas@cpan.orgE<gt>\r
+\r
+=back\r
+\r
+=head1 COPYRIGHT AND LICENSE\r
+\r
+Copyright 2006 by Tatsuhiko Miyagawa and Brian Cassidy\r
+\r
+This library is free software; you can redistribute it and/or modify\r
+it under the same terms as Perl itself. \r
+\r
+=cut\r
+\r
+sub new {\r
+ my( $class, %options ) = @_;\r
+ \r
+ $options{ method } ||= 'GET';\r
+ $options{ template } = URI->new( $options{ template } );\r
+ \r
+ my $self = $class->SUPER::new( \%options );
+ $self->parse_macros;\r
+
+ return $self;\r
+}\r
+\r
+sub parse_macros {\r
+ my $self = shift;\r
+ \r
+ my %query = $self->method eq 'post'
+ ? %{ $self->params }
+ : $self->template->query_form;\r
+ \r
+ my %macros;\r
+ for( keys %query ) {\r
+ if( $query{ $_ } =~ /^{(.+)}$/ ) {\r
+ $macros{ $1 } = $_;\r
+ }\r
+ }\r
+ \r
+ $self->macros( \%macros );\r
+}\r
+\r
+sub prepare_query {\r
+ my( $self, $params ) = @_;\r
+ my $url = $self->template->clone;\r
+ \r
+ $params->{ startIndex } ||= 1;\r
+ $params->{ startPage } ||= 1;\r
+ $params->{ language } ||= '*';\r
+ $params->{ outputEncoding } ||= 'UTF-8';\r
+ $params->{ inputEncoding } ||= 'UTF-8';\r
+ \r
+ my $macros = $self->macros;\r
+
+ # attempt to handle POST
+ if( $self->method eq 'post' ) {
+ my $post = $self->params;
+ for( keys %macros ) {
+ $post->{ $macros->{ $_ } } = $params->{ $_ };\r
+ }
+ return [ $url, $post ];
+ }
+
+ my $query = { $url->query_form };\r
+ for( keys %$macros ) {\r
+ $query->{ $macros->{ $_ } } = $params->{ $_ };\r
+ }\r
+ \r
+ $url->query_form( $query );\r
+ return $url;\r
+}\r
+\r
+1;\r
--- /dev/null
+use strict;
+use Test::More tests => 4;
+
+BEGIN {
+ use_ok 'WWW::OpenSearch';
+ use_ok 'WWW::OpenSearch::Description';
+ use_ok 'WWW::OpenSearch::Response';
+ use_ok 'WWW::OpenSearch::Url';
+}
--- /dev/null
+use strict;
+use Test::More;
+
+my $url = $ENV{OPENSEARCH_URL};
+unless ($url) {
+ Test::More->import(skip_all => "OPENSEARCH_URL not set");
+ exit;
+}
+
+# XXX This is not testing, but for debugging :)
+plan 'no_plan';
+
+use WWW::OpenSearch;
+
+my $engine = WWW::OpenSearch->new($url);
+ok $engine;
+ok $engine->description->shortname, $engine->description->shortname;
+
+my $res = $engine->search("iPod");
+ok $res;
+ok $res->feed->title, $res->feed->title;
+ok $res->feed->link, $res->feed->link;
+ok $res->pager->entries_per_page, "items per page " . $res->pager->entries_per_page;
+ok $res->pager->total_entries, "total entries " . $res->pager->total_entries;
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More tests => 38;
+
+use_ok( 'WWW::OpenSearch::Description' );
+
+# simple 1.1 OSD
+{
+ my $description = q(<?xml version="1.0" encoding="UTF-8"?>
+<OpenSearchDescription xmlns="http://a9.com/-/spec/opensearch/1.1/">
+ <ShortName>Web Search</ShortName>
+ <Description>Use Example.com to search the Web.</Description>
+ <Tags>example web</Tags>
+ <Contact>admin@example.com</Contact>
+ <Url type="application/rss+xml"
+ template="http://example.com/?q={searchTerms}&pw={startPage?}&format=rss"/>
+</OpenSearchDescription>
+);
+
+ my $osd = WWW::OpenSearch::Description->new( $description );
+ isa_ok( $osd, 'WWW::OpenSearch::Description' );
+ is( $osd->shortname, 'Web Search' );
+ ok( !defined $osd->longname );
+ is( $osd->description, 'Use Example.com to search the Web.' );
+ is( $osd->tags, 'example web' );
+ is( $osd->contact, 'admin@example.com' );
+
+ # count the urls
+ is( $osd->urls, 1 );
+}
+
+# complex 1.1 OSD
+{
+ my $description = q(<?xml version="1.0" encoding="UTF-8"?>
+<OpenSearchDescription xmlns="http://a9.com/-/spec/opensearch/1.1/">
+ <ShortName>Web Search</ShortName>
+ <Description>Use Example.com to search the Web.</Description>
+ <Tags>example web</Tags>
+ <Contact>admin@example.com</Contact>
+ <Url type="application/rss+xml"
+ template="http://example.com/?q={searchTerms}&pw={startPage}&format=rss"/>
+ <Url type="application/atom+xml"
+ template="http://example.com/?q={searchTerms}&pw={startPage?}&format=atom"/>
+ <Url type="text/html"
+ method="post"
+ template="https://intranet/search?format=html">
+ <Param name="s" value="{searchTerms}"/>
+ <Param name="o" value="{startIndex?}"/>
+ <Param name="c" value="{itemsPerPage?}"/>
+ <Param name="l" value="{language?}"/>
+ </Url>
+ <LongName>Example.com Web Search</LongName>
+ <Image height="64" width="64" type="image/png">http://example.com/websearch.png</Image>
+ <Image height="16" width="16" type="image/vnd.microsoft.icon">http://example.com/websearch.ico</Image>
+ <Query role="example" searchTerms="cat" />
+ <Developer>Example.com Development Team</Developer>
+ <Attribution>
+ Search data &copy; 2005, Example.com, Inc., All Rights Reserved
+ </Attribution>
+ <SyndicationRight>open</SyndicationRight>
+ <AdultContent>false</AdultContent>
+ <Language>en-us</Language>
+ <OutputEncoding>UTF-8</OutputEncoding>
+ <InputEncoding>UTF-8</InputEncoding>
+</OpenSearchDescription>
+);
+
+ my $osd = WWW::OpenSearch::Description->new( $description );
+ isa_ok( $osd, 'WWW::OpenSearch::Description' );
+ is( $osd->shortname, 'Web Search' );
+ is( $osd->longname, 'Example.com Web Search' );
+ is( $osd->description, 'Use Example.com to search the Web.' );
+ is( $osd->tags, 'example web' );
+ is( $osd->contact, 'admin@example.com' );
+ is( $osd->developer, 'Example.com Development Team' );
+ is( $osd->attribution, '
+ Search data © 2005, Example.com, Inc., All Rights Reserved
+ ' );
+ is( $osd->inputencoding, 'UTF-8' );
+ is( $osd->outputencoding, 'UTF-8' );
+ is( $osd->language, 'en-us' );
+ is( $osd->adultcontent, 'false' );
+ is( $osd->syndicationright, 'open' );
+
+ TODO: {
+ local $TODO = 'Test Query and Image';
+
+ is( $osd->query, undef );
+ is( $osd->image, undef );
+ };
+
+ # count the urls
+ is( $osd->urls, 3 );
+}
+
+# 1.0 OSD
+{
+ my $description = q(<?xml version="1.0" encoding="UTF-8"?>
+<OpenSearchDescription xmlns="http://a9.com/-/spec/opensearchdescription/1.0/">
+ <Url>http://www.unto.net/aws?q={searchTerms}&searchindex=Electronics
+ &flavor=osrss&itempage={startPage}</Url>
+ <Format>http://a9.com/-/spec/opensearchrss/1.0/</Format>
+ <ShortName>Electronics</ShortName>
+ <LongName>Amazon Electronics</LongName>
+ <Description>Search for electronics on Amazon.com.</Description>
+ <Tags>amazon electronics</Tags>
+ <Image>http://www.unto.net/search/amazon_electronics.gif</Image>
+ <SampleSearch>ipod</SampleSearch>
+ <Developer>DeWitt Clinton</Developer>
+ <Contact>dewitt@unto.net</Contact>
+ <Attribution>Product and search data &copy; 2005, Amazon, Inc.,
+ All Rights Reserved</Attribution>
+ <SyndicationRight>open</SyndicationRight>
+ <AdultContent>false</AdultContent>
+</OpenSearchDescription>
+);
+
+ my $osd = WWW::OpenSearch::Description->new( $description );
+ isa_ok( $osd, 'WWW::OpenSearch::Description' );
+ is( $osd->shortname, 'Electronics' );
+ is( $osd->longname, 'Amazon Electronics' );
+ is( $osd->description, 'Search for electronics on Amazon.com.' );
+ is( $osd->tags, 'amazon electronics' );
+ is( $osd->contact, 'dewitt@unto.net' );
+ is( $osd->format, 'http://a9.com/-/spec/opensearchrss/1.0/' );
+ is( $osd->image, 'http://www.unto.net/search/amazon_electronics.gif' );
+ is( $osd->samplesearch, 'ipod' );
+ is( $osd->developer, 'DeWitt Clinton' );
+ is( $osd->attribution, 'Product and search data © 2005, Amazon, Inc.,
+ All Rights Reserved' );
+ is( $osd->syndicationright, 'open' );
+ is( $osd->adultcontent, 'false' );
+
+ # count the urls
+ is( $osd->urls, 1 );
+}
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More tests => 27;
+
+use_ok( 'WWW::OpenSearch::Description' );
+use_ok( 'WWW::OpenSearch::Url' );
+
+{
+ my $description = q(<?xml version="1.0" encoding="UTF-8"?>
+<OpenSearchDescription xmlns="http://a9.com/-/spec/opensearch/1.1/">
+ <Url type="application/rss+xml"
+ template="http://example.com/?q={searchTerms}&pw={startPage?}&format=rss"/>
+</OpenSearchDescription>
+);
+
+ my $osd = WWW::OpenSearch::Description->new( $description );
+ isa_ok( $osd, 'WWW::OpenSearch::Description' );
+ is( $osd->urls, 1 );
+
+ my( $url ) = $osd->urls;
+ isa_ok( $url, 'WWW::OpenSearch::Url' );
+ is( $url->type, 'application/rss+xml' );
+ is( lc $url->method, 'get' );
+ is( $url->template, 'http://example.com/?q=%7BsearchTerms%7D&pw=%7BstartPage%7D&format=rss' );
+}
+
+{
+ my $description = q(<?xml version="1.0" encoding="UTF-8"?>
+<OpenSearchDescription xmlns="http://a9.com/-/spec/opensearch/1.1/">
+ <Url type="application/rss+xml"
+ template="http://example.com/?q={searchTerms}&pw={startPage}&format=rss"/>
+ <Url type="application/atom+xml"
+ template="http://example.com/?q={searchTerms}&pw={startPage?}&format=atom"/>
+ <Url type="text/html"
+ method="post"
+ template="https://intranet/search?format=html">
+ <Param name="s" value="{searchTerms}"/>
+ <Param name="o" value="{startIndex?}"/>
+ <Param name="c" value="{itemsPerPage?}"/>
+ <Param name="l" value="{language?}"/>
+ </Url>
+</OpenSearchDescription>
+);
+
+ my $osd = WWW::OpenSearch::Description->new( $description );
+ isa_ok( $osd, 'WWW::OpenSearch::Description' );
+ is( $osd->urls, 3 );
+
+ {
+ my $url = $osd->url->[ 0 ];
+ isa_ok( $url, 'WWW::OpenSearch::Url' );
+ is( $url->type, 'application/rss+xml' );
+ is( lc $url->method, 'get' );
+ is( $url->template, 'http://example.com/?q=%7BsearchTerms%7D&pw=%7BstartPage%7D&format=rss' );
+ }
+
+ {
+ my $url = $osd->url->[ 1 ];
+ isa_ok( $url, 'WWW::OpenSearch::Url' );
+ is( $url->type, 'application/atom+xml' );
+ is( lc $url->method, 'get' );
+ is( $url->template, 'http://example.com/?q=%7BsearchTerms%7D&pw=%7BstartPage%7D&format=atom' );
+ }
+
+ {
+ my $url = $osd->url->[ 2 ];
+ isa_ok( $url, 'WWW::OpenSearch::Url' );
+ is( $url->type, 'text/html' );
+ is( lc $url->method, 'post' );
+ is( $url->template, 'https://intranet/search?format=html' );
+ }
+}
+
+{
+ my $description = q(<?xml version="1.0" encoding="UTF-8"?>
+<OpenSearchDescription xmlns="http://a9.com/-/spec/opensearchdescription/1.0/">
+ <Url>http://www.unto.net/aws?q={searchTerms}&searchindex=Electronics&flavor=osrss&itempage={startPage}</Url>
+</OpenSearchDescription>
+);
+
+ my $osd = WWW::OpenSearch::Description->new( $description );
+ isa_ok( $osd, 'WWW::OpenSearch::Description' );
+ is( $osd->urls, 1 );
+
+ my( $url ) = $osd->urls;
+ isa_ok( $url, 'WWW::OpenSearch::Url' );
+ is( lc $url->method, 'get' );
+ is( $url->template, 'http://www.unto.net/aws?q=%7BsearchTerms%7D&searchindex=Electronics&flavor=osrss&itempage=%7BstartPage%7D' );
+}
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+use_ok( 'WWW::OpenSearch::Response' );
--- /dev/null
+use Test::More;\r
+eval "use Test::Pod 1.00";\r
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;\r
+all_pod_files_ok();
\ No newline at end of file
--- /dev/null
+use Test::More;\r
+eval "use Test::Pod::Coverage 1.00";\r
+plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@;\r
+all_pod_coverage_ok();
\ No newline at end of file
projects / libwww-opensearch-perl.git / commitdiff