File Coverage

blib/lib/Finance/Quote/BVB.pm
Criterion Covered Total %
statement 26 77 33.7
branch 0 22 0.0
condition n/a
subroutine 10 11 90.9
pod 0 3 0.0
total 36 113 31.8


line stmt bran cond sub pod time code
1             #!/usr/bin/perl -w
2             # vi: set ts=2 sw=2 noai ic showmode showmatch:
3             #
4             # Copyright (C) 2023, Bruce Schuck <bschuck@asgard-systems.com>
5             #
6             # This program is free software; you can redistribute it and/or modify
7             # it under the terms of the GNU General Public License as published by
8             # the Free Software Foundation; either version 2 of the License, or
9             # (at your option) any later version.
10             #
11             # This program is distributed in the hope that it will be useful,
12             # but WITHOUT ANY WARRANTY; without even the implied warranty of
13             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14             # GNU General Public License for more details.
15             #
16             # You should have received a copy of the GNU General Public License
17             # along with this program; if not, write to the Free Software
18             # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
19             # 02110-1301, USA
20             #
21             # Written as a replacement for Tradeville.pm.
22              
23             package Finance::Quote::BVB;
24              
25 5     5   2678 use strict;
  5         14  
  5         170  
26 5     5   36 use warnings;
  5         20  
  5         159  
27              
28 5     5   28 use Encode qw(decode);
  5         18  
  5         230  
29 5     5   52 use HTTP::Request::Common;
  5         11  
  5         289  
30 5     5   31 use HTML::TreeBuilder;
  5         12  
  5         39  
31 5     5   4164 use HTML::TableExtract;
  5         44619  
  5         41  
32              
33 5     5   249 use constant DEBUG => $ENV{DEBUG};
  5         16  
  5         330  
34 5     5   43 use if DEBUG, 'Smart::Comments', '###';
  5         11  
  5         29  
