| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
#!/usr/bin/perl -w |
|
2
|
|
|
|
|
|
|
# |
|
3
|
|
|
|
|
|
|
# Copyright (C) 1998, Dj Padzensky <djpadz@padz.net> |
|
4
|
|
|
|
|
|
|
# Copyright (C) 1998, 1999 Linas Vepstas <linas@linas.org> |
|
5
|
|
|
|
|
|
|
# Copyright (C) 2000, Yannick LE NY <y-le-ny@ifrance.com> |
|
6
|
|
|
|
|
|
|
# Copyright (C) 2000, Paul Fenwick <pjf@cpan.org> |
|
7
|
|
|
|
|
|
|
# Copyright (C) 2000, Brent Neal <brentn@users.sourceforge.net> |
|
8
|
|
|
|
|
|
|
# Copyright (C) 2001, Rob Sessink <rob_ses@users.sourceforge.net> |
|
9
|
|
|
|
|
|
|
# Copyright (C) 2005, Morten Cools <morten@cools.no> |
|
10
|
|
|
|
|
|
|
# Copyright (C) 2006, Dominique Corbex <domcox@sourceforge.net> |
|
11
|
|
|
|
|
|
|
# Copyright (C) 2008, Bernard Fuentes <bernard.fuentes@gmail.com> |
|
12
|
|
|
|
|
|
|
# Copyright (C) 2009, Erik Colson <eco@ecocode.net> |
|
13
|
|
|
|
|
|
|
# |
|
14
|
|
|
|
|
|
|
# This program is free software; you can redistribute it and/or modify |
|
15
|
|
|
|
|
|
|
# it under the terms of the GNU General Public License as published by |
|
16
|
|
|
|
|
|
|
# the Free Software Foundation; either version 2 of the License, or |
|
17
|
|
|
|
|
|
|
# (at your option) any later version. |
|
18
|
|
|
|
|
|
|
# |
|
19
|
|
|
|
|
|
|
# This program is distributed in the hope that it will be useful, |
|
20
|
|
|
|
|
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
21
|
|
|
|
|
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
22
|
|
|
|
|
|
|
# GNU General Public License for more details. |
|
23
|
|
|
|
|
|
|
# |
|
24
|
|
|
|
|
|
|
# You should have received a copy of the GNU General Public License |
|
25
|
|
|
|
|
|
|
# along with this program; if not, write to the Free Software |
|
26
|
|
|
|
|
|
|
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA |
|
27
|
|
|
|
|
|
|
# 02111-1307, USA |
|
28
|
|
|
|
|
|
|
# |
|
29
|
|
|
|
|
|
|
# 2017-01-10 Julian Wollrath <jwollrath@web.de> |
|
30
|
|
|
|
|
|
|
# |
|
31
|
|
|
|
|
|
|
# * (0.1) iniial release |
|
32
|
|
|
|
|
|
|
# |
|
33
|
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
package Finance::Quote::OnVista; |
|
35
|
|
|
|
|
|
|
require 5.005; |
|
36
|
|
|
|
|
|
|
|
|
37
|
5
|
|
|
5
|
|
2669
|
use strict; |
|
|
5
|
|
|
|
|
12
|
|
|
|
5
|
|
|
|
|
159
|
|
|
38
|
5
|
|
|
5
|
|
30
|
use LWP::UserAgent; |
|
|
5
|
|
|
|
|
25
|
|
|
|
5
|
|
|
|
|
30
|
|
|
39
|
5
|
|
|
5
|
|
133
|
use HTTP::Request::Common; |
|
|
5
|
|
|
|
|
13
|
|
|
|
5
|
|
|
|
|
327
|
|
|
40
|
5
|
|
|
5
|
|
34
|
use HTML::TreeBuilder; |
|
|
5
|
|
|
|
|
11
|
|
|
|
5
|
|
|
|
|
41
|
|
|
41
|
5
|
|
|
5
|
|
140
|
use Encode; |
|
|
5
|
|
|
|
|
26
|
|
|
|
5
|
|
|
|
|
535
|
|
|
42
|
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
our $VERSION = '1.58'; # VERSION |
|
44
|
|
|
|
|
|
|
|
|
45
|
5
|
|
|
5
|
|
42
|
use vars qw($OnVista_URL); |
|
|
5
|
|
|
|
|
12
|
|
|
|
5
|
|
|
|
|
5756
|
|
|
46
|
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
my $OnVista_URL = 'https://www.onvista.de'; |
|
48
|
|
|
|
|
|
|
|
|
49
|
5
|
|
|
5
|
0
|
27
|
sub methods {return (onvista => \&onvista);} |
|
50
|
5
|
|
|
5
|
0
|
23
|
sub labels {return ( onvista => [qw/name last date isodate time currency method exchange/] );} |
|
51
|
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
sub onvista { |
|
53
|
0
|
|
|
0
|
0
|
|
my $quoter = shift; |
|
54
|
0
|
|
|
|
|
|
my @stocks = @_; |
|
55
|
0
|
|
|
|
|
|
my (%info, $reply); |
|
56
|
0
|
|
|
|
|
|
my $ua = $quoter->user_agent(); |
|
57
|
|
|
|
|
|
|
|
|
58
|
0
|
|
|
|
|
|
foreach my $stock (@stocks) { |
|
59
|
0
|
|
|
|
|
|
my $queryUrl = "$OnVista_URL/suche/$stock"; |
|
60
|
0
|
|
|
|
|
|
$reply = $ua->request(GET $queryUrl); |
|
61
|
|
|
|
|
|
|
|
|
62
|
0
|
|
|
|
|
|
eval { |
|
63
|
0
|
|
|
|
|
|
my $tree = HTML::TreeBuilder->new_from_content(decode_utf8 $reply->content); |
|
64
|
0
|
|
|
|
|
|
my $row = $tree->look_down('_tag' => 'tr', 'class' => 'HERVORGEHOBEN'); |
|
65
|
0
|
|
|
|
|
|
my $link = $row->look_down('_tag' => 'a'); |
|
66
|
0
|
|
|
|
|
|
$queryUrl = $OnVista_URL . $link->attr('href'); |
|
67
|
0
|
|
|
|
|
|
$reply = $ua->request(GET $queryUrl); |
|
68
|
|
|
|
|
|
|
}; |
|
69
|
|
|
|
|
|
|
|
|
70
|
0
|
0
|
|
|
|
|
if ($@) { |
|
71
|
0
|
|
|
|
|
|
$info{ $stock, "success" } = 0; |
|
72
|
0
|
|
|
|
|
|
$info{ $stock, "errormsg" } = "Error retreiving $stock redirect: $@"; |
|
73
|
|
|
|
|
|
|
} |
|
74
|
|
|
|
|
|
|
|
|
75
|
0
|
0
|
|
|
|
|
if ($reply->is_success) { |
|
76
|
|
|
|
|
|
|
|
|
77
|
0
|
|
|
|
|
|
$info{ $stock, "success" } = 1; |
|
78
|
|
|
|
|
|
|
|
|
79
|
0
|
|
|
|
|
|
my $tree = HTML::TreeBuilder->new_from_content(decode_utf8 $reply->content); |
|
80
|
|
|
|
|
|
|
|
|
81
|
0
|
|
|
|
|
|
my @nameline = $tree->look_down('property', 'schema:name'); |
|
82
|
|
|
|
|
|
|
|
|
83
|
0
|
0
|
|
|
|
|
if (not @nameline) { |
|
84
|
0
|
|
|
|
|
|
@nameline = $tree->look_down('class', 'inline name'); |
|
85
|
0
|
0
|
|
|
|
|
if (not @nameline) { |
|
86
|
0
|
|
|
|
|
|
@nameline = $tree->look_down('class', 'ui medium header'); |
|
87
|
|
|
|
|
|
|
} |
|
88
|
|
|
|
|
|
|
} |
|
89
|
|
|
|
|
|
|
|
|
90
|
0
|
0
|
|
|
|
|
unless (@nameline) { |
|
91
|
0
|
|
|
|
|
|
$info{ $stock, "success" } = 0; |
|
92
|
0
|
|
|
|
|
|
$info{ $stock, "errormsg" } = "Stock name $stock not retrievable"; |
|
93
|
0
|
|
|
|
|
|
next; |
|
94
|
|
|
|
|
|
|
} |
|
95
|
|
|
|
|
|
|
|
|
96
|
0
|
|
|
|
|
|
my $name = $nameline[0]->as_text; |
|
97
|
0
|
|
|
|
|
|
$name =~ s/^\s+|\s+$//g; |
|
98
|
0
|
|
|
|
|
|
$info{ $stock, "name" } = $name; |
|
99
|
|
|
|
|
|
|
|
|
100
|
0
|
|
|
|
|
|
$info{ $stock, "method" } = "onvista"; |
|
101
|
|
|
|
|
|
|
|
|
102
|
0
|
|
|
|
|
|
my $exchange = $tree->look_down('property', 'schema:seller'); |
|
103
|
0
|
0
|
|
|
|
|
if ($exchange) { |
|
104
|
0
|
|
|
|
|
|
$info{ $stock, "exchange" } = $exchange->attr_get_i('content'); |
|
105
|
|
|
|
|
|
|
} |
|
106
|
|
|
|
|
|
|
|
|
107
|
0
|
|
|
|
|
|
my @currencyline = $tree->look_down('property', 'schema:priceCurrency'); |
|
108
|
0
|
0
|
|
|
|
|
if (not @currencyline) { |
|
109
|
0
|
|
|
|
|
|
@currencyline = $tree->look_down('id', 'current-quote-currency'); |
|
110
|
|
|
|
|
|
|
} |
|
111
|
0
|
0
|
|
|
|
|
if (@currencyline) { |
|
112
|
0
|
|
|
|
|
|
my $currency = $currencyline[0]->as_text; |
|
113
|
0
|
|
|
|
|
|
$info{ $stock, "currency" } = $currency; |
|
114
|
|
|
|
|
|
|
} else { |
|
115
|
0
|
|
|
|
|
|
@currencyline = $tree->look_down('class', 'price'); |
|
116
|
0
|
|
|
|
|
|
my $currency = ( $currencyline[0]->content_list )[0]; |
|
117
|
0
|
|
|
|
|
|
$currency =~ s/.* //; |
|
118
|
0
|
|
|
|
|
|
$info{ $stock, "currency" } = $currency; |
|
119
|
|
|
|
|
|
|
} |
|
120
|
|
|
|
|
|
|
|
|
121
|
0
|
|
|
|
|
|
my @lastline = $tree->look_down('data-push', qr/.*last.*Stock/); |
|
122
|
0
|
0
|
|
|
|
|
if (not @lastline) { |
|
123
|
0
|
|
|
|
|
|
@lastline = $tree->look_down('id', 'current-quote-price'); |
|
124
|
|
|
|
|
|
|
} |
|
125
|
0
|
0
|
|
|
|
|
if (not @lastline) { |
|
126
|
0
|
|
|
|
|
|
@lastline = $tree->look_down('class', 'price'); |
|
127
|
0
|
0
|
|
|
|
|
if (@lastline) { |
|
128
|
0
|
|
|
|
|
|
my $last = ( $lastline[0]->content_list )[0]; |
|
129
|
0
|
|
|
|
|
|
$last =~ s/,/./; |
|
130
|
0
|
|
|
|
|
|
$last =~ s/ .*//; |
|
131
|
0
|
|
|
|
|
|
$info{ $stock, "last" } = $last; |
|
132
|
|
|
|
|
|
|
} else { |
|
133
|
0
|
|
|
|
|
|
my $last = $tree->look_down('property', 'schema:price'); |
|
134
|
0
|
0
|
|
|
|
|
if ($last) { |
|
135
|
0
|
|
|
|
|
|
$info{ $stock, "last" } = $last->attr_get_i('content'); |
|
136
|
|
|
|
|
|
|
} |
|
137
|
|
|
|
|
|
|
} |
|
138
|
|
|
|
|
|
|
} else { |
|
139
|
0
|
|
|
|
|
|
my $last = $lastline[0]->as_text; |
|
140
|
0
|
|
|
|
|
|
$last =~ s/,/./; |
|
141
|
0
|
|
|
|
|
|
$info{ $stock, "last" } = $last; |
|
142
|
|
|
|
|
|
|
} |
|
143
|
|
|
|
|
|
|
|
|
144
|
0
|
|
|
|
|
|
my @datetimeline = $tree->find_by_tag_name('cite'); |
|
145
|
0
|
0
|
|
|
|
|
if (not @datetimeline) { |
|
146
|
0
|
|
|
|
|
|
@datetimeline = $tree->look_down('id', 'current-quote-datetime'); |
|
147
|
0
|
0
|
|
|
|
|
if (@datetimeline) { |
|
148
|
0
|
|
|
|
|
|
my $datetime = $datetimeline[0]->as_text; |
|
149
|
0
|
|
|
|
|
|
my $date = substr($datetime, 4, 2)."/".substr($datetime, 1, 2)."/".substr($datetime, 7, 4); |
|
150
|
0
|
|
|
|
|
|
my $time = substr($datetime, 13, 8); |
|
151
|
0
|
|
|
|
|
|
$info{ $stock, "date" } = $date; |
|
152
|
0
|
|
|
|
|
|
$info{ $stock, "time" } = $time; |
|
153
|
|
|
|
|
|
|
} else { |
|
154
|
0
|
|
|
|
|
|
@datetimeline = $tree->look_down('class', 'datetime'); |
|
155
|
0
|
|
|
|
|
|
my $datetime = ( $datetimeline[0]->content_list )[0]; |
|
156
|
0
|
|
|
|
|
|
my $date = substr($datetime, 3, 2)."/".substr($datetime, 0, 2)."/".substr($datetime, 6, 4); |
|
157
|
0
|
|
|
|
|
|
my $time = substr($datetime, 12, 8); |
|
158
|
0
|
|
|
|
|
|
$info{ $stock, "date" } = $date; |
|
159
|
0
|
|
|
|
|
|
$info{ $stock, "time" } = $time; |
|
160
|
|
|
|
|
|
|
} |
|
161
|
|
|
|
|
|
|
} else { |
|
162
|
0
|
|
|
|
|
|
my $datetime = $datetimeline[0]->as_text; |
|
163
|
0
|
|
|
|
|
|
my $date = substr($datetime, 5, 2)."/".substr($datetime, 2, 2)."/".substr($datetime, 8, 4); |
|
164
|
0
|
|
|
|
|
|
my $time = substr($datetime, 14, 8); |
|
165
|
0
|
|
|
|
|
|
$info{ $stock, "date" } = $date; |
|
166
|
0
|
|
|
|
|
|
$info{ $stock, "time" } = $time; |
|
167
|
|
|
|
|
|
|
} |
|
168
|
|
|
|
|
|
|
|
|
169
|
0
|
|
|
|
|
|
$quoter->store_date(\%info, $stock, {usdate => $info{$stock, "date"}}); |
|
170
|
0
|
|
|
|
|
|
$tree->delete; |
|
171
|
|
|
|
|
|
|
} |
|
172
|
|
|
|
|
|
|
else { |
|
173
|
0
|
|
|
|
|
|
$info{ $stock, "success" } = 0; |
|
174
|
0
|
|
|
|
|
|
$info{ $stock, "errormsg" } = "Error retreiving $stock"; |
|
175
|
|
|
|
|
|
|
} |
|
176
|
|
|
|
|
|
|
} |
|
177
|
0
|
0
|
|
|
|
|
return wantarray() ? %info : \%info; |
|
178
|
0
|
|
|
|
|
|
return \%info; |
|
179
|
|
|
|
|
|
|
} |
|
180
|
|
|
|
|
|
|
1; |
|
181
|
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
=head1 NAME |
|
183
|
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
Finance::Quote::OnVista - Obtain quotes from OnVista. |
|
185
|
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
187
|
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
use Finance::Quote; |
|
189
|
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
$q = Finance::Quote->new; |
|
191
|
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
%info = Finance::Quote->fetch("onvista","ml"); # Only query OnVista |
|
193
|
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
195
|
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
This module fetches information from OnVista, https://www.onvista.de. All stocks are available. |
|
197
|
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
This module is loaded by default on a Finance::Quote object. It's |
|
199
|
|
|
|
|
|
|
also possible to load it explicitly by placing "onvista" in the argument |
|
200
|
|
|
|
|
|
|
list to Finance::Quote->new(). |
|
201
|
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
Information obtained by this module may be covered by www.onvista.de |
|
203
|
|
|
|
|
|
|
terms and conditions See https://www.onvista.de/ for details. |
|
204
|
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=head1 LABELS RETURNED |
|
206
|
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
The following labels may be returned by Finance::Quote::OnVista : |
|
208
|
|
|
|
|
|
|
name, last, date, isodate, time, currency, method, exchange. |
|
209
|
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
=head1 SEE ALSO |
|
211
|
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
OnVista (german web site), https://www.onvista.de |
|
213
|
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
=cut |