File Coverage

blib/lib/WWW/Fuel/US/Prices.pm
Criterion Covered Total %
statement 15 87 17.2
branch 0 48 0.0
condition n/a
subroutine 5 11 45.4
pod 6 6 100.0
total 26 152 17.1


line stmt bran cond sub pod time code
1             package WWW::Fuel::US::Prices;
2              
3 1     1   28486 use warnings;
  1         3  
  1         41  
4 1     1   6 use strict;
  1         2  
  1         39  
5 1     1   6 use Carp;
  1         7  
  1         111  
6              
7 1     1   1206 use version; our $VERSION = qv('0.0.4');
  1         2480  
  1         7  
8              
9              
10             # Other recommended modules (uncomment to use):
11             # use IO::Prompt;
12             # use Perl6::Export;
13             # use Perl6::Slurp;
14             # use Perl6::Say;
15 1     1   1354 use HTTP::Lite;
  1         17993  
  1         1504  
16              
17             # Module implementation here
18             sub new
19             {
20 0     0 1   my $class = shift;
21 0           my $self = {};
22            
23 0           bless $self;
24 0           $self->{zip} = shift;
25            
26 0           my $http = new HTTP::Lite;
27 0           my $req = $http->request(
28             "http://autos.msn.com/everyday/GasStations.aspx?m=1&l=1&zip=" .
29             $self->{zip});
30 0           my $body = $http->body();
31 0           $body =~ s/\n/ /g;
32 0           $body =~ s/\r/ /g;
33 0           $body =~ s/\cM/ /g;
34            
35 0           $self->{units} = undef;
36            
37 0 0         if($body =~ /(.*?)<\/table>/) (.*?)<\/tr>/g)
38             {
39 0           my $data = $1;
40 0           $data =~ s/^\s+//;
41 0           $data =~ s/\s+$//;
42            
43 0           my @units = ();
44            
45 0           while ($data =~ /
46             {
47 0           my $unit = $1;
48 0 0         if($unit =~
49             /(.*?)<\/span>.*?(.*?)<\/span>.*?(.*?)<\/span>.*?(.*?)<\/span>.*?(.*?)<\/span>.*?(.*?)<\/span>.*?(.*?)<\/span>.*?(.*?)<\/span>.*?(.*?)<\/span>.*?(.*?)<\/span>.*?(.*?)<\/span>/)
50             {
51 0           my $station_info =
52             {
53             station_name => $1,
54             station_address => "$2, $3",
55             unleaded_price => $4,
56             unleaded_date => $5,
57             plus_price => $6,
58             plus_date => $7,
59             premium_price => $8,
60             premium_date => $9,
61             diesel_price => $10,
62             diesel_date => $11
63             };
64            
65            
66 0 0         $station_info->{unleaded_price} = $1
67             if ($station_info->{unleaded_price} =~
68             /\$(.*)/);
69            
70 0 0         $station_info->{plus_price} = $1
71             if ($station_info->{plus_price} =~
72             /\$(.*)/);
73            
74 0 0         $station_info->{premium_price} = $1
75             if ($station_info->{premium_price} =~
76             /\$(.*)/);
77            
78 0 0         $station_info->{diesel_price} = $1
79             if ($station_info->{diesel_price} =~
80             /\$(.*)/);
81            
82 0           push @units, $station_info;
83             }
84             }
85            
86 0           $self->{units} = \@units;
87            
88             #use Data::Dumper;
89             #print Dumper @units;
90              
91 0           return $self;
92             }
93 0           return undef;
94             }
95              
96             sub get_stations
97             {
98 0     0 1   my $self = shift;
99 0           return $self->{units};
100             }
101              
102             sub get_cheapest_station
103             {
104 0     0 1   my $self = shift;
105 0           my $type = shift;
106            
107 0           my @units = @{$self->{units}};
  0            
108            
109 0           my $lowest_price = undef;
110 0           my $cheapest_station = undef;
111            
112            
113 0           foreach(@units)
114             {
115 0 0         $cheapest_station = $_ if(!$cheapest_station);
116 0 0         if($self->is_less( $_->{$type . "_price"},
117             $cheapest_station->{$type . "_price"}))
118             {
119 0           $cheapest_station = $_;
120             }
121 0           $lowest_price = $cheapest_station->{$type . "_price"};
122             }
123            
124 0           return $cheapest_station;
125             }
126              
127             sub get_most_expensive_station
128             {
129 0     0 1   my $self = shift;
130 0           my $type = shift;
131            
132 0           my @units = @{$self->{units}};
  0            
133            
134 0           my $highest_price = undef;
135 0           my $most_expensive_station = undef;
136            
137            
138 0           foreach(@units)
139             {
140 0 0         $most_expensive_station = $_ if(!$most_expensive_station);
141 0 0         if($self->is_greater($_->{$type . "_price"},
142             $most_expensive_station->{$type . "_price"}))
143             {
144 0           $most_expensive_station = $_;
145             }
146            
147 0           $highest_price = $most_expensive_station->{$type . "_price"};
148             }
149            
150 0           return $most_expensive_station;
151            
152             }
153              
154             sub is_greater
155             {
156 0     0 1   my ($self, $first, $second) = @_;
157            
158 0 0         $first = $1 if($first =~ /\$(.*)/);
159 0 0         $second = $1 if($second =~ /\$(.*)/);
160            
161 0 0         return 0 if($first =~ /N\/A/);
162 0 0         return 0 if($first =~/nbsp/);
163            
164 0 0         return 1 if($second =~ /N\/A/);
165 0 0         return 1 if($second =~/nbsp/);
166            
167 0 0         return 1 if($first > $second);
168 0           return 0;
169             }
170              
171             sub is_less
172             {
173 0     0 1   my ($self, $first, $second) = @_;
174            
175 0 0         $first = $1 if($first =~ /\$(.*)/);
176 0 0         $second = $1 if($second =~ /\$(.*)/);
177              
178 0 0         return 0 if($first =~ /N\/A/);
179 0 0         return 0 if($first =~/nbsp/);
180            
181 0 0         return 1 if($second =~ /N\/A/);
182 0 0         return 1 if($second =~/nbsp/);
183            
184 0 0         return 1 if($first < $second);
185 0           return 0;
186             }
187              
188             1; # Magic true value required at end of module
189             __END__