File Coverage

blib/lib/Finance/Quote/DWS.pm
Criterion Covered Total %
statement 17 59 28.8
branch 0 6 0.0
condition n/a
subroutine 7 9 77.7
pod 0 3 0.0
total 24 77 31.1


line stmt bran cond sub pod time code
1             #!/usr/bin/perl -w
2              
3             # This program is free software; you can redistribute it and/or modify
4             # it under the terms of the GNU General Public License as published by
5             # the Free Software Foundation; either version 2 of the License, or
6             # (at your option) any later version.
7             #
8             # This program is distributed in the hope that it will be useful,
9             # but WITHOUT ANY WARRANTY; without even the implied warranty of
10             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11             # GNU General Public License for more details.
12             #
13             # You should have received a copy of the GNU General Public License
14             # along with this program; if not, write to the Free Software
15             # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
16             # 02110-1301, USA
17              
18             package Finance::Quote::DWS;
19              
20 5     5   3243 use strict;
  5         14  
  5         165  
21 5     5   29 use warnings;
  5         14  
  5         137  
22              
23 5     5   27 use Web::Scraper;
  5         11  
  5         61  
24              
25 5     5   427 use constant DEBUG => $ENV{DEBUG};
  5         17  
  5         312  
26 5     5   32 use if DEBUG, 'Smart::Comments';
  5         22  
  5         28  
27              
28             our $VERSION = '1.58'; # VERSION
29              
30             our @labels = qw/name date isodate last name currency/;
31              
32             sub labels {
33 5     5 0 18 return(dwsfunds => \@labels);
34             }
35              
36             sub methods {
37 5     5 0 21 return(dwsfunds => \&dwsfunds);
38             }
39              
40             sub dwsfunds {
41 0     0 0   my $quoter = shift;
42 0           my @symbols = @_;
43 0           my $ua = $quoter->user_agent();
44 0           my %info;
45              
46 0 0         if (not exists $quoter->{DWS_CACHE}) {
47 0           $quoter->{DWS_CACHE} = {};
48              
49 0           eval {
50 0           my @headers = (
51             'User-Agent' => 'Mozilla/5.0 (Macintosh; Intel Mac OS X 11_1_0) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/87.0.4280.88 Safari/537.36',
52             'Accept' => 'text/html,application/xhtml+xml,application/xml;q=0.9,image/avif,image/webp,image/apng,*/*;q=0.8,application/signed-exchange;v=b3;q=0.9',
53             'Accept-Encoding' => 'gzip, deflate, br',
54             'Accept-Language' => 'en-US,en;q=0.9'
55             );
56              
57 0           my $url = 'https://www.deami.de/dps/ff/prices.aspx';
58 0           my $reply = $ua->get($url, @headers);
59              
60             ### reply : $reply
61              
62             my $processor = scraper {
63             process '//*[@id="FundsFinder_ResultTable"]/tr', 'row[]' => scraper {
64             process 'td', 'col[]' => scraper {
65 0           process 'a', 'name' => 'TEXT';
66 0           process ':not(a)', 'other' => ['HTML', sub{[split m|<br */>|, $_]}];
  0            
67 0           };
68 0     0     };
69 0           };
70              
71 0           my $data = $processor->scrape($reply);
72              
73             ### data: $data
74              
75             # skip first row, which is the header
76 0           for (my $i = 1; $i < @{$data->{row}}; $i++) {
  0            
77 0           eval {
78 0           my $name = $data->{row}->[$i]->{col}->[1]->{name};
79 0           my $date = $data->{row}->[$i]->{col}->[2]->{other}->[0];
80 0           my $last = $data->{row}->[$i]->{col}->[2]->{other}->[2];
81 0           my $wkn = $data->{row}->[$i]->{col}->[4]->{other}->[1];
82 0           my $isin = $data->{row}->[$i]->{col}->[4]->{other}->[2];
83              
84 0           $last =~ s/,/./;
85              
86 0           my $info = {name => $name, date => $date, last => $last, wkn => $wkn, isin => $isin};
87              
88 0           $quoter->{DWS_CACHE}->{$wkn} = $info;
89 0           $quoter->{DWS_CACHE}->{$isin} = $info;
90             };
91             }
92             };
93             }
94              
95             ### DWS_CACHE : $quoter->{DWS_CACHE}
96              
97 0           foreach my $symbol (@_) {
98 0 0         if (exists $quoter->{DWS_CACHE}->{$symbol}) {
99 0           $info{$symbol, 'symbol'} = $symbol;
100 0           $info{$symbol, 'name'} = $quoter->{DWS_CACHE}->{$symbol}->{name};
101 0           $info{$symbol, 'last'} = $quoter->{DWS_CACHE}->{$symbol}->{last};
102 0           $info{$symbol, 'wkn'} = $quoter->{DWS_CACHE}->{$symbol}->{wkn};
103 0           $info{$symbol, 'isin'} = $quoter->{DWS_CACHE}->{$symbol}->{isin};
104 0           $info{$symbol, 'currency'} = 'EUR';
105              
106 0           $quoter->store_date(\%info, $symbol, {eurodate => $quoter->{DWS_CACHE}->{$symbol}->{date}});
107              
108 0           $info{$symbol, 'success'} = 1;
109             }
110             else {
111 0           $info{$symbol, 'success'} = 0;
112 0           $info{$symbol, 'errormsg'} = "Symbol $symbol not found.";
113             }
114             }
115            
116 0 0         return wantarray() ? %info : \%info;
117             }
118              
119             1;
120              
121             =head1 NAME
122              
123             Finance::Quote::DWS - Obtain quotes from DWS (Deutsche Bank Gruppe)
124              
125             =head1 SYNOPSIS
126              
127             use Finance::Quote;
128              
129             $q = Finance::Quote->new;
130              
131             %fundinfo = $q->fetch("dwsfunds","847402", "DE0008474024", ...);
132              
133             =head1 DESCRIPTION
134              
135             This module obtains information about DWS managed funds. Query it with
136             German WKN and/or international ISIN symbols.
137              
138             =head1 LABELS RETURNED
139              
140             The following labels may be returned by Finance::Quote::DWS:
141             name, date, isodate, last, name, currency
142              
143             =head1 TERMS & CONDITIONS
144              
145             Information returned by this module is governed by DWS's terms
146             and conditions.
147              
148             Finance::Quote is released under the GNU General Public License, version 2,
149             which explicitly carries a "No Warranty" clause.
150              
151             =cut