File Coverage

blib/lib/Finance/Quote/SIX.pm
Criterion Covered Total %
statement 26 69 37.6
branch 0 18 0.0
condition 0 3 0.0
subroutine 10 11 90.9
pod 0 3 0.0
total 36 104 34.6


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::SIX;
19              
20 5     5   2629 use strict;
  5         13  
  5         159  
21 5     5   30 use warnings;
  5         10  
  5         217  
22              
23 5     5   29 use constant DEBUG => $ENV{DEBUG};
  5         11  
  5         317  
24 5     5   35 use if DEBUG, 'Smart::Comments';
  5         10  
  5         26  
25              
26 5     5   192 use LWP::UserAgent;
  5         24  
  5         33  
27 5     5   147 use JSON qw( decode_json );
  5         14  
  5         32  
28 5     5   550 use String::Util qw(trim);
  5         11  
  5         297  
29 5     5   40 use Scalar::Util qw(looks_like_number);
  5         11  
  5         3547  
30              
31             our $VERSION = '1.58'; # VERSION
32              
33             our @labels = qw/last date isodate/;
34              
35             sub labels {
36 5     5 0 18 return ( six => \@labels );
37             }
38              
39             sub methods {
40 5     5 0 22 return ( six => \&six );
41             }
42              
43             sub six {
44 0     0 0   my $quoter = shift;
45 0           my @symbols = @_;
46 0           my $ua = $quoter->user_agent();
47 0           my %info;
48              
49 0           foreach my $symbol (@_) {
50 0           eval {
51             # 1. Search for the security
52 0           my $url = 'https://www.six-group.com/fqs/snap.json?select=ValorId,PortalSegment,ProductLine&where=PortalSegment=EQ|BO|FU|EP|IN&pagesize=2&match=' . $symbol;
53 0           my $reply = $ua->get($url);
54 0           my $search = JSON::decode_json $reply->content;
55              
56             ### Search : $url, $reply->code
57             ### Search : $search
58            
59             # 2. Get security metadata
60 0           my $valorid = $search->{rowData}->[0][0];
61 0 0         die "$symbol not found" unless defined $valorid;
62              
63 0           $url = 'https://www.six-group.com/fqs/ref.json?select=DividendEntitlementFlag,FirstTradingDate,LastTradingDate,ISIN,IssuerNameFull,IssuerNameShort,MarketDate,NominalCurrency,NominalValue,NumberInIssue,ProductLine,SecTypeDesc,ShortName,SmallestTradeableUnit,TitleSegment,TitleSegmentDesc,TradingBaseCurrency,ValorNumber,ValorSymbol&where=ValorId=' . $valorid;
64 0           $reply = $ua->get($url);
65 0           my $metadata = JSON::decode_json $reply->content;
66            
67             ### Metadata : $url, $reply->code
68             ### Metadata : $metadata
69              
70 0           my @metacols = @{$metadata->{colNames}};
  0            
71 0           my %metamap = map {$metacols[$_] => $_} (0 .. $#metacols);
  0            
72 0           my $metarow = $metadata->{rowData}->[0];
73              
74 0           $info{$symbol, 'isin'} = $metarow->[$metamap{ISIN}];
75 0           $info{$symbol, 'name'} = $metarow->[$metamap{IssuerNameFull}];
76 0           $info{$symbol, 'currency'} = $metarow->[$metamap{NominalCurrency}];
77              
78 0           $quoter->store_date(\%info, $symbol, {isodate => $metarow->[$metamap{MarketDate}]});
79              
80 0           $url = 'https://www.six-group.com/fqs/movie.json?select=AskPrice,AskVolume,BidPrice,BidVolume,ClosingDelta,ClosingPerformance,ClosingPrice,DailyHighPrice,DailyHighTime,DailyLowPrice,DailyLowTime,LatestTradeVolume,MarketMakers,MarketTime,MidSpread,OffBookTrades,OffBookTurnover,OffBookVolume,OnMarketTrades,OnMarketTurnover,OnMarketVolume,OpeningPrice,PreviousClosingPrice,SwissAtMidTrades,SwissAtMidTurnover,SwissAtMidVolume,TotalVolume,VWAP60Price,YearAgoPerformance,YearlyHighDate,YearlyHighPrice,YearlyLowDate,YearlyLowPrice,YearToDatePerformance,YieldToWorst&where=ValorId=' . $valorid;
81 0           $reply = $ua->get($url);
82 0           my $data = JSON::decode_json $reply->content;
83              
84             ### Data : $url, $reply->code
85             ### Data : $data
86              
87 0           my @datacols = @{$data->{colNames}};
  0            
88 0           my %datamap = map {$datacols[$_] => $_} (0 .. $#datacols);
  0            
89 0           my $datarow = $data->{rowData}->[0];
90              
91 0 0 0       $info{$symbol, 'ask'} = $datarow->[$datamap{AskPrice}] if $datarow->[$datamap{AskPrice}] and looks_like_number($datarow->[$datamap{AskPrice}]);
92 0 0         $info{$symbol, 'close'} = $datarow->[$datamap{ClosingPrice}] if $datarow->[$datamap{ClosingPrice}];
93 0 0         $info{$symbol, 'high'} = $datarow->[$datamap{DailyHighPrice}] if $datarow->[$datamap{DailyHighPrice}];
94 0 0         $info{$symbol, 'low'} = $datarow->[$datamap{DailyLowPrice}] if $datarow->[$datamap{DailyLowPrice}];
95 0 0         $info{$symbol, 'open'} = $datarow->[$datamap{OpeningPrice}] if $datarow->[$datamap{OpeningPrice}];
96 0 0         $info{$symbol, 'volume'} = $datarow->[$datamap{TotalVolume}] if $datarow->[$datamap{TotalVolume}];
97 0           $info{$symbol, 'success'} = 1;
98             };
99            
100 0 0         if ($@) {
101 0           my $error = "SIX failed: $@";
102 0           $info{$symbol, 'success'} = 0;
103 0           $info{$symbol, 'errormsg'} = trim($error);
104             }
105             }
106              
107 0 0         return wantarray() ? %info : \%info;
108             }
109              
110             1;
111              
112             =head1 NAME
113              
114             Finance::Quote::SIX - Obtain quotes from the Swiss Stock Exchange
115              
116             =head1 SYNOPSIS
117              
118             use Finance::Quote;
119              
120             $q = Finance::Quote->new;
121              
122             %info = Finance::Quote->fetch('six', 'NESN');
123              
124             =head1 DESCRIPTION
125              
126             This module fetches information from the Swiss Stock Exchange,
127             https://www.six-group.com.
128              
129             This module is loaded by default on a Finance::Quote object. It's also possible
130             to load it explicitly by placing 'SIX' in the argument list to
131             Finance::Quote->new().
132              
133             =head1 LABELS RETURNED
134              
135             The following labels may be returned by Finance::Quote::SIX :
136             isin name currency date isodate ask close high low open volume success
137              
138             =head1 TERMS & CONDITIONS
139              
140             Use of www.six-group.com is governed by any terms & conditions of that site.
141              
142             Finance::Quote is released under the GNU General Public License, version 2,
143             which explicitly carries a "No Warranty" clause.
144              
145             =cut
146