File Coverage

blib/lib/Finance/Quote/XETRA.pm
Criterion Covered Total %
statement 24 109 22.0
branch 0 8 0.0
condition n/a
subroutine 10 11 90.9
pod 0 4 0.0
total 34 132 25.7


line stmt bran cond sub pod time code
1             #!/usr/bin/perl -w
2             # This program is free software; you can redistribute it and/or modify
3             # it under the terms of the GNU General Public License as published by
4             # the Free Software Foundation; either version 2 of the License, or
5             # (at your option) any later version.
6             #
7             # This program is distributed in the hope that it will be useful,
8             # but WITHOUT ANY WARRANTY; without even the implied warranty of
9             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10             # GNU General Public License for more details.
11             #
12             # You should have received a copy of the GNU General Public License
13             # along with this program; if not, write to the Free Software
14             # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
15             # 02110-1301, USA
16              
17             package Finance::Quote::XETRA;
18              
19 5     5   2618 use strict;
  5         17  
  5         166  
20 5     5   26 use warnings;
  5         12  
  5         140  
21 5     5   79 use HTML::Entities;
  5         12  
  5         329  
22              
23 5     5   31 use constant DEBUG => $ENV{DEBUG};
  5         12  
  5         308  
24 5     5   35 use if DEBUG, 'Smart::Comments';
  5         22  
  5         43  
25              
26 5     5   191 use LWP::UserAgent;
  5         13  
  5         37  
27 5     5   147 use Web::Scraper;
  5         10  
  5         50  
