File Coverage

blib/lib/WebService/Ares.pm
Criterion Covered Total %
statement 35 64 54.6
branch 1 12 8.3
condition n/a
subroutine 9 12 75.0
pod 5 5 100.0
total 50 93 53.7


line stmt bran cond sub pod time code
1             package WebService::Ares;
2              
3             # Pragmas.
4 5     5   116823 use strict;
  5         13  
  5         150  
5 5     5   28 use warnings;
  5         9  
  5         159  
6              
7             # Modules.
8 5     5   3943 use Class::Utils qw(set_params);
  5         134841  
  5         113  
9 5     5   358 use Error::Pure qw(err);
  5         12  
  5         193  
10 5     5   4091 use HTTP::Request;
  5         156864  
  5         185  
11 5     5   7524 use LWP::UserAgent;
  5         124161  
  5         2793  
12              
13             # Version.
14             our $VERSION = 0.02;
15              
16             # Constructor.
17             sub new {
18 5     5 1 4664 my ($class, @params) = @_;
19              
20             # Create object.
21 5         13 my $self = bless {}, $class;
22              
23             # User agent.
24 5         69 $self->{'agent'} = 'WebService::Ares/'.$VERSION;
25              
26             # Debug.
27 5         13 $self->{'debug'} = 0;
28              
29             # Params.
30 5         27 set_params($self, @params);
31              
32             # Commands.
33 3         41 $self->{'commands'} = {
34             'standard' => {
35             'attr' => [
36             'ic',
37             ],
38             'method' => 'GET',
39             'url' => 'http://wwwinfo.mfcr.cz/cgi-bin/ares'.
40             '/darv_std.cgi',
41             },
42             };
43              
44             # Error string.
45 3         10 $self->{'error'} = undef;
46              
47             # User agent.
48 3         32 $self->{'ua'} = LWP::UserAgent->new;
49 3         13437 $self->{'ua'}->agent($self->{'agent'});
50              
51             # Object.
52 3         171 return $self;
53             }
54              
55             # Get web service commands.
56             sub commands {
57 1     1 1 6 my $self = shift;
58 1         2 return sort keys %{$self->{'commands'}};
  1         7  
59             }
60              
61             # Get error.
62             sub error {
63 1     1 1 6 my ($self, $clean) = @_;
64 1         2 my $error = $self->{'error'};
65 1 50       4 if ($clean) {
66 0         0 $self->{'error'} = undef;
67             }
68 1         3 return $error;
69             }
70              
71             # Get data.
72             sub get {
73 0     0 1   my ($self, $command, $def_hr) = @_;
74              
75             # Get XML data.
76 0           my $data = $self->get_xml($command, $def_hr);
77              
78             # Parse XML.
79 0           my $data_hr;
80 0 0         if ($command eq 'standard') {
81 0           require Ares::Standard;
82 0           $data_hr = Ares::Standard::parse($data);
83             }
84              
85             # Result.
86 0           return $data_hr;
87             }
88              
89             # Get XML file.
90             sub get_xml {
91 0     0 1   my ($self, $command, $def_hr) = @_;
92              
93             # Command structure.
94 0           my $c_hr = $self->{'commands'}->{$command};
95              
96             # Create url.
97 0           my $url = $c_hr->{'url'};
98 0           foreach my $key (keys %{$def_hr}) {
  0            
99             # TODO Control
100             # TODO Better create.
101 0 0         if ($key eq 'ic') {
102 0           $url .= '?ico='.$def_hr->{$key};
103             }
104             }
105              
106             # Get XML data.
107 0           return $self->_get_page($c_hr->{'method'}, $url);
108             }
109              
110             # Get page.
111             sub _get_page {
112 0     0     my ($self, $method, $url) = @_;
113              
114             # Debug.
115 0 0         if ($self->{'debug'}) {
116 0           print "Method: $method\n";
117 0           print "URL: $url\n";
118             }
119              
120             # Request.
121 0           my $req;
122 0 0         if ($method eq 'GET') {
123 0           $req = HTTP::Request->new('GET' => $url);
124             } else {
125 0           err "Method '$method' is unimplemenited.";
126             }
127              
128             # Response.
129 0           my $res = $self->{'ua'}->request($req);
130              
131             # Get page.
132 0 0         if ($res->is_success) {
133 0           return $res->content;
134             } else {
135 0           $self->{'error'} = $res->status_line;
136 0           return;
137             }
138             }
139              
140             1;
141              
142             __END__