root/WWW-OpenSearch/trunk/lib/WWW/OpenSearch/Description.pm

Revision 2405 (checked in by bricas, 13 years ago)

patch from ian beckwith to fix pod coverage

Line 
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 2007 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" if $nodename ne 'OpenSearchDescription';
173
174     my $ns = $element->getNamespace->value;
175     my $version;
176     if( $ns eq 'http://a9.com/-/spec/opensearchdescription/1.0/' ) {
177         $self->ns( 'http://a9.com/-/spec/opensearchrss/1.0/' );
178         $version = '1.0';
179     }
180     else {
181         $self->ns( $ns );
182         ( $version ) = $ns =~ m{([^/]+)/?$};
183     }
184     $self->version( $version );
185
186     for my $column ( @columns ) {
187         my $node = $doc->documentElement->getChildrenByTagName( $column ) or next;
188         if( $column eq 'Url' ) {
189             if( $version eq '1.0' ) {
190                 $self->Url( [ WWW::OpenSearch::Url->new( template => $node->string_value, type => 'application/rss+xml', ns => $self->ns ) ] );
191                 next;
192             }
193
194             my @url;
195             for my $urlnode ( $node->get_nodelist ) {
196                 my $type = $urlnode->getAttributeNode( 'type' )->value;
197                 my $url  = $urlnode->getAttributeNode( 'template' )->value;
198                 $url =~ s/\?}/}/g; # optional
199                 my $method = $urlnode->getAttributeNode( 'method' );
200                 $method = $method->value if $method;
201
202                 my %params;
203                 for( $urlnode->getChildrenByTagName( 'Param' ) ) {
204                     my $param = $_->getAttributeNode( 'name' )->value;
205                     my $value = $_->getAttributeNode( 'value' )->value;
206                     $value    =~ s/\?}/}/g; # optional
207                     $params{ $param } = $value;
208                 }
209
210                 push @url, WWW::OpenSearch::Url->new( template => $url, type => $type, method => $method, params => \%params, ns => $self->ns );
211             }
212             $self->Url( \@url );
213         }
214         elsif( $version eq '1.1' and $column eq 'Query' ) {
215             my $queries = $self->query || [];
216
217             for my $node ( $node->get_nodelist ) {
218                 my $query = WWW::OpenSearch::Query->new( {
219                     map { $_ => $node->getAttributeNode( $_ )->value } qw( role searchTerms )
220                 } );
221
222                 push @$queries, $query;
223             }
224
225             $self->query( $queries );
226         }
227         elsif( $version eq '1.1' and $column eq 'Image' ) {
228             my $images = $self->image || [];
229
230             for my $node ( $node->get_nodelist ) {
231                 my $image = WWW::OpenSearch::Image->new( {
232                     ( map { my $attr = $node->getAttributeNode( $_ ); $attr ? ($_ => $attr->value) : () } qw( height width type ) ),
233                     url => $node->string_value
234                 } );
235
236                 push @$images, $image;
237             }
238
239             $self->image( $images );
240         }
241         else {
242             $self->$column( $node->string_value );
243         }
244     }
245 }
246
247 sub get_best_url {
248     my $self = shift;
249    
250     return $self->get_url_by_type( 'application/atom+xml' )
251         || $self->get_url_by_type( 'application/rss+xml' )
252         || $self->get_url_by_type( 'text/xml' )
253         || $self->url->[ 0 ];
254 }
255
256 sub get_url_by_type {
257     my $self = shift;
258     my $type = shift;
259    
260     for( $self->urls ) {
261         return $_ if $_->type eq $type;
262     };
263    
264     return;
265 }
266
267 sub urls {
268     my $self = shift;
269     return @{ $self->url };
270 }
271
272 1;
Note: See TracBrowser for help on using the browser.