Subject: | AEX module broken, data source changed |
A while ago I experimented with Finance::Quote to retrieve some Dutch
stock quotes.
Unfortunately this failed horribly, both with Yahoo::Europe and AEX.
After some digging I found that the site used by AEX (www.aex.nl) is no
longer available and redirects to the homepage of another domain
www.euronext.com.
Ofter some more digging I managed to get a CSV source from this new site
and hook it in AEX.pm
The attached patch( against git:
6f0ee651d5f6d861d0b204b3883416725f7323eb) only works for common stocks,
not for futures and options.
If there is an interest I could try to also get those working again, but
I currently don't use them myself.
Subject: | AEX.patch |
diff --git a/lib/Finance/Quote/AEX.pm b/lib/Finance/Quote/AEX.pm
index 1093889..a093085 100644
--- a/lib/Finance/Quote/AEX.pm
+++ b/lib/Finance/Quote/AEX.pm
@@ -41,14 +41,13 @@ use vars qw($AEXOPT_URL $AEXOPT_FRAME_HREF $AEXOPT_SUBFRAME_URL $AEXFUT_URL $AEX
use LWP::UserAgent;
use HTTP::Request::Common qw(POST);
-use HTML::TableExtract;
-use CGI;
+use Data::Dumper;
$VERSION = '1.15';
# URLs of where to obtain information
-my $AEX_URL = 'http://www.aex.nl/scripts/marktinfo/koerszoek.asp';
+my $AEX_URL = "http://www.euronext.com/search/download/trapridownloadpopup.jcsv?pricesearchresults=actif&filter=1&belongsToList=market_EURLS&mep=8626&lan=NL&resultsTitle=Amsterdam+-+Euronext&cha=1800&format=txt&formatDecimal=.&formatDate=dd/MM/yy";
my $AEXOPT_URL = 'http://www.aex.nl/scripts/marktinfo/OptieKoersen.asp?taal=en';
my $AEXOPT_FRAME_HREF = "/scripts/marktinfo/OptieFrame.asp";
my $AEXOPT_SUBFRAME_URL = "http://www.aex.nl/scripts/marktinfo/ShowOptie.asp?taal=en";
@@ -87,131 +86,99 @@ sub methods { return (dutch => \&aex,
# Stocks and indices
sub aex {
- my $quoter = shift;
- my @symbols = @_;
- return unless @symbols;
-
- my (%info,$url,$reply,$te);
- my ($row, $datarow, $matches);
- my ($time);
-
- $url = $AEX_URL; # base url
-
-# Create a user agent object and HTTP headers
- my $ua = new LWP::UserAgent(agent => 'Mozilla/4.0 (compatible; MSIE 5.5; Windows 98)');
-
- my $headers = new HTTP::Headers(
- Accept => "text/html, text/plain, image/*",
- Content_Type => "application/x-www-form-urlencoded");
-
- foreach my $symbol (@symbols) {
-
- # Compose form-data
- my $q = new CGI( {zoek => "$symbol"} );
- my $form_data = $q->query_string;
-
- # Compose POST request
- my $request = new HTTP::Request("POST", $url, $headers);
- #printf $request . "\n";
- $request->content( $form_data );
-
- # Pass request to the user agent and get a response back
- $reply = $ua->request( $request );
-
- if ($reply->is_success) {
-
- # print STDOUT $reply->content,"\n";
-
- # Define the headers of the table to be extracted from the received HTML page
- $te = new HTML::TableExtract( headers => [qw(Fonds Current Change Time Bid Offer Volume High Low Open)]);
-
- # Parse table
- $te->parse($reply->content);
-
- # Check for a page without tables
- # This gets returned when a bad symbol name is given
- unless ( $te->tables )
- {
- $info {$symbol,"success"} = 0;
- $info {$symbol,"errormsg"} = "Fund name $symbol not found, bad symbol name";
- next;
- }
-
- # extract table contents
- my @rows;
- unless (@rows = $te->rows)
- {
- $info {$symbol,"success"} = 0;
- $info {$symbol,"errormsg"} = "Parse error";
- next;
- }
-
- # search for the fund within the table-rows (as ther might be other
- # funds having the same fundname in their prefix)
- my $found = 0;
- my $i = 0;
- while ($i < @rows ) {
- my $a = lc($rows[$i][0]); # convert to lowercase
- my $b = lc($symbol);
- $a =~ s/\s*//g; # remove spaces
- $b =~ s/\s*//g;
- if ($a eq $b) {
- $found = 1;
- last
- }
- $i++;
- }
-
- unless ( $found )
- {
- $info {$symbol,"success"} = 0;
- $info {$symbol,"errormsg"} = "Fund name $symbol not found";
- next;
- }
-
- # convert decimal comma's into points
- $rows[$i][$_] =~ s/,/./g foreach (1,4,5,7,8,9,2,6);
-
-# print STDOUT "nr rows: ", $max;
-# print STDOUT "$found,\n rows[", $i, "][0]: $rows[$i][0], symbol: $symbol\n";
-
-# $info {$symbol, "success"} = 1;
- $info {$symbol, "exchange"} = "Amsterdam Euronext eXchange";
- $info {$symbol, "method"} = "aex";
- $info {$symbol, "symbol"} = $symbol;
- ($info {$symbol, "last"} = $rows[$i][1]) =~ s/\s*//g; # Remove spaces
- ($info {$symbol, "bid"} = $rows[$i][4]) =~ s/\s*//g;
- ($info {$symbol, "offer"} = $rows[$i][5]) =~ s/\s*//g;
- ($info {$symbol, "high"} = $rows[$i][7]) =~ s/\s*//g;
- ($info {$symbol, "low"} = $rows[$i][8]) =~ s/\s*//g;
- ($info {$symbol, "open"} = $rows[$i][9]) =~ s/\s*//g;
- ($info {$symbol, "close"} = $rows[$i][1]) =~ s/\s*//g;
- ($info {$symbol, "p_change"} = $rows[$i][2]) =~ s/\s*//g;
- ($info {$symbol, "volume"} = $rows[$i][6]) =~ s/\s*//g;
-
-# Split the date and time from one table entity
- my $dateTime = $rows[$i][3];
-
-# Check for "dd mmm yyyy hh:mm" date/time format like "01 Aug 2004 16:34"
- if ($dateTime =~ m/(\d{2}) \s ([a-z]{3}) \s (\d{4}) \s
- (\d{2}:\d{2})/xi ) {
- $quoter->store_date(\%info, $symbol, {month => $2, day => $1, year => $3});
- $info {$symbol, "time"} = "$4";
- }
-
- $info {$symbol, "currency"} = "EUR";
- $info {$symbol, "success"} = 1;
- } else {
- $info {$symbol, "success"} = 0;
- $info {$symbol, "errormsg"} = "Error retrieving $symbol ";
-# $info {$symbol, "errormsg"} = $reply->message;
- }
- }
-
-# print STDOUT("Resultaat: $reply->message \n Fondsnaam: $symbol");
-
- return %info if wantarray;
- return \%info;
+ my $quoter = shift;
+ my @symbols = @_;
+ return unless @symbols;
+
+ my (%info,$url,$reply,$te);
+ my ($row, $datarow, $matches);
+ my ($time);
+
+ $url = $AEX_URL; # base url
+
+ # Create a user agent object and HTTP headers
+ my $ua = new LWP::UserAgent(agent => 'Mozilla/4.0 (compatible; MSIE 5.5; Windows 98)');
+
+ # Compose POST request
+ my $request = new HTTP::Request("GET", $url);
+
+ $reply = $ua->request( $request );
+ #print Dumper $reply;
+ if ($reply->is_success) {
+
+ # Write retreived data to temp file for debugging
+ use POSIX;
+ my $filename = tmpnam();
+ open my $fw, ">", $filename or die "$filename: $!";
+ print $fw $reply->content;
+ close $fw;
+
+ # Open reply to read lins
+ open FP, "<", \$reply->content or die "Unable to read data: $!";
+
+ # Open temp file instead while debugging
+ #open FP, "<", $filename or die "Unable to read data: $!";
+
+ # Skip the first 4 lines, which are not CSV
+ my $dummy = <FP>; # Typical content: Stocks
+ $dummy = <FP>; # Typical content: Amsterdam - Euronext
+ $dummy = <FP>; # Typical content:
+ $dummy = <FP>; # Typical content: Instrument's name;ISIN;Euronext code;Market;Symbol;ICB Sector (Level 4);Handelsvaluta;Laatst;Aantal;D/D-1 (%);Datum-tijd (CET);Omzet;Totaal aantal aandelen;Capitalisation;Trading mode;Dag Open;Dag Hoog;Dag Hoog / Datum-tijd (CET);Dag Laag;Dag Laag / Datum-tijd (CET); 31-12/Change (%); 31-12/Hoog; 31-12/Hoog/Datum; 31-12/Laag; 31-12/Laag/Datum; 52 weken/Change (%); 52 weken/Hoog; 52 weken/Hoog/Datum; 52 weken/Laag; 52 weken/Laag/Datum;Suspended;Suspended / Datum-tijd (CET);Reserved;Reserved / Datum-tijd (CET)
+
+ while (my $line = <FP>) {
+ #print Dumper $line;
+ my @row_data = $quoter->parse_csv_semicolon($line);
+ #print Dumper \@row_data;
+ my $row = \@row_data;
+ #print Dumper $row;
+ next unless @row_data;
+
+ foreach my $symbol (@symbols) {
+
+ my $found = 0;
+
+ # Match Fund's name, ISIN or symbol
+ if ( @$row[0] eq $symbol || @$row[1] eq $symbol || @$row[4] eq $symbol ) {
+ $info {$symbol, "exchange"} = "Amsterdam Euronext eXchange";
+ $info {$symbol, "method"} = "aex";
+ $info {$symbol, "symbol"} = @$row[4];
+ ($info {$symbol, "last"} = @$row[7]) =~ s/\s*//g;
+ $info {$symbol, "bid"} = undef;
+ $info {$symbol, "offer"} = undef;
+ $info {$symbol, "low"} = @$row[18];
+ $info {$symbol, "close"} = undef;
+ $info {$symbol, "p_change"} = @$row[9];
+ ($info {$symbol, "high"} = @$row[16]) =~ s/\s*//g;
+ ($info {$symbol, "volume"} = @$row[8]) =~ s/\s*//g;
+
+ # Split the date and time from one table entity
+ my $dateTime = @$row[10];
+
+ # Check for "dd mmm yyyy hh:mm" date/time format like "01 Aug 2004 16:34"
+ if ($dateTime =~ m/(\d{2})\/(\d{2})\/(\d{2}) \s
+ (\d{2}:\d{2})/xi ) {
+ $quoter->store_date(\%info, $symbol, {month => $2, day => $1, year => $3});
+ }
+
+ $info {$symbol, "currency"} = "EUR";
+ $info {$symbol, "success"} = 1;
+ }
+ }
+ }
+ }
+
+ foreach my $symbol (@symbols) {
+ unless ( !defined($info {$symbol, "success"}) || $info {$symbol, "success"} == 1 )
+ {
+ $info {$symbol,"success"} = 0;
+ $info {$symbol,"errormsg"} = "Fund name $symbol not found";
+ next;
+ }
+ }
+
+ #print Dumper \%info;
+ return %info if wantarray;
+ return \%info;
}
diff --git a/t/aex.t b/t/aex.t
index dd2bf63..57249e4 100755
--- a/t/aex.t
+++ b/t/aex.t
@@ -7,33 +7,38 @@ if (not $ENV{ONLINE_TEST}) {
plan skip_all => 'Set $ENV{ONLINE_TEST} to run this test';
}
-plan tests => 23;
+plan tests => 25;
# Test AEX functions.
my $quoter = Finance::Quote->new();
-my %quotes = $quoter->aex("AAB A NEDERLANDCRT");
+my %quotes = $quoter->aex("AH");
ok(%quotes);
# Check that some values are defined.
-ok($quotes{"AAB A NEDERLANDCRT","success"});
-ok($quotes{"AAB A NEDERLANDCRT","last"} > 0);
-ok($quotes{"AAB A NEDERLANDCRT","date"});
-ok($quotes{"AAB A NEDERLANDCRT","volume"} > 0);
+ok($quotes{"AH","success"});
+ok($quotes{"AH","last"} > 0);
+ok($quotes{"AH","date"});
+ok($quotes{"AH","volume"} > 0);
my $year = (localtime())[5] + 1900;
my $lastyear = $year - 1;
-ok(substr($quotes{"AAB A NEDERLANDCRT","isodate"},0,4) == $year ||
- substr($quotes{"AAB A NEDERLANDCRT","isodate"},0,4) == $lastyear);
-ok(substr($quotes{"AAB A NEDERLANDCRT","date"},6,4) == $year ||
- substr($quotes{"AAB A NEDERLANDCRT","date"},6,4) == $lastyear);
+ok(substr($quotes{"AH","isodate"},0,4) == $year ||
+ substr($quotes{"AH","isodate"},0,4) == $lastyear);
+ok(substr($quotes{"AH","date"},6,4) == $year ||
+ substr($quotes{"AH","date"},6,4) == $lastyear);
# Exercise the fetch function
-%quotes = $quoter->fetch("aex","AAB AEX Click Perp.");
+%quotes = $quoter->fetch("aex","AMG");
ok(%quotes);
-ok($quotes{"AAB AEX Click Perp.","success"});
-ok($quotes{"AAB AEX Click Perp.","last"} > 0);
+ok($quotes{"AMG","success"});
+ok($quotes{"AMG","last"} > 0);
+
+# Check fetching on based on ISIN
+%quotes = $quoter->aex("NL0000009165"); # NL0000009165 == Heineken == HEIA
+ok(%quotes);
+ok($quotes{"NL0000009165","success"});
# Test options fetching
# the following tests will fail after Dec 2009:-(