File Coverage

blib/lib/Finance/Quote/GoldMoney.pm
Criterion Covered Total %
statement 14 87 16.0
branch 0 28 0.0
condition 0 8 0.0
subroutine 6 9 66.6
pod 0 3 0.0
total 20 135 14.8


line stmt bran cond sub pod time code
1             #!/usr/bin/perl -w
2             #
3             # Copyright (C) 1998, Dj Padzensky <djpadz@padz.net>
4             # Copyright (C) 1998, 1999 Linas Vepstas <linas@linas.org>
5             # Copyright (C) 2000, Yannick LE NY <y-le-ny@ifrance.com>
6             # Copyright (C) 2000, Paul Fenwick <pjf@cpan.org>
7             # Copyright (C) 2000, Brent Neal <brentn@users.sourceforge.net>
8             # Copyright (C) 2000, Volker Stuerzl <volker.stuerzl@gmx.de>
9             # Copyright (C) 2006, Klaus Dahlke <klaus.dahlke@gmx.de>
10             # Copyright (C) 2008, Stephan Ebelt <stephan.ebelt@gmx.de>
11             #
12             # This program is free software; you can redistribute it and/or modify
13             # it under the terms of the GNU General Public License as published by
14             # the Free Software Foundation; either version 2 of the License, or
15             # (at your option) any later version.
16             #
17             # This program is distributed in the hope that it will be useful,
18             # but WITHOUT ANY WARRANTY; without even the implied warranty of
19             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20             # GNU General Public License for more details.
21             #
22             # You should have received a copy of the GNU General Public License
23             # along with this program; if not, write to the Free Software
24             # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
25             # 02110-1301, USA
26             #
27             # $Id: $
28              
29             package Finance::Quote::GoldMoney;
30             require 5.005;
31              
32 5     5   2847 use HTTP::Request::Common;
  5         23  
  5         373  
33 5     5   33 use JSON;
  5         12  
  5         68  
34              
35 5     5   725 use strict;
  5         12  
  5         166  
36 5     5   28 use warnings;
  5         12  
  5         4525  
