lib/WWW/OpenSearch/Description.pm

   1 package WWW::OpenSearch::Description;\r
   2 \r
   3 use strict;\r
   4 use warnings;\r
   5 \r
   6 use base qw( Class::Accessor::Fast );\r
   7 \r
   8 use Carp;\r
   9 use XML::LibXML;\r
  10 use WWW::OpenSearch::Url;\r
  11 \r
  12 my @columns = qw(\r
  13     AdultContent Contact     Description      Developer\r
  14     Format       Image       LongName         Query\r
  15     SampleSearch ShortName   SyndicationRight Tags\r
  16     Url          Attribution InputEncoding    OutputEncoding
  17     Language\r
  18 );\r
  19 \r
  20 __PACKAGE__->mk_accessors( qw( version ns ), map { lc } @columns );\r
  21 \r
  22 =head1 NAME\r
  23 \r
  24 WWW::OpenSearch::Description - Encapsulate an OpenSearch Description\r
  25 provided by an A9 OpenSearch compatible engine\r
  26 \r
  27 =head1 SYNOPSIS\r
  28     \r
  29     use WWW::OpenSearch;\r
  30     \r
  31     my $url = "http://bulkfeeds.net/opensearch.xml";\r
  32     my $engine = WWW::OpenSearch->new($url);\r
  33     my $description = $engine->description;\r
  34     \r
  35     my $format   = $description->Format;   # or $description->format\r
  36     my $longname = $description->LongName; # or $description->longname\r
  37     \r
  38 =head1 DESCRIPTION\r
  39 \r
  40 WWW::OpenSearch::Description is a module designed to encapsulate an\r
  41 OpenSearch Description provided by an A9 OpenSearch compatible engine.\r
  42 See http://opensearch.a9.com/spec/1.1/description/ for details.\r
  43 \r
  44 =head1 CONSTRUCTOR\r
  45 \r
  46 =head2 new( [ $xml ] )\r
  47 \r
  48 Constructs a new instance of WWW::OpenSearch::Description. If scalar\r
  49 parameter $xml is provided, data will be automatically loaded from it\r
  50 using load( $xml ).\r
  51 \r
  52 =head1 METHODS\r
  53 \r
  54 =head2 load( $xml )\r
  55 \r
  56 Loads description data by parsing provided argument using XML::LibXML.
  57
  58 =head2 urls( )
  59
  60 Return all of the urls associated with this description in an array.\r
  61 \r
  62 =head2 get_best_url( )\r
  63 \r
  64 Attempts to retrieve the best URL associated with this description, based\r
  65 on the following content types (from most preferred to least preferred):\r
  66 \r
  67 =over 4\r
  68 \r
  69 =item * application/atom+xml\r
  70 \r
  71 =item * application/rss+xml\r
  72 \r
  73 =item * text/xml\r
  74 \r
  75 =back\r
  76 \r
  77 =head2 get_url_by_type( $type )\r
  78 \r
  79 Retrieves the first WWW::OpenSearch::URL associated with this description\r
  80 whose type is equal to $type.\r
  81 \r
  82 =head1 ACCESSORS\r
  83 \r
  84 =head2 version( )\r
  85 \r
  86 =head2 ns( )\r
  87 \r
  88 =head2 AdultContent( )\r
  89 \r
  90 =head2 Contact( )\r
  91 \r
  92 =head2 Description( )\r
  93 \r
  94 =head2 Developer( )\r
  95 \r
  96 =head2 Format( )\r
  97 \r
  98 =head2 Image( )\r
  99 \r
 100 =head2 LongName( )\r
 101 \r
 102 =head2 Query( )\r
 103 \r
 104 =head2 SampleSearch( )\r
 105 \r
 106 =head2 ShortName( )\r
 107 \r
 108 =head2 SyndicationRight( )\r
 109 \r
 110 =head2 Tags( )\r
 111 \r
 112 =head2 Url( )\r
 113 \r
 114 =head1 AUTHOR\r
 115 \r
 116 =over 4\r
 117 \r
 118 =item * Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>\r
 119 \r
 120 =item * Brian Cassidy E<lt>bricas@cpan.orgE<gt>\r
 121 \r
 122 =back\r
 123 \r
 124 =head1 COPYRIGHT AND LICENSE\r
 125 \r
 126 Copyright 2006 by Tatsuhiko Miyagawa and Brian Cassidy\r
 127 \r
 128 This library is free software; you can redistribute it and/or modify\r
 129 it under the same terms as Perl itself. \r
 130 \r
 131 =cut\r
 132 \r
 133 for( @columns ) {\r
 134     no strict 'refs';\r
 135     my $col = lc;\r
 136     *$_ = \&$col;\r
 137 }\r
 138 \r
 139 sub new {\r
 140     my $class = shift;\r
 141     my $xml   = shift;\r
 142     \r
 143     my $self  = $class->SUPER::new;\r
 144     \r
 145     eval{ $self->load( $xml ); } if $xml;\r
 146     if( $@ ) {\r
 147         croak "Error while parsing Description XML: $@";\r
 148     }\r
 149 \r
 150     return $self;\r
 151 }\r
 152 \r
 153 sub load {\r
 154     my $self = shift;\r
 155     my $xml  = shift;\r
 156     \r
 157     my $parser   = XML::LibXML->new;\r
 158     my $doc      = $parser->parse_string( $xml );\r
 159     my $element  = $doc->documentElement;\r
 160     my $nodename = $element->nodeName;\r
 161 \r
 162     croak "Node should be OpenSearchDescription: $nodename" if $nodename ne 'OpenSearchDescription';\r
 163 \r
 164     my $ns = $element->getNamespace->value;\r
 165     my $version;\r
 166     if( $ns eq 'http://a9.com/-/spec/opensearch/1.1/' ) {\r
 167         $self->ns( $ns );\r
 168         $version = '1.1';\r
 169     }\r
 170     else {\r
 171         $version = '1.0';\r
 172     }\r
 173     $self->version( $version );\r
 174 \r
 175     for my $column ( @columns ) {\r
 176         my $node = $doc->documentElement->getChildrenByTagName( $column ) or next;\r
 177         if( $column eq 'Url' ) {\r
 178             if( $version eq '1.0' ) {\r
 179                 $self->Url( [ WWW::OpenSearch::Url->new( template => $node->string_value, type => 'application/rss+xml' ) ] );\r
 180                 next;\r
 181             }\r
 182 \r
 183             my @url;\r
 184             for my $urlnode ( $node->get_nodelist ) {\r
 185                 my $type = $urlnode->getAttributeNode( 'type' )->value;\r
 186                 my $url  = $urlnode->getAttributeNode( 'template' )->value;\r
 187                 $url =~ s/\?}/}/g; # optional\r
 188                 my $method = $urlnode->getAttributeNode( 'method' );\r
 189                 $method = $method->value if $method;\r
 190
 191                 my %params;\r
 192                 for( $urlnode->getChildrenByTagName( 'Param' ) ) {\r
 193                     my $param = $_->getAttributeNode( 'name' )->value;\r
 194                     my $value = $_->getAttributeNode( 'value' )->value;
 195                     $value    =~ s/\?}/}/g; # optional\r
 196                     $params{ $param } = $value;\r
 197                 }\r
 198 \r
 199                 push @url, WWW::OpenSearch::Url->new( template => $url, type => $type, method => $method, params => \%params );\r
 200             }\r
 201             $self->Url( \@url );\r
 202         }\r
 203         elsif( $version eq '1.1' and $column eq 'Query' ) {\r
 204             my $query = ( $node->get_nodelist )[ 0 ];\r
 205             next if $query->getAttributeNode( 'role' )->value eq 'example';\r
 206             $self->SampleSearch( $query->getAttributeNode( 'searchTerms' )->value );\r
 207         }\r
 208         elsif( $version eq '1.0' and $column eq 'Format' ) {\r
 209             $self->Format( $node->string_value );\r
 210             $self->ns( $self->Format );\r
 211         }\r
 212         else {\r
 213             $self->$column( $node->string_value );\r
 214         }\r
 215     }\r
 216 }\r
 217 \r
 218 sub get_best_url {\r
 219     my $self = shift;\r
 220     \r
 221     return $self->get_url_by_type( 'application/atom+xml' )\r
 222         || $self->get_url_by_type( 'application/rss+xml' )\r
 223         || $self->get_url_by_type( 'text/xml' )\r
 224         || $self->url->[ 0 ];\r
 225 }\r
 226 \r
 227 sub get_url_by_type {\r
 228     my $self = shift;\r
 229     my $type = shift;\r
 230     \r
 231     my $template;\r
 232     for( $self->urls ) {\r
 233         $template = $_ if $_->type eq $type;\r
 234         last;\r
 235     };\r
 236     \r
 237     return $template;\r
 238 }\r
 239
 240 sub urls {
 241     my $self = shift;
 242     return @{ $self->url };
 243 }
 244 \r
 245 1;\r