File Coverage

blib/lib/WebService/ClinicalTrialsdotGov/Request.pm
Criterion Covered Total %
statement 21 41 51.2
branch 0 2 0.0
condition n/a
subroutine 7 10 70.0
pod 3 3 100.0
total 31 56 55.3


line stmt bran cond sub pod time code
1             package WebService::ClinicalTrialsdotGov::Request;
2              
3 3     3   20 use strict;
  3         7  
  3         130  
4 3     3   18 use warnings;
  3         6  
  3         106  
5              
6 3     3   17 use Data::Dumper;
  3         5  
  3         159  
7 3     3   17 use Carp qw( cluck );
  3         7  
  3         145  
8              
9 3     3   20 use HTTP::Request;
  3         4  
  3         96  
10 3     3   15 use URI;
  3         7  
  3         84  
11 3     3   2684 use Clone qw( clone );
  3         11734  
  3         1082  
12              
13             my $RH_BASE_URIS = {
14             'search' => 'http://clinicaltrials.gov/search',
15             'show' => 'http://clinicaltrials.gov/show',
16             };
17              
18             =head1 NAME
19              
20             WebService::ClinicalTrialsdotGov::Request - Wrapper around the clinicaltrials.gov API
21              
22             =head1 FUNCTIONS
23              
24             =head1 FUNCTIONS
25              
26             =head2 new
27              
28             Creates a new request object.
29             Do not use this function directly.
30              
31             =cut
32              
33             sub new {
34 0     0 1   my $class = shift;
35 0           my $rh_params = shift;
36              
37 0           my $self = { };
38 0           bless $self, $class;
39              
40 0           my $uri = $self->create_uri( $rh_params );
41 0           $self->{request} = HTTP::Request->new( 'GET', $uri );
42              
43 0           bless $self, $class;
44            
45             }
46              
47             =head2 create_uri
48              
49             Creates and encodes the URI.
50             Do not use this function directly.
51              
52             =cut
53              
54             sub create_uri {
55 0     0 1   my $self = shift;
56 0           my $rh_params = shift;
57            
58 0           my $rh_search_params = clone( $rh_params );
59            
60 0           my $base_uri =
61             $RH_BASE_URIS->{ $rh_search_params->{'mode'} };
62            
63 0 0         if ( $rh_params->{'mode'} eq 'show' ) {
64 0           $base_uri = sprintf('%s/%s', $base_uri, $rh_params->{'id'} );
65 0           delete $rh_search_params->{id};
66             }
67            
68 0           delete $rh_search_params->{mode};
69            
70 0           my $uri = URI->new( $base_uri, 'http' ) ;
71              
72 0           $uri->query_form( %$rh_search_params ) ;
73            
74 0           return $uri ;
75            
76             }
77              
78             =head2 request
79              
80             Returns the internal HTTP request object.
81             Do not use this function directly.
82              
83             =cut
84              
85             sub request {
86 0     0 1   my $self = shift;
87 0           return $self->{request};
88             }
89              
90             =head1 AUTHOR
91              
92             Spiros Denaxas, C<< >>
93              
94             =head1 BUGS
95              
96             Please report any bugs or feature requests to C, or through
97             the web interface at L. I will be notified, and then you'll
98             automatically be notified of progress on your bug as I make changes.
99              
100             =head1 SUPPORT
101              
102             You can find documentation for this module with the perldoc command.
103              
104             perldoc WebService::ClinicalTrialsdotGov
105              
106             You can also look for information at:
107              
108             =over 4
109              
110             =item * RT: CPAN's request tracker
111              
112             L
113              
114             =item * AnnoCPAN: Annotated CPAN documentation
115              
116             L
117              
118             =item * CPAN Ratings
119              
120             L
121              
122             =item * Search CPAN
123              
124             L
125              
126             =back
127              
128             =head1 COPYRIGHT & LICENSE
129              
130             Copyright 2010 Spiros Denaxas, all rights reserved.
131              
132             This program is free software; you can redistribute it and/or modify it
133             under the same terms as Perl itself.
134              
135              
136             =cut
137              
138             1;