File Coverage

blib/lib/Finance/Quote/Sinvestor.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::Sinvestor;
18              
19 5     5   2734 use strict;
  5         17  
  5         151  
20 5     5   25 use warnings;
  5         10  
  5         126  
21 5     5   28 use HTML::Entities;
  5         10  
  5         383  
22              
23 5     5   31 use constant DEBUG => $ENV{DEBUG};
  5         14  
  5         320  
24 5     5   31 use if DEBUG, 'Smart::Comments';
  5         9  
  5         35  
25              
26 5     5   195 use LWP::UserAgent;
  5         11  
  5         41  
27 5     5   123 use Web::Scraper;
  5         10  
  5         32  
28              
29             our $VERSION = '1.57_03'; # TRIAL VERSION
30              
31             my $Sinvestor_URL = 'https://web.s-investor.de/app/detail.htm?isin=';
32              
33             sub methods {
34 5     5 0 29 return (sinvestor => \&sinvestor,
35             europe => \&sinvestor);
36             }
37              
38             sub parameters {
39 1     1 0 5 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 (sinvestor => \@labels,
46             europe => \@labels);
47             }
48              
49             sub sinvestor {
50 0     0 0   my $quoter = shift;
51             my $inst_id = exists $quoter->{module_specific_data}->{sinvestor}->{INST_ID} ?
52             $quoter->{module_specific_data}->{sinvestor}->{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 = $Sinvestor_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'} = 'Sinvestor';
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::Sinvestor - 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('Sinvestor', 'sinvestor' => {INST_ID => 'your institute id'});
186              
187             %info = Finance::Quote->fetch("Sinvestor", "DE000ENAG999"); # Only query Sinvestor
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 various online
194             and physical exchanges, and fund prices from the investment companies. The source
195             is returned in the "exchange" field.
196              
197             Suitable for shares, ETFs and funds 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 "Sinvestor" in the argument list to
201             Finance::Quote->new().
202              
203             This module provides "Sinvestor" 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