From d981e6304039517daa924f126bf85a9c739ecd2c Mon Sep 17 00:00:00 2001 From: ianb Date: Tue, 5 Sep 2006 20:00:43 +0100 Subject: [PATCH] Initial revision --- Changes | 37 ++++++ MANIFEST | 16 +++ META.yml | 17 +++ Makefile.PL | 14 +++ README | 69 +++++++++++ lib/WWW/OpenSearch.pm | 176 +++++++++++++++++++++++++++ lib/WWW/OpenSearch/Description.pm | 245 ++++++++++++++++++++++++++++++++++++++ lib/WWW/OpenSearch/Response.pm | 233 ++++++++++++++++++++++++++++++++++++ lib/WWW/OpenSearch/Url.pm | 108 +++++++++++++++++ t/00_compile.t | 9 ++ t/01_live.t | 24 ++++ t/10-description.t | 138 +++++++++++++++++++++ t/11-url.t | 91 ++++++++++++++ t/12-response.t | 6 + t/98_pod.t | 4 + t/99_pod_coverage.t | 4 + 16 files changed, 1191 insertions(+) create mode 100644 Changes create mode 100644 MANIFEST create mode 100644 META.yml create mode 100644 Makefile.PL create mode 100644 README create mode 100644 lib/WWW/OpenSearch.pm create mode 100644 lib/WWW/OpenSearch/Description.pm create mode 100644 lib/WWW/OpenSearch/Response.pm create mode 100644 lib/WWW/OpenSearch/Url.pm create mode 100644 t/00_compile.t create mode 100644 t/01_live.t create mode 100644 t/10-description.t create mode 100644 t/11-url.t create mode 100644 t/12-response.t create mode 100644 t/98_pod.t create mode 100644 t/99_pod_coverage.t diff --git a/Changes b/Changes new file mode 100644 index 0000000..066bf90 --- /dev/null +++ b/Changes @@ -0,0 +1,37 @@ +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 diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..86e744e --- /dev/null +++ b/MANIFEST @@ -0,0 +1,16 @@ +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 +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 diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..150d3aa --- /dev/null +++ b/META.yml @@ -0,0 +1,17 @@ +# 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 diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..b24fa45 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,14 @@ +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 + }, +); diff --git a/README b/README new file mode 100644 index 0000000..c77f030 --- /dev/null +++ b/README @@ -0,0 +1,69 @@ +NAME + WWW::OpenSearch - Search A9 OpenSearch compatible engines + +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}; + } + +DESCRIPTION + WWW::OpenSearch is a module to search A9's OpenSearch compatible search + engines. See http://opensearch.a9.com/ for details. + +CONSTRUCTOR + new( $url ) + 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). + +METHODS + 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. + + search( $query [, \%params] ) + Searches the engine for the given query using the given search + parameters. Valid search parameters include: + + * startPage + * totalResults + * startIndex + * itemsPerPage + + See http://opensearch.a9.com/spec/1.1/response/#elements for details. + + do_search( $url [, $method] ) + Performs a request for the given URL and returns a + WWW::OpenSearch::Response object. Method defaults to 'GET'. + +ACCESSORS + description_url( [$description_url] ) + agent( [$agent] ) + description( [$description] ) +AUTHOR + * Tatsuhiko Miyagawa + * Brian Cassidy + +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. + diff --git a/lib/WWW/OpenSearch.pm b/lib/WWW/OpenSearch.pm new file mode 100644 index 0000000..5985929 --- /dev/null +++ b/lib/WWW/OpenSearch.pm @@ -0,0 +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 +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; + + 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; diff --git a/lib/WWW/OpenSearch/Description.pm b/lib/WWW/OpenSearch/Description.pm new file mode 100644 index 0000000..6ed1e9a --- /dev/null +++ b/lib/WWW/OpenSearch/Description.pm @@ -0,0 +1,245 @@ +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 + 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 ) + +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; + 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; +} + +sub urls { + my $self = shift; + return @{ $self->url }; +} + +1; diff --git a/lib/WWW/OpenSearch/Response.pm b/lib/WWW/OpenSearch/Response.pm new file mode 100644 index 0000000..1cb653b --- /dev/null +++ b/lib/WWW/OpenSearch/Response.pm @@ -0,0 +1,233 @@ +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 { + my $self = shift; + 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 $request = $self->request; + my $method = lc $request->method; + + 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' ) { + my $uri = URI->new( 'http://foo.com/?' . $request->content ); + $query = { $uri->query_form }; + } + else { + $query = { $self->request->uri->query_form }; + } + + if( $param = $template->macros->{ startPage } ) { + $query->{ $param } = $pager->$pagermethod + } + 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; + } + } + + 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 new file mode 100644 index 0000000..33cbd0a --- /dev/null +++ b/lib/WWW/OpenSearch/Url.pm @@ -0,0 +1,108 @@ +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 } ); + + my $self = $class->SUPER::new( \%options ); + $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; + + # attempt to handle POST + if( $self->method eq 'post' ) { + my $post = $self->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; diff --git a/t/00_compile.t b/t/00_compile.t new file mode 100644 index 0000000..208a797 --- /dev/null +++ b/t/00_compile.t @@ -0,0 +1,9 @@ +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'; +} diff --git a/t/01_live.t b/t/01_live.t new file mode 100644 index 0000000..aeec5f7 --- /dev/null +++ b/t/01_live.t @@ -0,0 +1,24 @@ +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; diff --git a/t/10-description.t b/t/10-description.t new file mode 100644 index 0000000..784face --- /dev/null +++ b/t/10-description.t @@ -0,0 +1,138 @@ +use strict; +use warnings; + +use Test::More tests => 38; + +use_ok( 'WWW::OpenSearch::Description' ); + +# simple 1.1 OSD +{ + my $description = q( + + Web Search + Use Example.com to search the Web. + example web + admin@example.com + + +); + + 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( + + Web Search + Use Example.com to search the Web. + example web + admin@example.com + + + + + + + + + Example.com Web Search + http://example.com/websearch.png + http://example.com/websearch.ico + + Example.com Development Team + + Search data &copy; 2005, Example.com, Inc., All Rights Reserved + + open + false + en-us + UTF-8 + UTF-8 + +); + + 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( + + http://www.unto.net/aws?q={searchTerms}&searchindex=Electronics + &flavor=osrss&itempage={startPage} + http://a9.com/-/spec/opensearchrss/1.0/ + Electronics + Amazon Electronics + Search for electronics on Amazon.com. + amazon electronics + http://www.unto.net/search/amazon_electronics.gif + ipod + DeWitt Clinton + dewitt@unto.net + Product and search data &copy; 2005, Amazon, Inc., + All Rights Reserved + open + false + +); + + 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 ); +} + diff --git a/t/11-url.t b/t/11-url.t new file mode 100644 index 0000000..44ccb81 --- /dev/null +++ b/t/11-url.t @@ -0,0 +1,91 @@ +use strict; +use warnings; + +use Test::More tests => 27; + +use_ok( 'WWW::OpenSearch::Description' ); +use_ok( 'WWW::OpenSearch::Url' ); + +{ + my $description = q( + + + +); + + 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( + + + + + + + + + + +); + + 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( + + http://www.unto.net/aws?q={searchTerms}&searchindex=Electronics&flavor=osrss&itempage={startPage} + +); + + 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' ); +} + diff --git a/t/12-response.t b/t/12-response.t new file mode 100644 index 0000000..87dc6ed --- /dev/null +++ b/t/12-response.t @@ -0,0 +1,6 @@ +use strict; +use warnings; + +use Test::More tests => 1; + +use_ok( 'WWW::OpenSearch::Response' ); diff --git a/t/98_pod.t b/t/98_pod.t new file mode 100644 index 0000000..3afe2fa --- /dev/null +++ b/t/98_pod.t @@ -0,0 +1,4 @@ +use Test::More; +eval "use Test::Pod 1.00"; +plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; +all_pod_files_ok(); \ No newline at end of file diff --git a/t/99_pod_coverage.t b/t/99_pod_coverage.t new file mode 100644 index 0000000..73a83b0 --- /dev/null +++ b/t/99_pod_coverage.t @@ -0,0 +1,4 @@ +use Test::More; +eval "use Test::Pod::Coverage 1.00"; +plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@; +all_pod_coverage_ok(); \ No newline at end of file -- 2.11.0