| Subject: | Finance::Quote::HEX broken (patch included) |
I noticed that the module to fetch the information for the Helsinki
(HEX) is broken in this version, as the website that provides the
information has changed.
I am not a Perl programmer, but I tried to make this fix. I tested it
only in my machine, so I am not 100% sure that it will work in every
case, but I guess that it is already better.
Attached is a patch for it. Just in case I didn't create the patch
correctly, I am also attaching the new version of the file.
Thanks!
| Subject: | HexUpdate.patch |
44c44
< $VERSION = '1.15';
---
> $VERSION = "1.16";
46c46
< $HEX_URL = 'http://omxgroup.is-teledata.com/html/securitypricelistequities.html?language=fi';
---
> $HEX_URL = 'http://www.nasdaqomxnordic.com/webproxy/DataFeedProxy.aspx';
50,51c50
< sub methods {return ('europe' => \&hex, 'finland' => \&hex,'hex' => \&hex)}
<
---
> sub methods {return ('finland' => \&hex,'hex' => \&hex)}
65c64,65
< # Maintainer of this section is Mika Laari <laari@iki.fi>.
---
> # Maintainer of this section is Mika Laari <laari@iki.fi>.
> # Adjustments by <mcarvalho@gmail.com>
76c76,82
< my $response = $ua->request(GET $url);
---
> my $req = new HTTP::Request POST => $url;
> $req->content_type('application/x-www-form-urlencoded; charset=UTF-8');
> $req->header('X-Requested-With: XMLHttpRequest');
> $req->content('xmlquery=<post> <param name="Exchange" value="NMF"/> <param name="SubSystem" value="Prices"/> <param name="Action" value="GetMarket"/> <param name="inst__a" value="0,87,1,2,5,37,4,20,21,23,24,33,34,97,129,98"/> <param name="ext_xslt" value="inst_table.xsl"/> <param name="Market" value="L:3272"/> <param name="Market" value="L:3270"/> <param name="Market" value="L:3271"/> <param name="inst__e" value="7"/> <param name="instrumentType" value="S"/> <param name="ext_xslt_sortattribute" value="fnm"/> <param name="ext_xslt_lang" value="en"/> <param name="ext_xslt_tableId" value="searchSharesListTable"/> <param name="ext_xslt_hiddenattrs" value=",lists,tp,hlp,isin,note,"/> <param name="ext_xslt_tableClass" value="tablesorter"/> <param name="ext_xslt_options" value=",noflag,sectoridicon,truncate,mylist,"/> </post>');
>
> my $response = $ua->request($req);
>
90c96,101
< $te->parse($response->content);
---
> my $adjusted_content = $response->content;
> $adjusted_content =~ s!<tr class="[a-z]+" id="searchSharesListTable-[A-Z0-9]+" title="([^-]+)\s-\s[^"]+">\s*<td[^>]+>!<tr><td>$1</td>!gm;
>
> #printf $adjusted_content;
>
> $te->parse($adjusted_content);
107d117
< foreach my $row (@rows) {
109c119,120
< my $stock = $$row[1];
---
> foreach my $row (@rows) {
> my $stock = $$row[0];
120c131
< $info{$stock,'name'} = $$row[0];
---
> $info{$stock,'name'} = $$row[1];
123c134
< $info{$stock,'p_change'} = $$row[3];
---
> $info{$stock,'p_change'} = $$row[4];
127,130c138,141
< $info{$stock,'bid'} = $$row[4];
< $info{$stock,'ask'} = $$row[5];
< $info{$stock,'high'} = $$row[6];
< $info{$stock,'low'} = $$row[7];
---
> $info{$stock,'bid'} = $$row[6];
> $info{$stock,'ask'} = $$row[7];
> #$info{$stock,'high'} = $$row[6];
> #$info{$stock,'low'} = $$row[7];
132c143
< $info{$stock,'last'} = $$row[8];
---
> $info{$stock,'last'} = $$row[3];
136c147
< $info{$stock,'volume'} = $$row[9];
---
> $info{$stock,'volume'} = $$row[8];
140,142c151,153
< foreach my $label (qw/last bid ask high low p_change/) {
< $info{$stock,$label} =~ s/,/./;
< }
---
> #foreach my $label (qw/last bid ask high low p_change/) {
> # $info{$stock,$label} =~ s/,/./;
> #}
143a155
> $info{$stock, "currency"} = $$row[2];
145d156
< $info{$stock, "currency"} = "EUR";
150a162
> if ($info{$stock, "price"} == '') { $info{$stock, "price"} = $info{$stock,"ask"}; }
| Subject: | HEX.pm |
#!/usr/bin/perl -w
#
# Copyright (C) 1998, Dj Padzensky <djpadz@padz.net>
# Copyright (C) 1998, 1999 Linas Vepstas <linas@linas.org>
# Copyright (C) 2000, Yannick LE NY <y-le-ny@ifrance.com>
# Copyright (C) 2000, Paul Fenwick <pjf@cpan.org>
# Copyright (C) 2000, Brent Neal <brentn@users.sourceforge.net>
# Copyright (C) 2001, Leigh Wedding <leigh.wedding@telstra.com>
# Copyright (C) 2006, Mika Laari <mika.laari@iki.fi>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
# 02111-1307, USA
#
#
# This code derived from Padzensky's work on package Finance::YahooQuote,
# but extends its capabilites to encompas a greater number of data sources.
#
# This code was developed as part of GnuCash <http://www.gnucash.org/>
require 5.005;
use strict;
package Finance::Quote::HEX;
use HTTP::Request::Common;
use LWP::UserAgent;
use HTML::TableExtract;
use vars qw/$HEX_URL $VERSION/;
$VERSION = "1.16";
$HEX_URL = 'http://www.nasdaqomxnordic.com/webproxy/DataFeedProxy.aspx';
# XXX Europe should probably be removed since this module provides only
# the Finnish quotes.
sub methods {return ('finland' => \&hex,'hex' => \&hex)}
{
my @labels = qw/name last high low date isodate time p_change volume bid ask
price method exchange/;
sub labels { return ('europe' => \@labels,
'finland' => \@labels,
'hex' => \@labels); }
}
# Helsinki Stock Exchange (HEX)
# The HEX provides free delayed quotes through their webpage.
# This module is heavily based on the ASX.pm.
#
# Maintainer of this section is Mika Laari <laari@iki.fi>.
# Adjustments by <mcarvalho@gmail.com>
sub hex {
my $quoter = shift;
my @stocks = @_;
return unless @stocks;
my %info;
my $ua = $quoter->user_agent;
my $url = $HEX_URL;
my $req = new HTTP::Request POST => $url;
$req->content_type('application/x-www-form-urlencoded; charset=UTF-8');
$req->header('X-Requested-With: XMLHttpRequest');
$req->content('xmlquery=<post> <param name="Exchange" value="NMF"/> <param name="SubSystem" value="Prices"/> <param name="Action" value="GetMarket"/> <param name="inst__a" value="0,87,1,2,5,37,4,20,21,23,24,33,34,97,129,98"/> <param name="ext_xslt" value="inst_table.xsl"/> <param name="Market" value="L:3272"/> <param name="Market" value="L:3270"/> <param name="Market" value="L:3271"/> <param name="inst__e" value="7"/> <param name="instrumentType" value="S"/> <param name="ext_xslt_sortattribute" value="fnm"/> <param name="ext_xslt_lang" value="en"/> <param name="ext_xslt_tableId" value="searchSharesListTable"/> <param name="ext_xslt_hiddenattrs" value=",lists,tp,hlp,isin,note,"/> <param name="ext_xslt_tableClass" value="tablesorter"/> <param name="ext_xslt_options" value=",noflag,sectoridicon,truncate,mylist,"/> </post>');
my $response = $ua->request($req);
unless ($response->is_success) {
foreach my $stock (@stocks) {
$info{$stock,"success"} = 0;
$info{$stock,"errormsg"} = "HTTP session failed";
}
return wantarray() ? %info : \%info;
}
# Get a table containing information for all the stocks.
my $te = HTML::TableExtract->new();
my $adjusted_content = $response->content;
$adjusted_content =~ s!<tr class="[a-z]+" id="searchSharesListTable-[A-Z0-9]+" title="([^-]+)\s-\s[^"]+">\s*<td[^>]+>!<tr><td>$1</td>!gm;
#printf $adjusted_content;
$te->parse($adjusted_content);
# Extract table contents.
my @rows;
unless (@rows = $te->rows) {
foreach my $stock (@stocks) {
$info{$stock,"success"} = 0;
$info{$stock,"errormsg"} = "Failed to parse HTML table.";
}
return wantarray() ? %info : \%info;
}
# Prepare an array for checking whether a symbol is among the wanted ones.
my %is_stock = ();
for (@stocks) { $is_stock{uc($_)} = 1 }
# Pack the resulting data into our structure.
foreach my $row (@rows) {
my $stock = $$row[0];
next unless $stock;
# Delete spaces and high bit characters.
$stock =~ tr/ \200-\377//d;
next unless $is_stock{$stock};
$info{$stock,'symbol'} = $stock;
$info{$stock,'name'} = $$row[1];
$info{$stock,'name'} =~ s/^\s*(.*?)\s*$/$1/;
$info{$stock,'p_change'} = $$row[4];
# Remove possible plus and other unnecessary characters.
$info{$stock,'p_change'} =~ s/\+?(-?\d+,\d+)%/$1/;
$info{$stock,'bid'} = $$row[6];
$info{$stock,'ask'} = $$row[7];
#$info{$stock,'high'} = $$row[6];
#$info{$stock,'low'} = $$row[7];
$info{$stock,'last'} = $$row[3];
# Again, get rid of nasty high-bit characters.
#$info{$stock,'last'} =~ tr/ \200-\377//d;
$info{$stock,'volume'} = $$row[8];
$info{$stock,'volume'} =~ tr/ \200-\377//d;
# Use deciman point instead of comma.
#foreach my $label (qw/last bid ask high low p_change/) {
# $info{$stock,$label} =~ s/,/./;
#}
$info{$stock, "currency"} = $$row[2];
$quoter->store_date(\%info, $stock, {today => 1});
# $info{$stock, "time"} = $time;
$info{$stock, "method"} = "hex";
$info{$stock, "exchange"} = "Helsinki Stock Exchange";
$info{$stock, "price"} = $info{$stock,"last"};
if ($info{$stock, "price"} == '') { $info{$stock, "price"} = $info{$stock,"ask"}; }
$info{$stock, "success"} = 1;
}
# All done.
return %info if wantarray;
return \%info;
}
1;
=head1 NAME
Finance::Quote::HEX - Obtain quotes from the Helsinki Stock Exchange.
=head1 SYNOPSIS
use Finance::Quote;
$q = Finance::Quote->new;
%stockinfo = $q->fetch("hex","NOK1V"); # Only query ASX.
%stockinfo = $q->fetch("finland","NOK1V"); # Failover to other sources OK.
=head1 DESCRIPTION
This module obtains information from the Helsinki Stock Exchange
http://www.hex.com/. All Finnish stocks are available.
This module is not loaded by default on a Finance::Quote object.
It's possible to load it explicity by placing "HEX" in the argument
list to Finance::Quote->new().
This module provides both the "hex" and "finland" fetch methods.
Please use the "finland" fetch method if you wish to have failover
with other sources for Finnish stocks. Using the "hex" method will
guarantee that your information only comes from the Helsinki Stock
Exchange.
=head1 LABELS RETURNED
The following labels may be returned by Finance::Quote::HEX:
name, last, high, low, date, time, p_change, volume, bid, ask,
price, method and exchange.
=head1 SEE ALSO
Helsinki Stock Exchange, http://www.hex.com/
=cut