35              
36             our $VERSION = '1.57_03'; # TRIAL VERSION
37              
38             my $BVB_URL = 'https://bvb.ro/FinancialInstruments/Details/FinancialInstrumentsDetails.aspx?s=';
39              
40             sub methods {
41 5     5 0 38 return (bvb => \&bvb,
42             romania => \&bvb,
43             tradeville => \&bvb,
44             europe => \&bvb);
45             }
46              
47             our @labels = qw/symbol name open high low last bid ask date currency method/;
48              
49             sub labels {
50 5     5 0 21 return (bvb => \@labels,
51             romania => \@labels,
52             tradeville => \@labels,
53             europe => \@labels);
54             }
55              
56             sub bvb {
57              
58 0     0 0   my $quoter = shift;
59 0           my @stocks = @_;
60 0           my (%info, $tree, $table, $pricetable, $url, $reply);
61 0           my $ua = $quoter->user_agent();
62              
63 0           foreach my $stock (@stocks) {
64              
65 0           $url = $BVB_URL . $stock;
66 0           $reply = $ua->request( GET $url);
67              
68 0           my $code = $reply->code;
69 0           my $desc = HTTP::Status::status_message($code);
70 0           my $headers = $reply->headers_as_string;
71 0           my $body = decode('UTF-8', $reply->content);
72              
73             ### Body: $body
74              
75 0           my ($name, $bid, $ask, $last, $open, $high, $low, $date);
76              
77 0           $info{ $stock, "symbol" } = $stock;
78              
79 0 0         if ( $code == 200 ) {
80              
81             # Use HTML::TreeBuilder to parse HTML in $body
82 0           $tree = HTML::TreeBuilder->new;
83 0 0         if ($tree->parse($body)) {
84              
85 0           $tree->eof;
86 0 0         if ( $tree->look_down(_tag => 'div', id => 'ctl00_body_divNoData') ) {
87 0           $info{ $stock, "success" } = 0;
88 0           $info{ $stock, "errormsg" } =
89             "Error retrieving quote for $stock. No data returned";
90 0           next;
91             }
92 0           $name = $tree->look_down(_tag => 'h2', class => qr/^mBot0 large textStyled/)->as_text;
93 0           $info{ $stock, 'success' } = 1;
94 0           ($info{ $stock, 'name' } = $name) =~ s/^\s+|\s+$//g ;
95 0           $info{ $stock, 'currency' } = 'RON';
96 0           $info{ $stock, 'method' } = 'bvb';
97 0           $table = $tree->look_down(_tag => 'table', id => qr/^ctl00_body_ctl02_PricesControl_dvCPrices/)->as_HTML;
98 0           $pricetable = HTML::TableExtract->new();
99 0           $pricetable->parse($table);
100 0           foreach my $row ($pricetable->rows) {
101 0 0         if ( @$row[0] =~ m/Ask$/ ) {
    0          
    0          
    0          
    0          
    0          
102 0           ($bid, $ask) = @$row[1] =~ m|^\s+([\d\.]+)\s+\/\s+([\d\.]+)|;
103 0           $info{ $stock, 'bid' } = $bid;
104 0           $info{ $stock, 'ask' } = $ask;
105             }
106             elsif ( @$row[0] =~ m|^Date/time| ) {
107 0           ($date) = @$row[1] =~ m|^([\d/]+)\s|;
108 0 0         $quoter->store_date(\%info, $stock, {usdate => $1}) if $date =~ m|([0-9]{1,2}/[0-9]{1,2}/[0-9]{4})|;
109             }
110             elsif ( @$row[0] =~ m|^Last price| ) {
111 0           ($last) = @$row[1] =~ m|^([\d\.]+)|;
112 0           $info{ $stock, 'last' } = $last;
113             }
114             elsif ( @$row[0] =~ m|^Open price| ) {
115 0           ($open) = @$row[1] =~ m|^([\d\.]+)|;
116 0           $info{ $stock, 'open' } = $open;
117             }
118             elsif ( @$row[0] =~ m|^High price| ) {
119 0           ($high) = @$row[1] =~ m|^([\d\.]+)|;
120 0           $info{ $stock, 'high' } = $high;
121             }
122             elsif ( @$row[0] =~ m|^Low price| ) {
123 0           ($low) = @$row[1] =~ m|^([\d\.]+)|;
124 0           $info{ $stock, 'low' } = $low;
125             }
126             }
127              
128             } else {
129 0           $tree->eof;
130 0           $info{ $stock, "success" } = 0;
131 0           $info{ $stock, "errormsg" } =
132             "Error retrieving quote for $stock. Could not parse HTML returned from $url.";
133             }
134              
135             } else { # HTTP Request failed (code != 200)
136 0           $info{ $stock, "success" } = 0;
137 0           $info{ $stock, "errormsg" } =
138             "Error retrieving quote for $stock. Attempt to fetch the URL $url resulted in HTTP response $code ($desc)";
139             }
140              
141             }
142              
143 0 0         return wantarray() ? %info : \%info;
144 0           return \%info;
145              
146             }
147              
148             1;
149              
150             __END__
151              
152             =head1 NAME
153              
154             Finance::Quote::BVB - Obtain quotes from Bucharest Stock Exchange.
155              
156             =head1 SYNOPSIS
157              
158             use Finance::Quote;
159              
160             $q = Finance::Quote->new;
161              
162             %info = $q->fetch("bvb", "tlv"); # Only query bvb
163              
164             %info = $q->fetch("romania", "brd"); # Failover to other sources OK.
165              
166             =head1 DESCRIPTION
167              
168             This module fetches information from L<https://bvb.ro/>.
169              
170             This module is loaded by default on a Finance::Quote object. It's also possible
171             to load it explicitly by placing "bvb" in the argument list to
172             Finance::Quote->new().
173              
174             This module provides "bvb", "tradeville", "romania", and "europe"
175             fetch methods. It was written to replace a non-working Tradeville.pm
176             module.
177              
178             Information obtained by this module may be covered by Bucharest Stock
179             Exchange terms and conditions.
180              
181             =head1 LABELS RETURNED
182              
183             The following labels are returned:
184              
185             =over
186              
187             =item *
188              
189             name
190              
191             =item *
192              
193             symbol
194              
195             =item *
196              
197             open
198              
199             =item *
200              
201             high
202              
203             =item *
204              
205             low
206              
207             =item *
208              
209             price
210              
211             =item *
212              
213             bid
214              
215             =item *
216              
217             ask
218              
219             =item *
220              
221             date
222              
223             =item *
224              
225             currency (always RON)
226              
227             =back