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 |