File Coverage

blib/lib/Finance/Quote/SEB.pm
Criterion Covered Total %
statement 23 56 41.0
branch 0 12 0.0
condition n/a
subroutine 9 10 90.0
pod 0 3 0.0
total 32 81 39.5


line stmt bran cond sub pod time code
1             # Copyright (C) 1998, Dj Padzensky <djpadz@padz.net>
2             # Copyright (C) 1998, 1999 Linas Vepstas <linas@linas.org>
3             # Copyright (C) 2000, Yannick LE NY <y-le-ny@ifrance.com>
4             # Copyright (C) 2000, Paul Fenwick <pjf@cpan.org>
5             # Copyright (C) 2000, Brent Neal <brentn@users.sourceforge.net>
6             # Copyright (C) 2000, Keith Refson <Keith.Refson@earth.ox.ac.uk>
7             # Copyright (C) 2003, Tomas Carlsson <tc@tompa.nu>
8             #
9             # This program is free software; you can redistribute it and/or modify
10             # it under the terms of the GNU General Public License as published by
11             # the Free Software Foundation; either version 2 of the License, or
12             # (at your option) any later version.
13             #
14             # This program is distributed in the hope that it will be useful,
15             # but WITHOUT ANY WARRANTY; without even the implied warranty of
16             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17             # GNU General Public License for more details.
18             #
19             # You should have received a copy of the GNU General Public License
20             # along with this program; if not, write to the Free Software
21             # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
22             # 02110-1301, USA
23             #
24             #
25             # This code was derived from the work on the packages Finance::Yahoo::*
26             #
27             package Finance::Quote::SEB;
28             require 5.004;
29              
30 5     5   2682 use strict;
  5         13  
  5         542  
31              
32 5     5   28 use vars qw( $SEB_FUNDS_URL);
  5         11  
  5         235  
33              
34 5     5   32 use constant DEBUG => $ENV{DEBUG};
  5         24  
  5         332  
35 5     5   41 use if DEBUG, 'Smart::Comments';
  5         10  
  5         30  
36              
37 5     5   214 use LWP::UserAgent;
  5         10  
  5         36  
38 5     5   174 use HTTP::Request::Common;
  5         12  
  5         391  
39 5     5   39 use utf8;
  5         9  
  5         63  
40              
41             our $VERSION = '1.58'; # VERSION
42             $SEB_FUNDS_URL = 'https://seb.se/pow/fmk/2100/Senaste_fondkurserna.TXT';
43              
44 5     5 0 21 sub methods { return (seb_funds => \&seb_funds); }
45              
46             {
47             my @labels = qw/date isodate method source name currency price/;
48              
49 5     5 0 17 sub labels { return (seb_funds => \@labels); }
50             }
51              
52             sub seb_funds {
53 0     0 0   my $quoter = shift;
54 0           my @symbols = @_;
55              
56 0 0         return unless @symbols;
57 0           my ($ua, $reply, $url, %funds);
58              
59 0           $url = $SEB_FUNDS_URL;
60 0           $ua = $quoter->user_agent;
61 0           $reply = $ua->request(GET $url);
62              
63             ### url : $url
64             ### reply : $reply
65              
66 0 0         unless ($reply->is_success) {
67 0           foreach my $symbol (@symbols) {
68 0           $funds{$symbol, "success"} = 0;
69 0           $funds{$symbol, "errormsg"} = "HTTP failure";
70             }
71 0 0         return wantarray ? %funds : \%funds;
72             }
73              
74 0           foreach my $line (split /\n/, $reply->content) {
75 0           chomp($line);
76             # Format:
77             # 2003-08-11;SEB Aktiesparfond;5,605;387
78 0           my ($date, $name, $price, $hmm) = split ';', $line;
79 0           utf8::encode($name);
80 0 0         if (grep {$_ eq $name} @symbols) {
  0            
81 0           $price =~ s/,/\./; # change decimal point from , to .
82 0           $funds{$name, 'symbol'} = $name;
83 0           $quoter->store_date(\%funds, $name, {isodate => $date});
84 0           $funds{$name, 'method'} = 'seb_funds';
85 0           $funds{$name, 'source'} = 'Finance::Quote::SEB';
86 0           $funds{$name, 'name'} = $name;
87 0           $funds{$name, 'currency'} = 'SEK';
88 0           $funds{$name, 'price'} = $price;
89 0           $funds{$name, 'success'} = 1;
90             }
91             }
92              
93             # Check for undefined symbols
94 0           foreach my $symbol (@symbols) {
95 0 0         unless ($funds{$symbol, 'success'}) {
96 0           $funds{$symbol, "success"} = 0;
97 0           $funds{$symbol, "errormsg"} = "Fund name not found";
98             }
99             }
100              
101 0 0         return %funds if wantarray;
102 0           return \%funds;
103             }
104              
105             1;
106              
107             =head1 NAME
108              
109             Finance::Quote::SEB - Obtain fund prices from www.seb.se
110              
111             =head1 SYNOPSIS
112              
113             use Finance::Quote;
114              
115             $q = Finance::Quote->new;
116              
117             %fundinfo = $q->fetch("seb_funds","fund name");
118              
119             =head1 DESCRIPTION
120              
121             This module obtains information about SEB fund prices from
122             www.seb.se. The only available information source is "seb_funds"
123             and it will use www.seb.se.
124              
125             =head1 FUND NAMES
126              
127             Unfortunately there is no unique identifier for the fund names.
128             Therefore the complete fund name must be given, including spaces, case
129             is important.
130              
131             Consult https://seb.se/bors-och-finans/fonder/fondkurslista
132             for all available funds.
133              
134             Example "SEB Aktiesparfond"
135              
136             =head1 LABELS RETURNED
137              
138             Information available from SEB may include the following labels:
139             date method source name currency price. The prices are updated at the
140             end of each bank day.
141              
142             =head1 SEE ALSO
143              
144             SEB website - http://www.seb.se/
145              
146             =cut