lib/WWW/OpenSearch/Description.pm

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