37              
38             our $VERSION = '1.57_03'; # TRIAL VERSION
39              
40             sub methods {
41 5     5 0 24 return ( goldmoney => \&goldmoney );
42             }
43              
44             sub labels {
45 5     5 0 18 return ( goldmoney => [qw/exchange name date isodate price method/] );
46             }
47              
48             # goldmoney($quoter, @symbols)
49             #
50             # - get 'gold' and 'silver' spot rates from goldmoney.com
51             # - error out properly (that is: ignore) all other symbols
52             #
53             sub goldmoney {
54 0     0 0   my $quoter = shift;
55 0           my @symbols = @_;
56 0 0         return unless @symbols;
57              
58 0           my $ua = $quoter->user_agent;
59              
60             # Set the ua to be blank. GoldMOney are using CloudFlare who block
61             # the default useragent.
62 0           $ua->agent('');
63 0           my ( %symbolhash, @q, %info );
64 0           my ( $html_string, $te, $table_gold, $table_silver,
65             $table_platinum, $gold_gg, $gold_oz, $silver_oz,
66             $platinum_oz, $platinum_pg, $currency
67             );
68              
69 0           my $_want_gold = 0;
70 0           my $_want_silver = 0;
71 0           my $_want_platinum = 0;
72              
73             # - feed all requested symbols into %info (to be returned later)
74             # - set error state to false by default
75             # - see if a gold or silver rate is requested
76 0           foreach my $s (@symbols) {
77 0           $info{ $s, 'success' } = 0;
78 0           $info{ $s, 'exchange' } = 'goldmoney.com';
79 0           $info{ $s, 'method' } = 'goldmoney';
80 0           $info{ $s, 'symbol' } = $s;
81              
82 0 0         if ( $s eq 'gold' ) {
    0          
    0          
83 0           $_want_gold = 1;
84             }
85             elsif ( $s eq 'silver' ) {
86 0           $_want_silver = 1;
87             }
88             elsif ( $s eq 'platinum' ) {
89 0           $_want_platinum = 1;
90             }
91             else {
92 0           $info{ $s, 'errormsg' } =
93             "No data returned (note: this module only works for 'gold' and 'silver')";
94             }
95             }
96              
97             # get the JSON of the prices. Currently getting sell price,
98 0 0 0       if ( $_want_gold or $_want_silver or $_want_platinum ) {
      0        
99              
100 0   0       my $currency = $quoter->{"currency"} || 'EUR';
101 0           my $GOLDMONEY_URL =
102             "http://www.goldmoney.com/metal/prices/currentSpotPrices?currency="
103             . lc($currency)
104             . "&units=grams&price=bid";
105 0           my $response = $ua->request( GET $GOLDMONEY_URL);
106              
107 0 0         if ( $response->is_success ) {
108 0           $html_string = $response->content;
109              
110 0           my $json = from_json($html_string);
111              
112 0           $table_gold = $json->{spotPrices}[0];
113 0           $table_silver = $json->{spotPrices}[1];
114 0           $table_platinum = $json->{spotPrices}[2];
115             }
116             else {
117             # retrieval error - flag an error and return right away
118 0           foreach my $s (@symbols) {
119 0           %info = _goldmoney_error( @symbols,
120             'HTTP error: ' . $response->status_line );
121 0 0         return wantarray() ? %info : \%info;
122             }
123 0 0         return wantarray() ? %info : \%info;
124             }
125              
126             # get gold rate
127             #
128 0 0         if ($_want_gold) {
129              
130             # assemble final dataset
131             # - take "now" as date/time as the site is always current and does
132             # not provide this explicitly - so there is a time-slip
133 0           $quoter->store_date( \%info, 'gold',
134             { isodate => _goldmoney_time('isodate') } );
135              
136 0           $info{ 'gold', 'time' } = _goldmoney_time('time');
137 0           $info{ 'gold', 'name' } = 'Gold Spot';
138 0           $info{ 'gold', 'last' } = $table_gold->{spotPrice};
139 0           $info{ 'gold', 'price' } = $table_gold->{spotPrice};
140 0           $info{ 'gold', 'currency' } = $currency;
141 0           $info{ 'gold', 'success' } = 1;
142             }
143              
144             # get silver rate
145             #
146 0 0         if ($_want_silver) {
147              
148 0           $quoter->store_date( \%info, 'silver',
149             { isodate => _goldmoney_time('isodate') } );
150 0           $info{ 'silver', 'time' } = _goldmoney_time('time');
151 0           $info{ 'silver', 'name' } = 'Silver Spot';
152 0           $info{ 'silver', 'last' } = $table_silver->{spotPrice};
153 0           $info{ 'silver', 'price' } = $table_silver->{spotPrice};
154 0           $info{ 'silver', 'currency' } = $currency;
155 0           $info{ 'silver', 'success' } = 1;
156              
157             }
158              
159             # get platinum rate
160             #
161 0 0         if ($_want_platinum) {
162              
163             # assemble final dataset
164             # - take "now" as date/time as the site is always current and does
165             # not provide this explicitly - so there is a time-slip
166 0           $quoter->store_date( \%info, 'platinum',
167             { isodate => _goldmoney_time('isodate') } );
168 0           $info{ 'platinum', 'time' } = _goldmoney_time('time');
169 0           $info{ 'platinum', 'name' } = 'Platinum Spot';
170 0           $info{ 'platinum', 'last' } = $table_platinum->{spotPrice};
171 0           $info{ 'platinum', 'price' } = $table_platinum->{spotPrice};
172 0           $info{ 'platinum', 'currency' } = $currency;
173 0           $info{ 'platinum', 'success' } = 1;
174              
175             }
176             }
177              
178 0 0         return wantarray() ? %info : \%info;
179             }
180              
181             # - populate %info with errormsg and status code set for all requested symbols
182             # - return a hash ready to pass back to fetch()
183             sub _goldmoney_error {
184 0     0     my @symbols = shift;
185 0           my $msg = shift;
186 0           my %info;
187              
188 0           foreach my $s (@symbols) {
189 0           $info{ $s, "success" } = 0;
190 0           $info{ $s, "errormsg" } = $msg;
191             }
192              
193 0           return (%info);
194             }
195              
196             # - return current 'isodate' and 'time' string
197             sub _goldmoney_time {
198 0     0     my $want = shift;
199 0           my @now = localtime();
200 0           my $str;
201              
202 0 0         if ( $want eq 'isodate' ) {
    0          
203 0           $str = sprintf( '%4d-%02d-%02d', $now[5] + 1900, $now[4] + 1, $now[3] );
204             }
205             elsif ( $want eq 'time' ) {
206 0           $str = sprintf( '%02d:%02d:%02d', $now[2], $now[1], $now[0] );
207             }
208              
209 0           return ($str);
210             }
211              
212             1;
213              
214             =head1 NAME
215              
216             Finance::Quote::GoldMoney - obtain spot rates from GoldMoney.
217              
218             =head1 SYNOPSIS
219              
220             use Finance::Quote;
221              
222             $q = Finance::Quote->new;
223              
224             %rates = $q->fetch('goldmoeny','gold', 'silver', 'platinum');
225              
226             =head1 DESCRIPTION
227              
228             This module obtains current spot rates for 'gold', 'silver' and
229             'platinum' from Goldmoney (http://www.goldmoney.com). All other
230             symbols are ignored.
231              
232             Information returned by this module is governed by Net Transactions
233             Ltd.'s terms and conditions. This module is *not* affiliated with the
234             company in any way. Use at your own risk.
235              
236             =head1 LABELS RETURNED
237              
238             The following labels are returned by Finance::Quote::GoldMoney:
239              
240             - exchange
241             - name
242             - date, time
243             - price (per gram),
244             - currency
245              
246             =head1 SEE ALSO
247              
248             GoldMoney (Net Transactions Ltd.), http://www.goldmoney.com/
249              
250             =cut