File Coverage

blib/lib/Finance/Quote/AEX.pm
Criterion Covered Total %
statement 26 118 22.0
branch 0 26 0.0
condition 0 6 0.0
subroutine 10 15 66.6
pod 0 3 0.0
total 36 168 21.4


line stmt bran cond sub pod time code
1             #!/usr/bin/perl -w
2             # vi: set ts=4 sw=4 noai ic showmode showmatch:
3              
4             # This program is free software; you can redistribute it and/or modify
5             # it under the terms of the GNU General Public License as published by
6             # the Free Software Foundation; either version 2 of the License, or
7             # (at your option) any later version.
8             #
9             # This program is distributed in the hope that it will be useful,
10             # but WITHOUT ANY WARRANTY; without even the implied warranty of
11             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12             # GNU General Public License for more details.
13             #
14             # You should have received a copy of the GNU General Public License
15             # along with this program; if not, write to the Free Software
16             # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
17             # 02110-1301, USA
18              
19             package Finance::Quote::AEX;
20              
21 5     5   2910 use strict;
  5         10  
  5         161  
22 5     5   26 use warnings;
  5         18  
  5         170  
23              
24 5     5   30 use constant DEBUG => $ENV{DEBUG};
  5         8  
  5         417  
25 5     5   29 use if DEBUG, 'Smart::Comments';
  5         9  
  5         32  
26              
27 5     5   205 use vars qw( $AEX_URL);
  5         10  
  5         290  
28              
29 5     5   31 use LWP::UserAgent;
  5         20  
  5         187  
30 5     5   2794 use Web::Scraper;
  5         376734  
  5         36  
31 5     5   3004 use String::Util qw(trim);
  5         12339  
  5         6432  
