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