1package WWW::OpenSearch::Description; 2 3use strict; 4use warnings; 5 6use base qw( Class::Accessor::Fast ); 7 8use Carp; 9use XML::LibXML; 10use WWW::OpenSearch::Url; 11use WWW::OpenSearch::Query; 12use WWW::OpenSearch::Image; 13 14my @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 26WWW::OpenSearch::Description - Encapsulate an OpenSearch Description 27provided 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 42WWW::OpenSearch::Description is a module designed to encapsulate an 43OpenSearch Description provided by an A9 OpenSearch compatible engine. 44See http://opensearch.a9.com/spec/1.1/description/ for details. 45 46=head1 CONSTRUCTOR 47 48=head2 new( [ $xml ] ) 49 50Constructs a new instance of WWW::OpenSearch::Description. If scalar 51parameter $xml is provided, data will be automatically loaded from it 52using load( $xml ). 53 54=head1 METHODS 55 56=head2 load( $xml ) 57 58Loads description data by parsing provided argument using XML::LibXML. 59 60=head2 urls( ) 61 62Return all of the urls associated with this description in an array. 63 64=head2 get_best_url( ) 65 66Attempts to retrieve the best URL associated with this description, based 67on 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 81Retrieves the first WWW::OpenSearch::URL associated with this description 82whose 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 136Copyright 2005-2013 by Tatsuhiko Miyagawa and Brian Cassidy 137 138This library is free software; you can redistribute it and/or modify 139it under the same terms as Perl itself. 140 141=cut 142 143for ( @columns ) { 144 no strict 'refs'; 145 my $col = lc; 146 *$_ = \&$col; 147} 148 149sub 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 163sub 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 270sub 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 280sub 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 291sub urls { 292 my $self = shift; 293 return @{ $self->url }; 294} 295 2961; 297