File Coverage

blib/lib/Finance/Quote/Tradegate.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::Tradegate;
18              
19 5     5   2664 use strict;
  5         10  
  5         154  
20 5     5   25 use warnings;
  5         12  
  5         123  
21 5     5   26 use HTML::Entities;
  5         11  
  5         321  
22              
23 5     5   32 use constant DEBUG => $ENV{DEBUG};
  5         10  
  5         323  
24 5     5   32 use if DEBUG, 'Smart::Comments';
  5         21  
  5         28  
25              
26 5     5   180 use LWP::UserAgent;
  5         14  
  5         30  
27 5     5   185 use Web::Scraper;
  5         11  
  5         37  
28              
29             our $VERSION = '1.58_01'; # TRIAL VERSION
30              
31             my $Tradegate_URL = 'https://web.s-investor.de/app/detail.htm?boerse=TDG&isin=';
32              
33             sub methods {
34 5     5 0 26 return (tradegate => \&tradegate,
35             europe => \&tradegate);
36             }
37              
38             sub parameters {
39 1     1 0 3 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 18 return (tradegate => \@labels,
46             europe => \@labels);
47             }
48              
49             sub tradegate {
50 0     0 0   my $quoter = shift;
51             my $inst_id = exists $quoter->{module_specific_data}->{tradegate}->{INST_ID} ?
52             $quoter->{module_specific_data}->{tradegate}->{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 = $Tradegate_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            
146 0           $info{$symbol, 'success'} = 1;
147 0           $info{$symbol, 'method'} = 'Tradegate';
148 0           $info{$symbol, 'symbol'} = $isin;
149 0           $info{$symbol, 'name'} = $sharename;
150 0           $info{$symbol, 'exchange'} = $exchange;
151 0           $info{$symbol, 'last'} = $price;
152 0           $info{$symbol, 'price'} = $price;
153 0           $info{$symbol, 'close'} = $close;
154 0           $info{$symbol, 'change'} = $change;
155 0           $info{$symbol, 'p_change'} = $p_change;
156 0           $info{$symbol, 'volume'} = $volume;
157 0           $info{$symbol, 'currency'} = $currency;
158             # $info{$symbol, 'date'} = $date;
159 0           $quoter->store_date(\%info, $symbol, {eurodate => $date});
160             }
161             };
162 0 0         if ($@) {
163 0           $info{$symbol, 'success'} = 0;
164 0           $info{$symbol, 'errormsg'} = "Error retreiving $symbol: $@";
165             }
166              
167              
168             }
169 0           $ua->agent($agent);
170              
171 0 0         return wantarray() ? %info : \%info;
172             }
173              
174             1;
175              
176             =head1 NAME
177              
178             Finance::Quote::Tradegate - Obtain quotes from S-Investor platform.
179              
180             =head1 SYNOPSIS
181              
182             use Finance::Quote;
183              
184             $q = Finance::Quote->new;
185             or
186             $q = Finance::Quote->new('Tradegate', 'tradegate' => {INST_ID => 'your institute id'});
187              
188             %info = Finance::Quote->fetch("Tradegate", "DE000ENAG999"); # Only query Tradegate
189             %info = Finance::Quote->fetch("europe", "brd"); # Failover to other sources OK.
190              
191             =head1 DESCRIPTION
192              
193             This module fetches information from https://s-investor.de/, the investment platform
194             of the German Sparkasse banking group. It fetches share prices from tradegate,
195             a major German trading platform.
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 "Tradegate" in the argument list to
201             Finance::Quote->new().
202              
203             This module provides "Tradegate" 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