32              
33             our $VERSION = '1.58_01'; # TRIAL VERSION
34              
35             sub methods {
36 5     5 0 49 return (dutch => \&aex,
37             aex => \&aex);
38             }
39              
40             our @labels = qw/name symbol price last date time p_change bid ask offer open high low close volume currency method exchange/;
41              
42             sub labels {
43 5     5 0 18 return (dutch => \@labels,
44             aex => \@labels);
45             }
46              
47             sub aex {
48 0     0 0   my $quoter = shift;
49 0           my $ua = $quoter->user_agent();
50 0           my $agent = $ua->agent;
51 0           $ua->agent('Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/74.0.3729.169 Safari/537.36');
52              
53 0           my %info;
54             my $url;
55 0           my $reply;
56              
57 0           foreach my $symbol (@_) {
58 0           my $isin = undef;
59              
60             # eval {
61 0           my $search = "https://live.euronext.com/en/search_instruments/$symbol";
62 0           $reply = $ua->get($search);
63              
64             ### Search: $search, $reply->code
65              
66 0 0         if (not defined $reply->previous) {
67             # Got a search page
68             my $widget = scraper {
69 0     0     process 'table#awl-lookup-instruments-directory-table a', 'link[]' => '@href';
70 0           };
71              
72 0           my $result = $widget->scrape($reply);
73              
74             # die "Failed to find $symbol" unless exists $result->{link} and @{$result->{link}} > 0;
75 0 0 0       unless (exists $result->{link} and @{$result->{link}} > 0) {
  0            
76 0           $info{$symbol, 'success'} = 0;
77 0           $info{$symbol, 'errormsg'} = 'Cannot find symbol ' . $symbol;
78 0           next;
79             }
80              
81             # Loop through linkarray. Skip links containing the string
82             # "product/indices"
83 0           for my $newlink (@{$result->{link}}) {
  0            
84             ### NewLink: $newlink
85 0 0         if ( $newlink !~ /product\/indices/i ) {
86 0           $url = $newlink;
87             ### Setting URL: $url
88 0           last;
89             }
90             }
91              
92             # die "Failed to find isin" unless $url->as_string =~ m|/([A-Za-z0-9]{12}-[A-Za-z]+)/|;
93 0 0 0       unless (defined($url) && $url->as_string =~ m|/([A-Za-z0-9]{12}-[A-Za-z]+)/|) {
94 0           $info{$symbol, 'success'} = 0;
95 0           $info{$symbol, 'errormsg'} = 'Cannot find ISIN for ' . $symbol;
96 0           next;
97             } else {
98 0           $isin = uc($1);
99             }
100            
101             }
102             else {
103             # Redirected
104             my $widget = scraper {
105 0     0     process 'a', 'redirect' => '@href';
106 0           };
107              
108 0           my $result = $widget->scrape($reply->previous->content);
109              
110             # die "Failed to find $symbol in redirect" unless exists $result->{redirect};
111 0 0         unless (exists $result->{redirect}) {
112 0           $info{$symbol, 'success'} = 0;
113 0           $info{$symbol, 'errormsg'} =
114             'Cannot find symbol ' . $symbol . ' in redirect';
115 0           next;
116             }
117            
118 0           my $url = $result->{redirect};
119            
120             # die "Failed to find isin in redirect" unless $url =~ m|/([A-Za-z0-9]{12}-[A-Za-z]+)|;
121 0 0         unless ($url =~ m|/([A-Za-z0-9]{12}-[A-Za-z]+)|) {
122 0           $info{$symbol, 'success'} = 0;
123 0           $info{$symbol, 'errormsg'} =
124             'Cannot find ISIN for ' . $symbol . ' in redirect';
125 0           next;
126             }
127            
128 0           $isin = uc($1);
129             ### ISIN: $isin
130              
131             }
132            
133             # die "No isin set" unless defined $isin;
134 0 0         unless (defined $isin) {
135 0           $info{$symbol, 'success'} = 0;
136 0           $info{$symbol, 'errormsg'} = 'No ISIN set for ' . $symbol;
137 0           next;
138             }
139              
140             # }; # End eval
141            
142 0 0         if ($@) {
143 0           my $error = "Search failed: $@";
144 0           $info{$symbol, 'success'} = 0;
145 0           $info{$symbol, 'errormsg'} = trim($error);
146 0           next;
147             }
148              
149             # eval {
150 0           my $url = "https://live.euronext.com/en/ajax/getDetailedQuote/$isin";
151 0           my %form = (theme_name => 'euronext_live');
152 0           $reply = $ua->post($url, \%form);
153              
154             ### Header : $url, $reply->code
155             ### Content: $reply->content
156              
157             my $widget = scraper {
158 0     0     process 'h1#header-instrument-name strong', 'name' => ['TEXT', sub {trim($_)}];
  0            
159 0           process 'span#header-instrument-price', 'last' => ['TEXT', sub {trim($_)}];
  0            
160             # process 'div.head_detail_bottom div.col span, div.head_detail > div > div:last-child', 'date' => ['TEXT', sub {trim($_)}];
161             # process 'div.ml-2 last-price-date-time', 'date' => ['TEXT', sub {trim($_)}];
162 0           process 'div.ml-2.last-price-date-time', 'date' => ['TEXT', sub {trim($_)}];
  0            
163 0           };
164              
165 0           my $header = $widget->scrape($reply);
166             ### Header getDetailedQuote: $header
167              
168 0           $url = "https://live.euronext.com/en/intraday_chart/getDetailedQuoteAjax/$isin/full";
169              
170 0           $reply = $ua->get($url);
171             $widget = scraper {
172 0     0     process 'div.table-responsive td:first-child, div.table-responsive td:first-child + td', 'data[]' => ['TEXT', sub {trim($_)}];
  0            
173 0           };
174              
175             ### Body : $url, $reply->code
176              
177 0           my $body = $widget->scrape($reply);
178              
179             # die "Failed to find detailed quote table" unless exists $body->{data};
180 0 0         unless (exists $body->{data}) {
181 0           $info{$symbol, 'success'} = 0;
182 0           $info{$symbol, 'errormsg'} = 'Failed to find detailed quote table';
183 0           next;
184             }
185            
186 0           my %table = @{$body->{data}};
  0            
187              
188 0           $info{$symbol, 'success'} = 1;
189 0           $info{$symbol, 'currency'} = $table{Currency};
190 0           $info{$symbol, 'volume'} = $table{Volume};
191 0           $info{$symbol, 'volume'} =~ s/,//g;
192 0           $info{$symbol, 'open'} = $table{Open};
193 0           $info{$symbol, 'high'} = $table{High};
194 0           $info{$symbol, 'low'} = $table{Low};
195              
196 0           $info{$symbol, 'name'} = $header->{name};
197 0 0         $info{$symbol, 'isin'} = $1 if $isin =~ /([A-Z0-9]{12})/;
198 0           $info{$symbol, 'last'} = $header->{last};
199              
200 0 0         $quoter->store_date(\%info, $symbol, {eurodate => $1}) if $header->{date} =~ m|([0-9]{2}/[0-9]{2}/[0-9]{4})|;
201             # }; # End eval
202              
203 0 0         if ($@) {
204 0           my $error = "Fetch/Parse failed: $@";
205 0           $info{$symbol, 'success'} = 0;
206 0           $info{$symbol, 'errormsg'} = trim($error);
207 0           next;
208             }
209             }
210              
211 0           $ua->agent($agent);
212              
213 0 0         return wantarray() ? %info : \%info;
214             }
215              
216             1;
217              
218             =head1 NAME
219              
220             Finance::Quote::AEX - Obtain quotes from Amsterdam Euronext eXchange
221              
222             =head1 SYNOPSIS
223              
224             use Finance::Quote;
225              
226             $q = Finance::Quote->new;
227              
228             %info = $q->fetch("aex", "AMG"); # Only query AEX
229             %info = $q->fetch("dutch", "AMG"); # Failover to other sources OK
230              
231             =head1 DESCRIPTION
232              
233             This module fetches information from https://live.euronext.com. Stocks and bonds
234             are supported.
235              
236             This module is loaded by default on a Finance::Quote object. It's also possible
237             to load it explicitly by placing 'aex' in the argument list to
238             Finance::Quote->new().
239              
240             =head1 LABELS RETURNED
241              
242             The following labels may be returned: currency date high isin isodate last low
243             name open success symbol volume.
244              
245             =head1 Terms & Conditions
246              
247             Use of live.euronext.com is governed by any terms & conditions of that site.
248              
249             Finance::Quote is released under the GNU General Public License, version 2,
250             which explicitly carries a "No Warranty" clause.
251              
252             =cut