File Coverage

blib/lib/Finance/Quote/MorningstarCH.pm
Criterion Covered Total %
statement 23 103 22.3
branch 0 32 0.0
condition 0 9 0.0
subroutine 9 10 90.0
pod 0 3 0.0
total 32 157 20.3


line stmt bran cond sub pod time code
1             #!/usr/bin/perl -w
2              
3             # MorningstarCH.pm
4             #
5             # Obtains quotes for CH Unit Trusts from http://morningstar.ch/ - please
6             # refer to the end of this file for further information.
7             #
8             # author: Manuel Friedli (manuel@fritteli.ch)
9             #
10             # version: 0.1 Initial version - 02 March 2019
11             #
12             # This file is heavily based on MStaruk.pm by Martin Sadler
13             # (martinsadler@users.sourceforge.net), version 0.1, 01 April 2013
14             #
15             # This program is free software; you can redistribute it and/or modify
16             # it under the terms of the GNU General Public License as published by
17             # the Free Software Foundation; either version 2 of the License, or
18             # (at your option) any later version.
19             #
20             # This program is distributed in the hope that it will be useful,
21             # but WITHOUT ANY WARRANTY; without even the implied warranty of
22             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23             # GNU General Public License for more details.
24             #
25             # You should have received a copy of the GNU General Public License
26             # along with this program; if not, write to the Free Software
27             # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
28             # 02110-1301, USA
29             #
30              
31              
32             package Finance::Quote::MorningstarCH;
33             require 5.006;
34              
35 5     5   2777 use strict;
  5         16  
  5         154  
36 5     5   27 use warnings;
  5         19  
  5         155  
37              
38             # URLs
39 5     5   35 use vars qw($VERSION $MSTARCH_NEXT_URL $MSTARCH_LOOK_UP $MSTARCH_MAIN_URL);
  5         10  
  5         314  
40              
41 5     5   2323 use LWP::Simple;
  5         43976  
  5         31  
42 5     5   1558 use LWP::UserAgent;
  5         14  
  5         34  
43 5     5   112 use HTTP::Request::Common;
  5         12  
  5         297  
44 5     5   36 use HTTP::Cookies;
  5         12  
  5         85  
