root/WWW-OpenSearch/branches/WWW-OpenSearch-rewrite/lib/WWW/OpenSearch/Description.pm

Revision 1821 (checked in by bricas, 14 years ago)

applied Adam's pod patch

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