File Coverage

blib/lib/WebService/Nestoria/Search/MetadataResponse.pm
Criterion Covered Total %
statement 62 73 84.9
branch 17 24 70.8
condition 3 6 50.0
subroutine 10 11 90.9
pod 4 5 80.0
total 96 119 80.6


line stmt bran cond sub pod time code
1 9     9   64 use strict;
  9         20  
  9         244  
2 9     9   49 use warnings;
  9         16  
  9         8579  
3              
4             package WebService::Nestoria::Search::MetadataResponse;
5             $WebService::Nestoria::Search::MetadataResponse::VERSION = '1.022010';
6             =head1 NAME
7              
8             WebService::Nestoria::Search::MetadataResponse - Container object for the result of a metadata query to the Nestoria Search API.
9              
10             =head1 VERSION
11              
12             version 1.022010
13              
14             This package is used by WebService::Nestoria::Search and a WebService::Nestoria::Search::MetadataResponse object should never need to be explicitly created by the user.
15              
16             =cut
17              
18             sub new {
19 2     2 0 8 my $class = shift;
20 2         7 my $self;
21              
22 2         58 $self->{data} = shift;
23              
24 2         8 my $metadata = $self->{data}{response}{metadata};
25 2         14 foreach my $stat (@$metadata) {
26 43         121 my $name = $stat->{metadata_name};
27 43         207 $self->{metadata}{$name} = $stat;
28             }
29 2         39 return bless $self, $class;
30             }
31              
32             =head1 Functions
33              
34             =head2 get_hashref
35              
36             Returns a reference to a hash that contains exactly what the response from the Nestoria API gave, converted from JSON into a hashref with JSON::from_json()
37              
38             =cut
39              
40             sub get_hashref {
41 1     1 1 1111 my $self = shift;
42 1         57 return $self->{data};
43             }
44              
45             =head2 get_metadata
46              
47             Returns a reference to a hash that maps metadata names to the statistics associated with it.
48              
49             =cut
50              
51             sub get_metadata {
52 1     1 1 5 my $self = shift;
53 1         21 return $self->{metadata};
54             }
55              
56             =head2 get_average_price
57              
58             Returns the average for properties which match the number of rooms or bedrooms (come countries use rooms, some countries bedrooms), property type and listing type, for the given month.
59              
60             my %options = (
61             # required
62             listing_type => 'rent',
63             range => 'monthly', # 'monthly' ('quarterly' is deprecated, and has no data.)
64            
65             # optional depending on 'range'
66             year => 2007, # 4 digit date
67             month => 'January', # eg. '1', 'Jan' or 'January'
68              
69             # optional
70             num_beds => 3, # integer
71             num_rooms => 2, # integer
72             per_sqm => 1, # price returned per square metre
73             );
74             my $average_price = $metadata->get_average_price(%options);
75              
76             Rent prices are monthly. Prices are in local currency (EUR, GBP, INR, etc)
77             See http://www.nestoria.co.uk/help/api-metadata to see from when data is available for each country
78              
79             If year and month are not supplied data for the most recent month available will be returned.
80              
81             =cut
82              
83             sub get_average_price {
84 6     6 1 4293 my $self = shift;
85 6         25 return $self->_get_info('avg_price', @_);
86             }
87              
88             =head2 get_num_datapoints
89              
90             Called the same way as get_average_price, but instead returns the number of datapoints used to calculate the average.
91              
92             =cut
93              
94             sub get_num_datapoints {
95 0     0 1 0 my $self = shift;
96 0         0 return $self->_get_info('datapoints', @_);
97             }
98              
99             sub _get_info{
100 6     6   13 my $self = shift;
101 6         12 my $id = shift;
102              
103 6 50       29 if ( @_ % 2 != 0 ) {
104 0         0 warn "wrong arg count to get_average_price";
105             }
106 6         32 my %params = @_;
107 6         18 foreach my $required ( qw(listing_type range) ) {
108 12 50       48 if ( ! exists $params{$required} ) {
109 0         0 warn "required paramter $required not given\n";
110 0         0 return;
111             }
112             }
113              
114 6         32 my $metadata_name = $self->_get_metadata_name(%params);
115 6         39 my $metadata_date = $self->_get_metadata_date($metadata_name, %params);
116              
117 6 50 33     63 if (defined $metadata_name && defined $metadata_date) {
118 6         52 return $self->{'metadata'}{$metadata_name}{'data'}{$metadata_date}{$id};
119             }
120 0         0 return;
121             }
122              
123              
124             sub _get_metadata_name {
125 6     6   21 my $self = shift;
126 6         39 my %params = @_;
127              
128             ## avg_5bed_property_buy_monthly_per_sqm
129              
130 6         15 my $name = "avg_";
131              
132 6 100       37 if ($params{'num_beds'}) {
    50          
133 1         6 $name .= $params{'num_beds'} . "bed_";
134             }
135             elsif ($params{'num_rooms'}) {
136 0         0 $name .= $params{'num_rooms'} . "room_";
137             }
138              
139 6         22 $name .= "property_";
140 6         20 $name .= $params{'listing_type'} . "_";
141 6         13 $name .= $params{'range'};
142              
143 6 100       24 if ($params{'per_sqm'}) {
144 1         2 $name .= "_per_sqm";
145             }
146              
147 6         38 return $name;
148             }
149              
150             my %short_months = (
151             Jan => 1,
152             Feb => 2,
153             Mar => 3,
154             Apr => 4,
155             May => 5,
156             Jun => 6,
157             Jul => 7,
158             Aug => 8,
159             Sep => 9,
160             Sept => 9,
161             Oct => 10,
162             Nov => 11,
163             Dec => 12
164             );
165              
166             my %long_months = (
167             January => 1,
168             February => 2,
169             March => 3,
170             April => 4,
171             May => 5,
172             June => 6,
173             July => 7,
174             August => 8,
175             September => 9,
176             October => 10,
177             November => 11,
178             December => 12
179             );
180              
181             sub _get_metadata_date {
182 6     6   15 my $self = shift;
183 6         14 my $metadata_name = shift;
184 6         24 my %params = @_;
185              
186 6         20 my ($mm, $year) = @params{'month', 'year'};
187            
188             ## If $year & $month are not specified, we assume the user wants the most recent month that
189             ## we have metadata for...
190 6 100 66     50 if (!defined $year && !defined $mm) {
    50          
191 1         5 my $ra_metadata = $self->{'metadata'}->{$metadata_name};
192            
193 1         4 my @a_found_months = ();
194 1         4 foreach my $item ($ra_metadata){
195             ## can be 2007_q4 or 2007_m10
196 1         2 my @a_dates_this_item = keys %{$item->{'data'}};
  1         10  
197 1         54 push(@a_found_months, grep { m!\d_m\d! } @a_dates_this_item);
  12         60  
198             }
199 1         8 my ($date) = sort { _month_to_yyyymmdd($b) <=> _month_to_yyyymmdd($a) } @a_found_months;
  29         101  
200 1         9 return $date;
201             }
202             elsif ($params{'range'} eq 'monthly') {
203             my $month = exists $short_months{$mm}
204             ? $short_months{$mm}
205             : exists $long_months{$mm}
206 5 100       30 ? $long_months{$mm}
    100          
207             : $mm;
208            
209 5 50       20 if ($month == 0) {
210 0         0 $month = 12;
211 0         0 $year--;
212             }
213              
214 5         45 return sprintf '%d_m%d', $year, $month;
215             }
216              
217 0         0 return;
218             }
219              
220             sub _month_to_yyyymmdd {
221 58     58   159 my $month = shift;
222 58 50       335 if ( $month =~ m/(\d\d\d\d)_m(\d+)/ ){
223 58         378 return sprintf('%04d%02d%02d', $1, $2, 1 );
224             }
225 0           return;
226             }
227              
228             =head1 Copyright
229              
230             Copyright (C) 2014 Lokku Ltd.
231              
232             =head1 Author
233              
234             Alex Balhatchet (alex@lokku.com)
235              
236             Patches supplied by Yoav Felberbaum, Alistair Francis, Ed Freyfogle.
237              
238             =cut
239              
240             1;