45              
46              
47             $MSTARCH_MAIN_URL = "https://www.morningstar.ch";
48             $MSTARCH_LOOK_UP = "https://www.morningstar.ch/ch/funds/SecuritySearchResults.aspx?search=";
49             $MSTARCH_NEXT_URL = "https://www.morningstar.ch/ch/funds/snapshot/snapshot.aspx?id=";
50              
51             # FIXME -
52              
53             our $VERSION = '1.58_01'; # TRIAL VERSION
54              
55 5     5 0 29 sub methods { return (morningstarch => \&morningstarch_fund); }
56              
57             {
58             my @labels = qw/name currency last date time price nav source iso_date method net p_change success errormsg/;
59              
60 5     5 0 18 sub labels { return (morningstarch => \@labels); }
61             }
62              
63             #
64             # =======================================================================
65              
66             sub morningstarch_fund {
67 0     0 0   my $quoter = shift;
68 0           my @symbols = @_;
69              
70 0 0         return unless @symbols;
71              
72 0           my %fundquote;
73              
74 0           my $ua = $quoter->user_agent;
75 0           my $cj = HTTP::Cookies->new();
76 0           $ua->cookie_jar( $cj );
77              
78 0           foreach (@symbols)
79             {
80 0           my $code = $_;
81              
82 0           my $code_type = "** Invalid **";
83 0 0 0       if ($code =~ m/^[a-zA-Z]{2}[a-zA-Z0-9]{9}\d(.*)/ && !$1) { $code_type = "ISIN"; }
  0 0 0        
    0 0        
84 0           elsif ($code =~ m/^[a-zA-Z0-9]{6}\d(.*)/ && !$1 ) { $code_type = "SEDOL"; }
85 0           elsif ($code =~ m/^[a-zA-Z]{4,6}(.*)/ && !$1) { $code_type = "MEXID"; }
86              
87             # current version can only use ISIN - report an error and exit if any other type
88              
89 0 0         if ($code_type ne "ISIN")
90             {
91 0           $fundquote {$code,"success"} = 0;
92 0           $fundquote {$code,"errormsg"} = "Error - invalid symbol";
93 0           next;
94             }
95              
96 0           $fundquote {$code,"success"} = 1; # ever the optimist....
97 0           $fundquote {$code,"errormsg"} = "Success";
98              
99             # perform the look-up - if not found, return with error
100              
101 0           my $webdoc = get($MSTARCH_LOOK_UP.$code);
102 0 0         if (!$webdoc)
103             {
104             # serious error, report it and give up
105 0           $fundquote {$code,"success"} = 0;
106 0           $fundquote {$code,"errormsg"} =
107             "Error - failed to retrieve fund data";
108 0           next;
109             }
110 0           $fundquote {$code, "symbol"} = $code;
111 0           $fundquote {$code, "source"} = $MSTARCH_MAIN_URL;
112              
113             # Find name by regexp
114              
115 0           my ($name, $nexturl, $isin);
116 0 0         if ($webdoc =~
117             m[<td class="msDataText searchLink"><a href="(.*?)">(.*?)</a></td><td class="msDataText searchIsin"><span>[a-zA-Z]{2}[a-zA-Z0-9]{9}\d(.*)</span></td>] )
118             {
119 0           $nexturl = $1;
120 0           $name = $2;
121 0           $isin = $3;
122             }
123              
124 0 0         if (!defined($name)) {
125             # not a serious error - don't report it ....
126             # $fundquote {$code,"success"} = 0;
127             # ... but set a useful message ....
128 0           $fundquote {$code,"errormsg"} = "Warning - failed to find fund name";
129 0           $name = "*** UNKNOWN ***";
130             # ... and continue
131             }
132 0           $fundquote {$code, "name"} = $name; # set name
133              
134 0 0         if (!defined($nexturl)) {
135             # serious error, report it and give up
136 0           $fundquote {$code,"success"} = 0;
137 0           $fundquote {$code,"errormsg"} =
138             "Error - failed to retrieve fund data";
139 0           next;
140             }
141              
142             # modify $nexturl to remove html escape encoding for the Ampersand (&) character
143              
144 0           $nexturl =~ s/&amp;/&/;
145              
146             # Now need to look-up next page using $next_url
147              
148 0           $webdoc = get($MSTARCH_MAIN_URL.$nexturl);
149 0 0         if (!$webdoc)
150             {
151             # serious error, report it and give up
152 0           $fundquote {$code,"success"} = 0;
153 0           $fundquote {$code,"errormsg"} =
154             "Error - failed to retrieve fund data";
155 0           next;
156             }
157              
158             # Find date, currency and price all in one table row
159              
160 0           my ($currency, $date, $price, $pchange);
161 0 0         if ($webdoc =~
162             m[<td class="line heading">NAV<span class="heading"><br />([0-9]{2}\.[0-9]{2}\.[0-9]{4})</span>.*([A-Z]{3}).([0-9\,\.]+).*>([0-9\,\.\-]+)%?] )
163             {
164              
165 0           $date = $1;
166 0           $currency = $2;
167 0           $price = $3;
168 0           $pchange = $4;
169             }
170              
171 0 0         if (!defined($pchange)) {
172             # not a serious error - don't report it ....
173             # $fundquote {$code,"success"} = 0;
174             # ... but set a useful message ....
175 0           $fundquote {$code,"errormsg"} = "Warning - failed to find net or %-age change";
176             # set to (minus)zero
177 0           $pchange = -0.00;
178             # ... and continue
179             }
180 0           $pchange =~ s/,/./;
181 0           $fundquote {$code, "p_change"} = $pchange; # set %-change
182              
183 0 0         if (!defined($date)) {
184             # not a serious error - don't report it ....
185             # $fundquote {$code,"success"} = 0;
186             # ... but set a useful message ....
187 0           $fundquote {$code,"errormsg"} = "Warning - failed to find a date";
188             # use today's date
189 0           $quoter->store_date(\%fundquote, $code, {today => 1});
190             # ... and continue
191             }
192             else
193             {
194 0           $quoter->store_date(\%fundquote, $code, {eurodate => $date});
195             }
196              
197 0 0         if (!defined($price)) {
198             # serious error, report it and give up
199 0           $fundquote {$code,"success"} = 0;
200 0           $fundquote {$code,"errormsg"} = "Error - failed to find a price";
201 0           next;
202             }
203 0           $price =~ s/,/./;
204              
205 0 0         if (!defined($currency)) {
206             # serious error, report it and give up
207 0           $fundquote {$code,"success"} = 0;
208 0           $fundquote {$code,"errormsg"} = "Error - failed to find a currency";
209 0           next;
210             }
211              
212             # defer setting currency and price until we've dealt with possible GBX currency...
213              
214             # Calculate net change - it's not included in the morningstar factsheets
215              
216 0           my $net = ($price * $pchange) / 100 ;
217              
218             # now set prices and currency
219              
220 0           $fundquote {$code, "price"} = $price;
221 0           $fundquote {$code, "last"} = $price;
222 0           $fundquote {$code, "nav"} = $price;
223 0           $fundquote {$code, "net"} = $net;
224 0           $fundquote {$code, "currency"} = $currency;
225              
226             # Set a dummy time as gnucash insists on having a valid format
227              
228 0           my $time = "12:00"; # set to Midday if no time supplied ???
229             # gnucash insists on having a valid-format
230              
231 0           $fundquote {$code, "time"} = $time; # set time
232              
233 0           $fundquote {$code, "method"} = "morningstarch"; # set method
234              
235             }
236              
237 0 0         return wantarray ? %fundquote : \%fundquote;
238             }
239              
240             1;
241              
242             =head1 NAME
243              
244             Finance::Quote::morningstarch - Obtain CH Unit Trust quotes from morningstar.ch.
245              
246             =head1 SYNOPSIS
247              
248             $q = Finance::Quote->new;
249              
250             %info = Finance::Quote->fetch("morningstarch","<isin> ..."); # Only query morningstar.ch using ISINs
251              
252             =head1 DESCRIPTION
253              
254             This module fetches information from the MorningStar Funds service,
255             https://morningstar.com/ch/.
256              
257             Funds are identified by their ISIN code.
258              
259             This module is loaded by default on a Finance::Quote object. It's
260             also possible to load it explicitly by placing "morningstarch" in the argument
261             list to Finance::Quote->new().
262              
263             Information obtained by this module may be covered by Morningstar
264             terms and conditions See https://morningstar.ch/ for details.
265              
266             =head2 Stocks And Indices
267              
268             This module provides the "morningstarch" fetch method for fetching CH Unit
269             Trusts and OEICs prices and other information from morningstar.ch.
270              
271             =head1 LABELS RETURNED
272              
273             The following labels may be returned by Finance::Quote::morningstarch :
274              
275             name, currency, last, date, time, price, nav, source, method,
276             iso_date, net, p_change, success, errormsg.
277              
278              
279             =head1 SEE ALSO
280              
281             Morning Star websites, https://morningstar.ch
282              
283              
284             =head1 AUTHOR
285              
286             Manuel Friedli, E<lt>manuel@fritteli.chE<gt>
287             Based heavily on the work of Martin Sadler E<lt>martinsadler@users.sourceforge.netE<gt>, many thanks!
288              
289             =head1 COPYRIGHT AND LICENSE
290              
291             Copyright (C) 2019 by Manuel Friedli
292              
293             This library is free software; you can redistribute it and/or modify
294             it under the same terms as Perl itself, either Perl version 5.10.1 or,
295             at your option, any later version of Perl 5 you may have available.
296              
297              
298             =cut
299              
300             __END__
301