From 1fc70f0d6badbef9bb483990d761d1446d52cbb2 Mon Sep 17 00:00:00 2001 From: Ian Beckwith Date: Mon, 24 Mar 2008 18:49:04 +0000 Subject: [PATCH] Imported Upstream version 0.11 --- Changes | 37 +++ MANIFEST | 11 +- META.yml | 24 +- Makefile.PL | 22 +- README | 138 +++++------ lib/WWW/OpenSearch.pm | 326 ++++++++++++------------- lib/WWW/OpenSearch/Agent.pm | 68 ++++++ lib/WWW/OpenSearch/Description.pm | 487 ++++++++++++++++++++------------------ lib/WWW/OpenSearch/Image.pm | 55 +++++ lib/WWW/OpenSearch/Query.pm | 51 ++++ lib/WWW/OpenSearch/Request.pm | 85 +++++++ lib/WWW/OpenSearch/Response.pm | 456 ++++++++++++++++++----------------- lib/WWW/OpenSearch/Url.pm | 192 +++++++-------- t/00_compile.t | 6 +- t/09-opensearch.t | 9 + t/10-description.t | 86 ++++--- t/11-url.t | 48 ++-- t/13-request.t | 43 ++++ t/data/osd.xml | 31 +++ 19 files changed, 1297 insertions(+), 878 deletions(-) create mode 100644 lib/WWW/OpenSearch/Agent.pm create mode 100644 lib/WWW/OpenSearch/Image.pm create mode 100644 lib/WWW/OpenSearch/Query.pm create mode 100644 lib/WWW/OpenSearch/Request.pm create mode 100644 t/09-opensearch.t create mode 100644 t/13-request.t create mode 100644 t/data/osd.xml diff --git a/Changes b/Changes index 066bf90..1a7cba1 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,42 @@ Revision history for Perl extension WWW::OpenSearch +0.11 Tue Apr 17 2007 + - added a simple OSD parsing test + +0.10_02 Tue Jan 23 2007 + - fix Request.pm to clone the extra attributes we've + added (Marc Tobias) + +0.10_01 Mon Jan 22 2007 + - use URI::Template for parsing OSD uri templates + - added opensearch-specific Request and Agent classes + - un-break get_best_url() + - you can now pass a WWW::OpenSearch::Url to WWW::OpenSearch's + search() method + - added ns() (namespace) field to Url.pm + - re-worked paging to use the new Request object + + [ THINGS THAT MAY BREAK YOUR CODE ] + - using URI::Template means some methods are now proxied to + that class + - removed agent argument in new() in OpenSearch.pm + - handling of POST requests in prepare_query() in Url.pm now + returns data suitable for passing to HTTP::Request + - un-link Response.pm and the parent WWW::OpenSearch object -- + a Response is now in the context of whatever + WWW::OpenSearch::Url was used + +0.09 Thu Dec 07 2006 + - fix link fetching from atom feeds + +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..1b195bf 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,16 +1,23 @@ Changes lib/WWW/OpenSearch.pm +lib/WWW/OpenSearch/Agent.pm lib/WWW/OpenSearch/Description.pm +lib/WWW/OpenSearch/Image.pm +lib/WWW/OpenSearch/Query.pm +lib/WWW/OpenSearch/Request.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) +MANIFEST This list of files README t/00_compile.t t/01_live.t +t/09-opensearch.t t/10-description.t t/11-url.t t/12-response.t +t/13-request.t t/98_pod.t t/99_pod_coverage.t +t/data/osd.xml +META.yml Module meta-data (added by MakeMaker) diff --git a/META.yml b/META.yml index 150d3aa..1bcc3a5 100644 --- a/META.yml +++ b/META.yml @@ -1,17 +1,21 @@ -# 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: +--- #YAML:1.0 +name: WWW-OpenSearch +version: 0.11 +abstract: Search A9 OpenSearch compatible engines +license: perl +generated_by: ExtUtils::MakeMaker version 6.32 +distribution_type: module +requires: Data::Page: 2 Encode: 0 LWP: 5.6 Test::More: 0.32 URI: 0 + URI::Template: 0 XML::Feed: 0.08 XML::LibXML: 1.58 - -distribution_type: module -generated_by: ExtUtils::MakeMaker version 6.17 +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.2.html + version: 1.2 +author: + - Brian Cassidy diff --git a/Makefile.PL b/Makefile.PL index b24fa45..fb44e76 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -1,14 +1,18 @@ use ExtUtils::MakeMaker; WriteMakefile( - 'NAME' => 'WWW::OpenSearch', - 'VERSION_FROM' => 'lib/WWW/OpenSearch.pm', + 'NAME' => 'WWW::OpenSearch', + 'VERSION_FROM' => 'lib/WWW/OpenSearch.pm', + 'ABSTRACT_FROM' => 'lib/WWW/OpenSearch.pm', + 'AUTHOR' => 'Brian Cassidy ', + 'LICENSE' => 'perl', '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 + 'Data::Page' => 2.00, + 'Encode' => 0, + 'LWP' => 5.60, + 'Test::More' => 0.32, + 'URI' => 0, + 'XML::Feed' => 0.08, + 'XML::LibXML' => 1.58, + 'URI::Template' => 0, }, ); diff --git a/README b/README index c77f030..2c3973c 100644 --- a/README +++ b/README @@ -1,69 +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. - +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 2007 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 index 5985929..86ad45c 100644 --- a/lib/WWW/OpenSearch.pm +++ b/lib/WWW/OpenSearch.pm @@ -1,176 +1,156 @@ -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; - +package WWW::OpenSearch; + +use strict; +use warnings; + +use base qw( Class::Accessor::Fast ); + +use Carp; +use WWW::OpenSearch::Agent; +use WWW::OpenSearch::Request; +use WWW::OpenSearch::Description; + +use Encode (); + +__PACKAGE__->mk_accessors( qw( description_url agent description ) ); + +our $VERSION = '0.11'; + +=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 ) + +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). + +=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 2007 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 ) = @_; + + 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( WWW::OpenSearch::Agent->new() ); + + $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_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( WWW::OpenSearch::Description->new( $response->content ) ); +} + +sub search { + my( $self, $query, $params, $url ) = @_; + + $params ||= { }; + $params->{ searchTerms } = $query; + Encode::_utf8_off( $params->{ searchTerms } ); + + $url ||= $self->description->get_best_url; + return $self->agent->search( WWW::OpenSearch::Request->new( $url, $params ) ); +} + +1; diff --git a/lib/WWW/OpenSearch/Agent.pm b/lib/WWW/OpenSearch/Agent.pm new file mode 100644 index 0000000..bc5bbec --- /dev/null +++ b/lib/WWW/OpenSearch/Agent.pm @@ -0,0 +1,68 @@ +package WWW::OpenSearch::Agent; + +use strict; +use warnings; + +use base qw( LWP::UserAgent ); + +use WWW::OpenSearch; +use WWW::OpenSearch::Response; + +=head1 NAME + +WWW::OpenSearch::Agent - An agent for doing OpenSearch requests + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head1 CONSTRUCTOR + +=head2 new( [%options] ) + +=head1 METHODS + +=head2 request( $request | $url, \%params ) + +=head2 search( ) + +An alias for request() + +=head1 AUTHOR + +=over 4 + +=item * Brian Cassidy Ebricas@cpan.orgE + +=back + +=head1 COPYRIGHT AND LICENSE + +Copyright 2007 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, @rest ) = @_; + return $class->SUPER::new( + agent => join( '/', __PACKAGE__, $WWW::OpenSearch::VERSION ), + @rest, + ); +} + +*search = \&request; + +sub request { + my $self = shift; + my $request = shift; ; + my $response = $self->SUPER::request( $request, @_ ); + + # allow regular HTTP::Requests to flow through + return $response unless $request->isa( 'WWW::OpenSearch::Request' ); + return WWW::OpenSearch::Response->new( $response ); +} + +1; diff --git a/lib/WWW/OpenSearch/Description.pm b/lib/WWW/OpenSearch/Description.pm index 6ed1e9a..0075e35 100644 --- a/lib/WWW/OpenSearch/Description.pm +++ b/lib/WWW/OpenSearch/Description.pm @@ -1,245 +1,264 @@ -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 2007 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/opensearchdescription/1.0/' ) { + $self->ns( 'http://a9.com/-/spec/opensearchrss/1.0/' ); + $version = '1.0'; + } + else { + $self->ns( $ns ); + ( $version ) = $ns =~ m{([^/]+)/?$}; + } + $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', ns => $self->ns ) ] ); + 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, ns => $self->ns ); + } + $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 ); + } + 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; + + for( $self->urls ) { + return $_ if $_->type eq $type; + }; + + return; +} 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..01dafe4 --- /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 2007 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..b75ba77 --- /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 2007 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/Request.pm b/lib/WWW/OpenSearch/Request.pm new file mode 100644 index 0000000..7c33255 --- /dev/null +++ b/lib/WWW/OpenSearch/Request.pm @@ -0,0 +1,85 @@ +package WWW::OpenSearch::Request; + +use strict; +use warnings; + +use base qw( HTTP::Request Class::Accessor::Fast ); + +use HTTP::Request::Common (); + +__PACKAGE__->mk_accessors( qw( opensearch_url opensearch_params ) ); + +=head1 NAME + +WWW::OpenSearch::Request - Encapsulate an opensearch request + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head1 CONSTRUCTOR + +=head2 new( $url, \%params ) + +=head1 METHODS + +=head2 clone( ) + +=head1 ACCESSORS + +=over 4 + +=item * opensearch_url + +=item * opensearch_params + +=back + +=head1 AUTHOR + +=over 4 + +=item * Brian Cassidy Ebricas@cpan.orgE + +=back + +=head1 COPYRIGHT AND LICENSE + +Copyright 2007 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, $os_url, $params ) = @_; + + my( $uri, $post ) = $os_url->prepare_query( $params ); + + my $self; + if( lc $os_url->method eq 'post' ) { + $self = HTTP::Request::Common::POST( $uri, $post ); + bless $self, $class; + } + else { + $self = $class->SUPER::new( $os_url->method => $uri ); + } + + $self->opensearch_url( $os_url ); + $self->opensearch_params( $params ); + + return $self; +} + +sub clone { + my $self = shift; + my $clone = bless $self->SUPER::clone, ref( $self ); + + $clone->opensearch_url( $self->opensearch_url ); + $clone->opensearch_params( $self->opensearch_params ); + + return $clone; +} + +1; diff --git a/lib/WWW/OpenSearch/Response.pm b/lib/WWW/OpenSearch/Response.pm index 1cb653b..d0b923c 100644 --- a/lib/WWW/OpenSearch/Response.pm +++ b/lib/WWW/OpenSearch/Response.pm @@ -1,233 +1,243 @@ -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 Data::Page; +use WWW::OpenSearch::Agent; +use WWW::OpenSearch::Request; + +__PACKAGE__->mk_accessors( qw( feed pager ) ); + +=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( $response ) + +Constructs a new instance of WWW::OpenSearch::Response from the +WWWW::OpenSearch: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( ) + +=head1 AUTHOR + +=over 4 + +=item * Tatsuhiko Miyagawa Emiyagawa@bulknews.netE + +=item * Brian Cassidy Ebricas@cpan.orgE + +=back + +=head1 COPYRIGHT AND LICENSE + +Copyright 2007 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 $response = shift; + + my $self = bless $response, $class; + + 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->request->opensearch_url->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( 'previous' ); + 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; + my $pagermethod = "${direction}_page"; + my $page = $pager->$pagermethod; + return unless $page; + + my $params; + my $osu = $self->request->opensearch_url; + +# this code is too fragile -- deparse depends on the order of query +# params and the like. best just to use the last query params and +# do the paging from there. +# +# if( lc $osu->method ne 'post' ) { # force query build on POST +# my $link = $self->_get_link( $direction ); +# if( $link ) { +# $params = $osu->deparse( $link ); +# } +# } + + # rebuild the query + if( !$params ) { + $params = $self->request->opensearch_params; + + # handle paging via a page # + $params->{ startPage } = $page; + + # handle paging via an index + if( exists $params->{ startIndex } ) { + # start index is pre-existing + if( $params->{ startIndex } ) { + if( $direction eq 'previous' ) { + $params->{ startIndex } -= $pager->entries_per_page + } + else { + $params->{ startIndex } += $pager->entries_per_page; + } + } + # start index did not exist previously + else { + if( $direction eq 'previous' ) { + $params->{ startIndex } = 1 + } + else { + $params->{ startIndex } = $pager->entries_per_page + 1; + } + + } } - 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; + my $agent = WWW::OpenSearch::Agent->new; + return $agent->search( WWW::OpenSearch::Request->new( + $osu, $params + ) ); +} + +sub _get_link { + my $self = shift; + my $type = shift; + my $feed = $self->feed->{ atom }; + + return unless $feed; + + for( $feed->link ) { + return $_->href if $_->rel eq $type; + } + + return; +} + +1; diff --git a/lib/WWW/OpenSearch/Url.pm b/lib/WWW/OpenSearch/Url.pm index 33cbd0a..6e4c27f 100644 --- a/lib/WWW/OpenSearch/Url.pm +++ b/lib/WWW/OpenSearch/Url.pm @@ -1,108 +1,100 @@ -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::Template; + +__PACKAGE__->mk_accessors( qw( type template method params ns ) ); + +=head1 NAME + +WWW::OpenSearch::Url - Object to represent a target URL + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head1 CONSTRUCTOR + +=head2 new( [%options] ) + +=head1 METHODS + +=head2 prepare_query( [ \%params ] ) + +=head1 ACCESSORS + +=over 4 + +=item * type + +=item * template + +=item * method + +=item * params + +=item * ns + +=back + +=head1 AUTHOR + +=over 4 + +=item * Tatsuhiko Miyagawa Emiyagawa@bulknews.netE + +=item * Brian Cassidy Ebricas@cpan.orgE + +=back + +=head1 COPYRIGHT AND LICENSE + +Copyright 2007 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::Template->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; + + return $self; +} + +sub prepare_query { + my( $self, $params ) = @_; + my $tmpl = $self->template; + + $params->{ startIndex } ||= 1; + $params->{ startPage } ||= 1; + $params->{ language } ||= '*'; + $params->{ outputEncoding } ||= 'UTF-8'; + $params->{ inputEncoding } ||= 'UTF-8'; + + # fill the uri template + my $url = $tmpl->process( %$params ); # attempt to handle POST if( $self->method eq 'post' ) { my $post = $self->params; - for( keys %macros ) { - $post->{ $macros->{ $_ } } = $params->{ $_ }; + for my $key ( keys %$post ) { + $post->{ $key } =~ s/{(.+)}/$params->{ $1 } || ''/eg; } - return [ $url, $post ]; + + return $url, [ %$post ]; } + + return $url; +} - my $query = { $url->query_form }; - for( keys %$macros ) { - $query->{ $macros->{ $_ } } = $params->{ $_ }; - } - - $url->query_form( $query ); - return $url; -} - -1; +1; diff --git a/t/00_compile.t b/t/00_compile.t index 208a797..0981f98 100644 --- a/t/00_compile.t +++ b/t/00_compile.t @@ -1,9 +1,13 @@ use strict; -use Test::More tests => 4; +use Test::More tests => 8; 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'; + use_ok 'WWW::OpenSearch::Agent'; + use_ok 'WWW::OpenSearch::Request'; } diff --git a/t/09-opensearch.t b/t/09-opensearch.t new file mode 100644 index 0000000..ba34d26 --- /dev/null +++ b/t/09-opensearch.t @@ -0,0 +1,9 @@ +use Test::More tests => 2; + +use_ok( 'WWW::OpenSearch' ); +use URI::file; + +my $uri = URI::file->new_abs( 't/data/osd.xml' ); + +my $engine = WWW::OpenSearch->new( $uri ); +isa_ok( $engine, 'WWW::OpenSearch' ); diff --git a/t/10-description.t b/t/10-description.t index 784face..3eacf72 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' ); @@ -20,14 +20,14 @@ use_ok( 'WWW::OpenSearch::Description' ); 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' ); + is( $osd->shortname, 'Web Search', 'shortname' ); + ok( !defined $osd->longname, 'longname' ); + is( $osd->description, 'Use Example.com to search the Web.', 'description' ); + is( $osd->tags, 'example web', 'tags' ); + is( $osd->contact, 'admin@example.com', 'contact' ); # count the urls - is( $osd->urls, 1 ); + is( $osd->urls, 1, 'number of url objects' ); } # complex 1.1 OSD @@ -68,30 +68,39 @@ use_ok( 'WWW::OpenSearch::Description' ); 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->shortname, 'Web Search', 'shortname' ); + is( $osd->longname, 'Example.com Web Search', 'longname' ); + is( $osd->description, 'Use Example.com to search the Web.', 'description' ); + is( $osd->tags, 'example web', 'tags' ); + is( $osd->contact, 'admin@example.com', 'contact' ); + is( $osd->developer, 'Example.com Development Team', 'developer' ); 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' ); + ', 'attribution' ); + is( $osd->inputencoding, 'UTF-8', 'inputencoding' ); + is( $osd->outputencoding, 'UTF-8', 'outputencoding' ); + is( $osd->language, 'en-us', 'language' ); + is( $osd->adultcontent, 'false', 'adultcontent' ); + is( $osd->syndicationright, 'open', 'syndicationright' ); - TODO: { - local $TODO = 'Test Query and Image'; + my $queries = $osd->query; + is( scalar @$queries, 1, 'number of query objects' ); + is( $queries->[ 0 ]->role, 'example', 'role' ); + is( $queries->[ 0 ]->searchTerms, 'cat', 'searchTerms' ); - is( $osd->query, undef ); - is( $osd->image, undef ); - }; + my $images = $osd->image; + is( scalar @$images, 2, 'number of image objects' ); + is( $images->[ 0 ]->height, 64, 'height' ); + is( $images->[ 0 ]->width, 64, 'width' ); + is( $images->[ 0 ]->type, 'image/png', 'content type' ); + is( $images->[ 0 ]->url, 'http://example.com/websearch.png', 'url' ); + is( $images->[ 1 ]->height, 16, 'height' ); + is( $images->[ 1 ]->width, 16, 'width' ); + is( $images->[ 1 ]->type, 'image/vnd.microsoft.icon', 'content type' ); + is( $images->[ 1 ]->url, 'http://example.com/websearch.ico', 'url' ); # count the urls - is( $osd->urls, 3 ); + is( $osd->urls, 3, 'number of url objects' ); } # 1.0 OSD @@ -118,21 +127,20 @@ use_ok( 'WWW::OpenSearch::Description' ); 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->shortname, 'Electronics', 'shortname' ); + is( $osd->longname, 'Amazon Electronics', 'longname' ); + is( $osd->description, 'Search for electronics on Amazon.com.', 'descrpiton' ); + is( $osd->tags, 'amazon electronics', 'tags' ); + is( $osd->contact, 'dewitt@unto.net', 'contact' ); + is( $osd->format, 'http://a9.com/-/spec/opensearchrss/1.0/', 'format' ); + is( $osd->image, 'http://www.unto.net/search/amazon_electronics.gif', 'image' ); + is( $osd->samplesearch, 'ipod', 'samplesearch' ); + is( $osd->developer, 'DeWitt Clinton', 'developer' ); is( $osd->attribution, 'Product and search data © 2005, Amazon, Inc., - All Rights Reserved' ); - is( $osd->syndicationright, 'open' ); - is( $osd->adultcontent, 'false' ); + All Rights Reserved', 'attribution' ); + is( $osd->syndicationright, 'open', 'syndicationright' ); + is( $osd->adultcontent, 'false', 'adultcontent' ); # count the urls - is( $osd->urls, 1 ); + is( $osd->urls, 1, 'urls' ); } - diff --git a/t/11-url.t b/t/11-url.t index 44ccb81..9b1e2d8 100644 --- a/t/11-url.t +++ b/t/11-url.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 27; +use Test::More tests => 36; use_ok( 'WWW::OpenSearch::Description' ); use_ok( 'WWW::OpenSearch::Url' ); @@ -16,13 +16,17 @@ use_ok( 'WWW::OpenSearch::Url' ); my $osd = WWW::OpenSearch::Description->new( $description ); isa_ok( $osd, 'WWW::OpenSearch::Description' ); - is( $osd->urls, 1 ); + is( $osd->version, '1.1', 'version' ); + is( $osd->ns, 'http://a9.com/-/spec/opensearch/1.1/', 'namespace' ); + is( $osd->urls, 1, 'number of urls' ); 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' ); + is( $url->type, 'application/rss+xml', 'content type' ); + is( lc $url->method, 'get', 'method' ); + is( $url->template, 'http://example.com/?q={searchTerms}&pw={startPage}&format=rss', 'template' ); + my $result = $url->prepare_query( { searchTerms => 'x', startPage => 1 } ); + is( $result, 'http://example.com/?q=x&pw=1&format=rss', 'prepare_query' ); } { @@ -45,30 +49,36 @@ use_ok( 'WWW::OpenSearch::Url' ); my $osd = WWW::OpenSearch::Description->new( $description ); isa_ok( $osd, 'WWW::OpenSearch::Description' ); - is( $osd->urls, 3 ); + is( $osd->urls, 3, 'number of urls' ); + is( $osd->get_best_url, $osd->url->[ 1 ], 'get_best_url' ); { 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' ); + is( $url->type, 'application/rss+xml', 'content type' ); + is( lc $url->method, 'get', 'method' ); + is( $url->template, 'http://example.com/?q={searchTerms}&pw={startPage}&format=rss', 'template' ); } { 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' ); + is( $url->type, 'application/atom+xml', 'content type' ); + is( lc $url->method, 'get', 'method' ); + is( $url->template, 'http://example.com/?q={searchTerms}&pw={startPage}&format=atom', 'template' ); } { 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' ); + is( $url->type, 'text/html', 'content type' ); + is( lc $url->method, 'post', 'method' ); + is( $url->template, 'https://intranet/search?format=html', 'template' ); + is_deeply( $url->params, { s => '{searchTerms}', o => '{startIndex}', c => '{itemsPerPage}', l => '{language}' }, 'params' ); + my( $result, $post ) = $url->prepare_query( { searchTerms => 'x', startIndex => '1', itemsPerPage => 1, language => 'en' } ); + is( $result, 'https://intranet/search?format=html', 'prepare_query (uri)' ); + $post = { @$post }; + is_deeply( $post, { s => 'x', o => 1, c => 1, l => 'en' }, 'prepare_query (params)' ); } } @@ -81,11 +91,13 @@ use_ok( 'WWW::OpenSearch::Url' ); my $osd = WWW::OpenSearch::Description->new( $description ); isa_ok( $osd, 'WWW::OpenSearch::Description' ); - is( $osd->urls, 1 ); + is( $osd->version, '1.0', 'version' ); + is( $osd->ns, 'http://a9.com/-/spec/opensearchrss/1.0/', 'namespace' ); + is( $osd->urls, 1, 'number of urls' ); 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' ); + is( lc $url->method, 'get', 'method' ); + is( $url->template, 'http://www.unto.net/aws?q={searchTerms}&searchindex=Electronics&flavor=osrss&itempage={startPage}', 'template' ); } diff --git a/t/13-request.t b/t/13-request.t new file mode 100644 index 0000000..24c9396 --- /dev/null +++ b/t/13-request.t @@ -0,0 +1,43 @@ +use Test::More tests => 9; + +use strict; +use warnings; + +use_ok( 'WWW::OpenSearch::Description' ); +use_ok( 'WWW::OpenSearch::Request' ); + +{ + my $description = q( + + + + + + + + + + +); + + my $osd = WWW::OpenSearch::Description->new( $description ); + + { + my $req = WWW::OpenSearch::Request->new( $osd->url->[ 2 ], { searchTerms => 'iPod' } ); + isa_ok( $req, 'WWW::OpenSearch::Request' ); + is( lc $req->method, 'post', 'method' ); + is( $req->uri, 'https://intranet/search?format=html', 'uri' ); + is( $req->content, 'l=*&c=&s=iPod&o=1', 'content' ); + } + + { + my $req = WWW::OpenSearch::Request->new( $osd->url->[ 1 ], { searchTerms => 'iPod' } ); + isa_ok( $req, 'WWW::OpenSearch::Request' ); + is( lc $req->method, 'get', 'method' ); + is( $req->uri, 'http://example.com/?q=iPod&pw=1&format=atom', 'uri' ); + } +} diff --git a/t/data/osd.xml b/t/data/osd.xml new file mode 100644 index 0000000..7ccafde --- /dev/null +++ b/t/data/osd.xml @@ -0,0 +1,31 @@ + + 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 + -- 2.11.0