File Coverage

blib/lib/Finance/Quote/Consorsbank.pm
Criterion Covered Total %
statement 26 76 34.2
branch 0 28 0.0
condition 0 6 0.0
subroutine 10 11 90.9
pod 0 3 0.0
total 36 124 29.0


line stmt bran cond sub pod time code
1             #!/usr/bin/perl -w
2              
3             # Copyright (C) 2023, Stephan Gambke <s7eph4n@gmail.com>
4              
5             # This program is free software; you can redistribute it and/or modify
6             # it under the terms of the GNU General Public License as published by
7             # the Free Software Foundation; either version 2 of the License, or
8             # (at your option) any later version.
9             # This program is distributed in the hope that it will be useful,
10             # but WITHOUT ANY WARRANTY; without even the implied warranty of
11             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12             # GNU General Public License for more details.
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             require 5.005;
19              
20 5     5   2747 use strict;
  5         13  
  5         261  
21 5     5   26 use warnings;
  5         102  
  5         309  
22              
23             package Finance::Quote::Consorsbank;
24              
25 5     5   36 use LWP::UserAgent;
  5         94  
  5         37  
26 5     5   146 use JSON qw( decode_json );
  5         10  
  5         24  
27 5     5   7034 use DateTime;
  5         2832675  
  5         56  
28              
29 5     5   370 use constant DEBUG => $ENV{DEBUG};
  5         72  
  5         475  
30 5     5   36 use if DEBUG, 'Smart::Comments';
  5         11  
  5         60  
31 5     5   232 use if DEBUG, 'Data::Dumper';
  5         22  
  5         25  
