File Coverage

blib/lib/Finance/Quote/TesouroDireto.pm
Criterion Covered Total %
statement 23 59 38.9
branch 0 10 0.0
condition n/a
subroutine 9 10 90.0
pod 0 3 0.0
total 32 82 39.0


line stmt bran cond sub pod time code
1             #!/usr/bin/perl -w
2             #
3             # This program is free software; you can redistribute it and/or modify
4             # it under the terms of the GNU General Public License as published by
5             # the Free Software Foundation; either version 2 of the License, or
6             # (at your option) any later version.
7             #
8             # This program is distributed in the hope that it will be useful,
9             # but WITHOUT ANY WARRANTY; without even the implied warranty of
10             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11             # GNU General Public License for more details.
12             #
13             # You should have received a copy of the GNU General Public License
14             # along with this program; if not, write to the Free Software
15             # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
16             # 02110-1301, USA
17             #
18             #
19             # $Id: $
20              
21             package Finance::Quote::TesouroDireto;
22             require 5.10.1;
23              
24 5     5   2652 use strict;
  5         24  
  5         150  
25 5     5   26 use warnings;
  5         23  
  5         205  
26              
27 5     5   30 use constant DEBUG => $ENV{DEBUG};
  5         20  
  5         372  
28 5     5   35 use if DEBUG, 'Smart::Comments';
  5         19  
  5         40  
29              
30 5     5   213 use LWP::UserAgent;
  5         23  
  5         44  
31 5     5   149 use HTTP::Request::Common;
  5         10  
  5         343  
32 5     5   34 use JSON;
  5         18  
  5         30  
33              
34             our $VERSION = '1.57_03'; # TRIAL VERSION
35              
36 5     5 0 26 sub methods { return (tesouro_direto => \&tesouro); }
37 5     5 0 23 sub labels { return (tesouro_direto => [qw/exchange date isodate symbol name price last method currency/]); }
38              
39             sub tesouro
40             {
41 0     0 0   my $quoter = shift;
42 0           my @funds = @_;
43 0 0         return unless @funds;
44              
45 0           my $ua = $quoter->user_agent;
46              
47             # Bad stuff to get around bad cert and ssl confs
48 0           $ua->ssl_opts(verify_hostname => 0, SSL_verify_mode => 0, SSL_cipher_list => 'DEFAULT:!DH');
49              
50 0           my (%fundsymbol, %fundhash, @q, %info);
51              
52             # create hash of all funds requested
53 0           foreach my $fund (@funds)
54             {
55 0           $fundhash{$fund} = 0;
56             }
57              
58 0           my $url = "https://www.tesourodireto.com.br/json/br/com/b3/tesourodireto/service/api/treasurybondsinfo.json";
59 0           my $response = $ua->request(GET $url);
60              
61 0 0         if ($response->is_success) {
62              
63 0           my $data = decode_json($response->content)->{'response'};
64 0           my $quote_date = substr($data->{'TrsrBondMkt'}{'qtnDtTm'},0,10);
65 0           my @bounds_list = @{$data->{'TrsrBdTradgList'}};
  0            
66              
67 0           foreach(@bounds_list) {
68              
69 0           my $quote_name = $_->{'TrsrBd'}{'nm'};
70              
71 0 0         if (exists $fundhash{$quote_name})
72             {
73 0           $fundhash{$quote_name} = 1;
74              
75 0           $info{$quote_name, "exchange"} = "Tesouro Direto";
76 0           $info{$quote_name, "name"} = $quote_name;
77 0           $info{$quote_name, "symbol"} = $quote_name;
78 0           $info{$quote_name, "price"} = $_->{'TrsrBd'}{'untrRedVal'};
79 0           $info{$quote_name, "last"} = $_->{'TrsrBd'}{'untrRedVal'};
80 0           $quoter->store_date(\%info, $quote_name, {isodate => $quote_date});
81 0           $info{$quote_name, "method"} = "tesouro_direto";
82 0           $info{$quote_name, "currency"} = "BRL";
83 0           $info{$quote_name, "success"} = 1;
84             }
85             }
86              
87             # check to make sure a value was returned for every fund requested
88 0           foreach my $fund (keys %fundhash)
89             {
90 0 0         if ($fundhash{$fund} == 0)
91             {
92 0           $info{$fund, "success"} = 0;
93 0           $info{$fund, "errormsg"} = "No data returned";
94             }
95             }
96             }
97             else
98             {
99 0           foreach my $fund (@funds)
100             {
101 0           $info{$fund, "success"} = 0;
102 0           $info{$fund, "errormsg"} = "HTTP error";
103             }
104             }
105              
106             ### result: %info
107              
108 0 0         return wantarray() ? %info : \%info;
109             }
110              
111              
112             1;
113              
114             =head1 NAME
115              
116             Finance::Quote::TesouroDireto - Obtain quotes for Brazilian government bounds
117              
118             =head1 SYNOPSIS
119              
120             use Finance::Quote;
121             $q = Finance::Quote->new;
122              
123             %stockinfo = $q->fetch("tesouro_direto", "Tesouro IPCA+ 2045");
124              
125             =head1 DESCRIPTION
126              
127             This module obtains quotes for Brazilian government bounds, obtained from
128             https://www.tesourodireto.com.br/titulos/precos-e-taxas.htm
129              
130             =head1 LABELS RETURNED
131              
132             The following labels may be returned by Finance::Quote::TesouroDireto:
133             exchange, name, symbol, date, price, last, method, currency.
134              
135             =head1 SEE ALSO
136              
137             =cut