File Coverage

blib/lib/Finance/Quote/OnVista.pm
Criterion Covered Total %
statement 20 107 18.6
branch 0 30 0.0
condition n/a
subroutine 8 9 88.8
pod 0 3 0.0
total 28 149 18.7


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   2713 use strict;
  5         11  
  5         191  
38 5     5   48 use LWP::UserAgent;
  5         11  
  5         31  
39 5     5   153 use HTTP::Request::Common;
  5         17  
  5         298  
40 5     5   48 use HTML::TreeBuilder;
  5         10  
  5         80  
41 5     5   142 use Encode;
  5         9  
  5         522  
42              
43             our $VERSION = '1.57_03'; # TRIAL VERSION
44              
45 5     5   35 use vars qw($OnVista_URL);
  5         11  
  5         5634  
46              
47             my $OnVista_URL = 'https://www.onvista.de';
48              
49 5     5 0 23 sub methods {return (onvista => \&onvista);}
50 5     5 0 19 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