28              
29             our $VERSION = '1.57_03'; # TRIAL VERSION
30              
31             my $xetra_URL = 'https://web.s-investor.de/app/detail.htm?boerse=GER&isin=';
32              
33             sub methods {
34 5     5 0 32 return (xetra => \&xetra,
35             europe => \&xetra);
36             }
37              
38             sub parameters {
39 1     1 0 4 return ('INST_ID');
40             }
41              
42             our @labels = qw/symbol last close exchange volume open price change p_change/;
43              
44             sub labels {
45 5     5 0 19 return (xetra => \@labels,
46             europe => \@labels);
47             }
48              
49             sub xetra {
50 0     0 0   my $quoter = shift;
51             my $inst_id = exists $quoter->{module_specific_data}->{xetra}->{INST_ID} ?
52             $quoter->{module_specific_data}->{xetra}->{INST_ID} :
53 0 0         '0000057';
54 0           my $ua = $quoter->user_agent();
55 0           my $agent = $ua->agent;
56 0           $ua->agent('Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/74.0.3729.169 Safari/537.36');
57              
58 0           my %info;
59             my $url;
60 0           my $reply;
61              
62 0           foreach my $symbol (@_) {
63 0           eval {
64 0           my $url = $xetra_URL
65             . $symbol
66             . '&INST_ID='
67             . $inst_id;
68              
69 0           my $symlen = length($symbol);
70              
71 0           my $tree = HTML::TreeBuilder->new_from_url($url);
72              
73 0           my $lastvalue = $tree->look_down('class'=>'si_seitenbezeichnung');
74 0           my @child = $lastvalue->content_list;
75              
76 0 0         if ($child[0] eq 'S-Investor Ausnahme') {
77 0           $info{ $symbol, 'success' } = 0;
78 0           $info{ $symbol, 'errormsg' } = 'Invalid institute id. Get a valid institute id from https://web.s-investor.de/app/webauswahl.jsp';
79             } else {
80 0           $lastvalue = $tree->look_down('class'=>'si_inner_content_box');
81              
82 0           my $td1 = ($lastvalue->look_down('_tag'=>'td'))[1];
83 0           @child = $td1->content_list;
84 0           my $isin = $child[0];
85              
86 0           $td1 = ($lastvalue->look_down('_tag'=>'td'))[3];
87 0           @child = $td1->content_list;
88 0           my $sharename = $child[0];
89              
90 0           $td1 = ($lastvalue->look_down('_tag'=>'td'))[5];
91 0           @child = $td1->content_list;
92 0           my $exchange = $child[0];
93              
94 0           $td1 = ($lastvalue->look_down('_tag'=>'td'))[7];
95 0           @child = $td1->content_list;
96 0           my $date = substr($child[0], 0, 8);
97              
98 0           $td1 = ($lastvalue->look_down('_tag'=>'td'))[9];
99 0           @child = $td1->content_list;
100 0           my $price = $child[0];
101 0           $price =~ s/\.//g;
102 0           $price =~ s/,/\./;
103 0           my $encprice = encode_entities($price);
104 0           my @splitprice= split ('&',$encprice);
105 0           $price = $splitprice[0];
106              
107 0           $td1 = ($lastvalue->look_down('_tag'=>'td'))[11];
108 0           @child = $td1->content_list;
109 0           my $currency = $child[0];
110 0           $currency =~ s/Euro/EUR/;
111              
112 0           $td1 = ($lastvalue->look_down('_tag'=>'td'))[13];
113 0           @child = $td1->content_list;
114 0           my $volume = $child[0];
115              
116 0           $lastvalue = $tree->look_down('id'=>'detailVergleichszahlen');
117              
118             #-- change (absolute change)
119 0           $td1 = ($lastvalue->look_down('_tag'=>'td'))[16];
120 0           @child = $td1->content_list;
121 0           my $change = $child[0];
122 0           $change =~ s/\.//g;
123 0           $change =~ s/,/\./;
124 0           my $encchange = encode_entities($change);
125 0           my @splitcchange= split ('&',$encchange);
126 0           $change = $splitcchange[0];
127              
128             #-- p_change (relative change)
129 0           $td1 = ($lastvalue->look_down('_tag'=>'td'))[19];
130 0           @child = $td1->content_list;
131 0           my $p_change =$child[0];
132 0           $p_change =~ s/[\.|%]//g;
133 0           $p_change =~ s/,/\./;
134              
135             #-- close
136 0           $td1 = ($lastvalue->look_down('_tag'=>'td'))[37];
137 0           @child = $td1->content_list;
138 0           my $close = $child[0];
139 0           $close =~ s/\.//g;
140 0           $close =~ s/,/\./;
141 0           my $encclose = encode_entities($close);
142 0           my @splitclose= split ('&',$encclose);
143 0           $close = $splitclose[0];
144              
145 0           $info{$symbol, 'success'} = 1;
146 0           $info{$symbol, 'method'} = 'xetra';
147 0           $info{$symbol, 'symbol'} = $isin;
148 0           $info{$symbol, 'name'} = $sharename;
149 0           $info{$symbol, 'exchange'} = $exchange;
150 0           $info{$symbol, 'last'} = $price;
151 0           $info{$symbol, 'price'} = $price;
152 0           $info{$symbol, 'close'} = $close;
153 0           $info{$symbol, 'change'} = $change;
154 0           $info{$symbol, 'p_change'} = $p_change;
155 0           $info{$symbol, 'volume'} = $volume;
156 0           $info{$symbol, 'currency'} = $currency;
157             # $info{$symbol, 'date'} = $date;
158 0           $quoter->store_date(\%info, $symbol, {eurodate => $date});
159             }
160             };
161 0 0         if ($@) {
162 0           $info{$symbol, 'success'} = 0;
163 0           $info{$symbol, 'errormsg'} = "Error retreiving $symbol: $@";
164             }
165              
166              
167             }
168 0           $ua->agent($agent);
169              
170 0 0         return wantarray() ? %info : \%info;
171             }
172              
173             1;
174              
175             =head1 NAME
176              
177             Finance::Quote::xetra - Obtain quotes from S-Investor platform.
178              
179             =head1 SYNOPSIS
180              
181             use Finance::Quote;
182              
183             $q = Finance::Quote->new;
184             or
185             $q = Finance::Quote->new('XETRA', 'xetra' => {INST_ID => 'your institute id'});
186              
187             %info = Finance::Quote->fetch("xetra", "DE000ENAG999"); # Only query xetra
188             %info = Finance::Quote->fetch("europe", "brd"); # Failover to other sources OK.
189              
190             =head1 DESCRIPTION
191              
192             This module fetches information from https://s-investor.de/, the investment platform
193             of the German Sparkasse banking group. It fetches share prices from XETRA,
194             a major German trading platform. The prices on XETRA serve as the basis for calculating
195             the DAX and other stock market indices.
196              
197             Suitable for shares and ETFs that are traded in Germany.
198              
199             This module is loaded by default on a Finance::Quote object. It's also possible
200             to load it explicitly by placing "XETRA" in the argument list to
201             Finance::Quote->new().
202              
203             This module provides "xetra" and "europe" fetch methods.
204              
205             Information obtained by this module may be covered by s-investor.de terms and
206             conditions.
207              
208             =head1 INST_ID
209              
210             https://s-investor.de/ supports different institute IDs. The default value "0000057" is
211             used (Krefeld) if no institute ID is provided. A list of institute IDs is provided here:
212             https://web.s-investor.de/app/webauswahl.jsp
213              
214             The INST_ID may be set by providing a module specific hash to
215             Finance::Quote->new as in the above example (optional).
216              
217             =head1 LABELS RETURNED
218              
219             The following labels are returned:
220             currency
221             exchange
222             last
223             method
224             success
225             symbol
226             volume
227             price
228             close
229             change
230             p_change
231              
232