File: Url.pm

package info (click to toggle)
libwww-opensearch-perl 0.17-2
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 228 kB
  • sloc: perl: 1,663; xml: 31; makefile: 2
file content (101 lines) | stat: -rw-r--r-- 1,741 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
package WWW::OpenSearch::Url;

use strict;
use warnings;

use base qw( Class::Accessor::Fast );

use URI::Template;

__PACKAGE__->mk_accessors( qw( type template method params ns ) );

=head1 NAME

WWW::OpenSearch::Url - Object to represent a target URL

=head1 SYNOPSIS

=head1 DESCRIPTION

=head1 CONSTRUCTOR

=head2 new( [%options] )

=head1 METHODS

=head2 prepare_query( [ \%params ] )

=head1 ACCESSORS

=over 4

=item * type

=item * template

=item * method

=item * params

=item * ns

=back

=head1 AUTHOR

=over 4

=item * Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>

=item * Brian Cassidy E<lt>bricas@cpan.orgE<gt>

=back

=head1 COPYRIGHT AND LICENSE

Copyright 2005-2013 by Tatsuhiko Miyagawa and Brian Cassidy

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=cut

sub new {
    my ( $class, %options ) = @_;

    $options{ method } ||= 'GET';
    $options{ template } = URI::Template->new( $options{ template } );

    my $self = $class->SUPER::new( \%options );

    return $self;
}

sub prepare_query {
    my ( $self, $params ) = @_;
    my $tmpl = $self->template;

    for ( qw( startIndex startPage ) ) {
        $params->{ $_ } = 1 if !defined $params->{ $_ };
    }
    $params->{ language }       ||= '*';
    $params->{ outputEncoding } ||= 'UTF-8';
    $params->{ inputEncoding }  ||= 'UTF-8';

    # fill the uri template
    my $url = $tmpl->process( %$params );

    # attempt to handle POST
    if ( $self->method eq 'post' ) {
        my $post = $self->params;
        for my $key ( keys %$post ) {
            $post->{ $key } =~ s/{(.+)}/$params->{ $1 } || ''/eg;
        }

        return $url, [ %$post ];
    }

    return $url;
}

1;