32              
33             our $VERSION = '1.58'; # VERSION
34              
35             my $CONSORS_URL = 'https://www.consorsbank.de/web-financialinfo-service/api/marketdata/stocks?';
36             my $CONSORS_SOURCE_BASE_URL = 'https://www.consorsbank.de/web/Wertpapier/';
37              
38             sub methods {
39             return (
40 5     5 0 35 consorsbank => \&consorsbank,
41             europe => \&consorsbank
42             );
43             }
44              
45             {
46             # Correspondence of FQ labels to Consorsbank API fields
47              
48             # success Did the stock successfully return information? (true/false)
49             # errormsg Info.Errors.ERROR_MESSAGE If success is false, this field may contain the reason why.
50             # symbol Info.ID Lookup symbol (ISIN, WKN, ticker symbol)
51             # name BasicV1.NAME_SECURITY Company or Mutual Fund Name
52             # method 'consorsbank' The module (as could be passed to fetch) which found this information.
53             # source Source URL, either general website or direct human-readable deep link
54             # exchange CONSORS_EXCHANGE_NAME The exchange the information was obtained from.
55             # currency ISO_CURRENCY ISO currency code
56              
57             # ask ASK Ask
58             # avg_vol Average Daily Vol
59             # bid BID Bid
60             # cap Market Capitalization
61             # close PREVIOUS_LAST Previous Close
62             # date DATETIME_PRICE Last Trade Date (MM/DD/YY format)
63             # day_range HIGH, LOW Day's Range
64             # div Dividend per Share
65             # div_date Dividend Pay Date
66             # div_yield Dividend Yield
67             # eps Earnings per Share
68             # ex_div Ex-Dividend Date.
69             # high HIGH Highest trade today
70             # last PRICE Last Price
71             # low LOW Lowest trade today
72             # nav Net Asset Value
73             # net PERFORMANCE Net Change
74             # open FIRST Today's Open
75             # p_change PERFORMANCE_PCT Percent Change from previous day's close
76             # pe P/E Ratio
77             # time DATETIME_PRICE Last Trade Time
78             # type The type of equity returned
79             # volume TOTAL_VOLUME Volume
80             # year_range HIGH_PRICE_1_YEAR - LOW_PRICE_1_YEAR 52-Week Range
81             # yield Yield (usually 30 day avg)
82              
83             my @labels = qw/
84             symbol
85             name
86             method
87             source
88             exchange
89             currency
90             ask
91             bid
92             close
93             date
94             day_range
95             high
96             last
97             low
98             net
99             open
100             p_change
101             volume
102             year_range
103             /;
104              
105             # Function that lists the data items available from Consorsbank
106             sub labels {
107             return (
108 5     5 0 20 consorsbank => \@labels,
109             europe => \@labels);
110             }
111             }
112              
113             sub consorsbank {
114              
115             # a Finance::Quote object
116 0     0 0   my Finance::Quote $quoter = shift;
117              
118             # a list of zero or more symbol names
119 0 0         my @symbols = @_ or return;
120              
121             # user_agent() provides a ready-to-use LWP::UserAgent
122 0           my $ua = $quoter->user_agent;
123              
124 0           my %info;
125              
126 0           for my $symbol (@symbols) {
127              
128             ### $symbol
129              
130 0           $info{ $symbol, 'symbol' } = $symbol;
131 0           $info{ $symbol, 'success' } = 1;
132 0           $info{ $symbol, 'errormsg' } = '';
133              
134 0           my $query = $CONSORS_URL . "id=$symbol&field=QuotesV1&field=BasicV1";
135 0           my $response = $ua->get($query);
136              
137 0 0         unless ($response->is_success) {
138 0           $info{ $symbol, 'success' } = 0;
139 0           $info{ $symbol, 'errormsg' } = "Unable to fetch data from the Consorsbank server for $symbol. Error: " . $response->status_line;
140 0           next;
141             }
142              
143 0 0         unless ($response->header('content-type') =~ m|application/json|i) {
144 0           $info{ $symbol, 'success' } = 0;
145 0           $info{ $symbol, 'errormsg' } = "Invalid content-type from Consorsbank server for $symbol. Expected: application/json, received: " . $response->header('content-type');
146 0           next;
147             }
148              
149 0           my $json = $response->content;
150              
151              
152             ### [<here>] $json:
153             ### $json
154              
155 0           my $data;
156 0           eval { $data = JSON::decode_json($json) };
  0            
157              
158 0 0         if ($@) {
159 0           $info{ $symbol, 'success' } = 0;
160 0           $info{ $symbol, 'errormsg' } = "Failed to parse JSON data for $symbol. Error: $@.";
161             ### $@
162 0           next;
163             }
164              
165             ### [<here>] $data:
166             ### $data
167              
168 0 0         if ( defined $data->[0]{'Info'}{'Errors'} ){
169             ### API Error: $data->[0]{'Info'}{'Errors'}
170 0           $info{ $symbol, 'success' } = 0;
171              
172 0 0         if ( $data->[0]{'Info'}{'Errors'}[0]{'ERROR_CODE'} eq 'IDMS' ){
173 0           $info{ $symbol, 'errormsg' } = "Invalid symbol: $symbol";
174             } else {
175 0           $info{ $symbol, 'errormsg' } = $data->[0]{'Info'}{'Errors'}[0]{'ERROR_MESSAGE'}
176             }
177 0           next;
178             }
179              
180 0           my $quote = $data->[0]{'QuotesV1'}[0];
181              
182             ### [<here>] $symbol:
183             ### $symbol
184 0 0         $info{ $symbol, 'symbol' } = $data->[0]{'Info'}{'ID'} if (defined $data->[0]{'Info'}{'ID'}) ;
185 0 0         $info{ $symbol, 'name' } = $data->[0]{'BasicV1'}{'NAME_SECURITY'} if (defined $data->[0]{'BasicV1'}{'NAME_SECURITY'});
186 0           $info{ $symbol, 'method' } = 'consorsbank';
187 0           $info{ $symbol, 'source' } = $CONSORS_SOURCE_BASE_URL . $data->[0]{'Info'}{'ID'};
188              
189 0 0 0       $info{ $symbol, 'day_range' } = $quote->{'HIGH'} - $quote->{'LOW'} if (defined $quote->{'HIGH'} && defined $quote->{'LOW'});
190              
191             $info{ $symbol, 'year_range' } = $quote->{'HIGH_PRICE_1_YEAR'} - $quote->{'LOW_PRICE_1_YEAR'}
192 0 0 0       if (defined $quote->{'HIGH_PRICE_1_YEAR'} && defined $quote->{'LOW_PRICE_1_YEAR'});
193              
194 0           my %mapping = ('exchange' => 'CONSORS_EXCHANGE_NAME', 'currency' => 'ISO_CURRENCY', 'ask' => 'ASK',
195             'bid' => 'BID', 'close' => 'PREVIOUS_LAST', 'high' => 'HIGH', 'last' => 'PRICE',
196             'low' => 'LOW', 'net' => 'PERFORMANCE', 'open' => 'FIRST', 'p_change' => 'PERFORMANCE_PCT',
197             'volume' => 'TOTAL_VOLUME' );
198              
199 0           while ((my $fqkey, my $cbkey) = each (%mapping)) {
200 0 0         $info{ $symbol, $fqkey } = $quote->{$cbkey} if (defined $quote->{$cbkey});
201             }
202              
203 0 0         $quote->{'DATETIME_PRICE'} = DateTime->now->iso8601 unless defined $quote->{'DATETIME_PRICE'};
204 0           ($info{ $symbol, 'date' }, $info{ $symbol, 'time' }) = split /T/, $quote->{'DATETIME_PRICE'};
205 0           $quoter->store_date(\%info, $symbol, { isodate => $info{ $symbol, 'date' } });
206              
207 0 0         unless (defined $info{ $symbol, 'last'} ) {
208 0           $info{ $symbol, 'success' } = 0;
209 0           $info{ $symbol, 'errormsg' } = "The server did not return a price for $symbol.";
210             next
211 0           }
212              
213             }
214              
215             ### [<here>] %info:
216             ### %info
217              
218 0 0         return wantarray() ? %info : \%info;
219             }
220             1;
221             __END__
222              
223             =head1 NAME
224              
225             Finance::Quote::Consorsbank - Obtain quotes from Consorsbank.
226              
227             =head1 SYNOPSIS
228              
229             use Finance::Quote;
230             $q = Finance::Quote->new;
231             %stockinfo = $q->fetch("consorsbank","DE0007664005"); # Only query consorsbank using ISIN.
232             %stockinfo = $q->fetch("consorsbank","766400"); # Only query consorsbank using WKN.
233             %stockinfo = $q->fetch("europe","DE0007664005"); # Failover to other sources OK.
234              
235             =head1 DESCRIPTION
236              
237             This module obtains information from Consorsbank (https://www.consorsbank.de).
238              
239             It accepts ISIN or German WKN as requested symbol.
240              
241             This module is loaded by default on a Finance::Quote object. It's
242             also possible to load it explicitly by placing "Consorsbank" in the argument
243             list to Finance::Quote->new().
244              
245             This module provides both the "consorsbank" and "europe" fetch methods.
246             Please use the "europe" fetch method if you wish to have failover with other
247             sources for European stock exchanges. Using the "consorsbank" method will
248             guarantee that your information only comes from the Consorsbank service.
249              
250             =head1 LABELS RETURNED
251              
252             The following labels may be returned by Finance::Quote::Consorsbank:
253              
254             ask, bid, close, date, day_range, high, last, low, net, open, p_change, volume, year_range
255              
256             =cut