--- /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
projects / libwww-opensearch-perl.git / blobdiff