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

Revision 1802 (checked in by bricas, 15 years ago)

Initial Import of rewrite branch

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 for( @columns ) {
22     no strict 'refs';
23     my $col = lc;
24     *$_ = \&$col;
25 }
26
27 sub new {
28     my $class = shift;
29     my $xml   = shift;
30    
31     my $self  = $class->SUPER::new;
32    
33     eval{ $self->load( $xml ); } if $xml;
34     if( $@ ) {
35         croak "Error while parsing Description XML: $@";
36     }
37
38     return $self;
39 }
40
41 sub load {
42     my $self = shift;
43     my $xml  = shift;
44    
45     my $parser   = XML::LibXML->new;
46     my $doc      = $parser->parse_string( $xml );
47     my $element  = $doc->documentElement;
48     my $nodename = $element->nodeName;
49
50     croak "Node should be OpenSearchDescription: $nodename" if $nodename ne 'OpenSearchDescription';
51
52     my $ns = $element->getNamespace->value;
53     my $version;
54     if( $ns eq 'http://a9.com/-/spec/opensearch/1.1/' ) {
55         $self->ns( $ns );
56         $version = '1.1';
57     }
58     else {
59         $version = '1.0';
60     }
61     $self->version( $version );
62
63     for my $column ( @columns ) {
64         my $node = $doc->documentElement->getChildrenByTagName( $column ) or next;
65         if( $column eq 'Url' ) {
66             if( $version eq '1.0' ) {
67                 $self->Url( [ WWW::OpenSearch::Url->new( template => $node->string_value, type => 'application/rss+xml' ) ] );
68                 next;
69             }
70
71             my @url;
72             for my $urlnode ( $node->get_nodelist ) {
73                 my $type = $urlnode->getAttributeNode( 'type' )->value;
74                 my $url  = $urlnode->getAttributeNode( 'template' )->value;
75                 $url =~ s/\?}/}/g; # optional
76                 my $method = $urlnode->getAttributeNode( 'method' );
77                 $method = $method->value if $method;
78
79                 # TODO
80                 # properly handle POST
81                 for( $urlnode->getChildrenByTagName( 'Param' ) ) {
82                     my $join = '&';
83                     if( $url =~ /&/ ) {
84                         $join = '?';
85                     }
86                     my $param = $_->getAttributeNode( 'name' )->value;
87                     my $value = $_->getAttributeNode( 'value' )->value;
88                     $url .= "$join$param=$value";
89                 }
90
91                 push @url, WWW::OpenSearch::Url->new( template => $url, type => $type, method => $method );
92             }
93             $self->Url( \@url );
94         }
95         elsif( $version eq '1.1' and $column eq 'Query' ) {
96             my $query = ( $node->get_nodelist )[ 0 ];
97             next if $query->getAttributeNode( 'role' )->value eq 'example';
98             $self->SampleSearch( $query->getAttributeNode( 'searchTerms' )->value );
99         }
100         elsif( $version eq '1.0' and $column eq 'Format' ) {
101             $self->Format( $node->string_value );
102             $self->ns( $self->Format );
103         }
104         else {
105             $self->$column( $node->string_value );
106         }
107     }
108 }
109
110 sub get_best_url {
111     my $self = shift;
112    
113     return $self->get_url_by_type( 'application/atom+xml' )
114         || $self->get_url_by_type( 'application/rss+xml' )
115         || $self->get_url_by_type( 'text/xml' )
116         || $self->url->[ 0 ];
117 }
118
119 sub get_url_by_type {
120     my $self = shift;
121     my $type = shift;
122    
123     my $template;
124     for( @{ $self->url } ) {
125         $template = $_ if $_->type eq $type;
126         last;
127     };
128    
129     return $template;
130 }
131
132 1;
Note: See TracBrowser for help on using the browser.