File Coverage

blib/lib/Finance/Quote/TMX.pm
Criterion Covered Total %
statement 26 74 35.1
branch 0 12 0.0
condition n/a
subroutine 10 11 90.9
pod 0 3 0.0
total 36 100 36.0


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::TMX;
19              
20 5     5   2598 use strict;
  5         13  
  5         153  
21 5     5   27 use warnings;
  5         27  
  5         126  
22 5     5   2761 use Readonly;
  5         20549  
  5         362  
23             Readonly my $DEBUG => $ENV{DEBUG};
24 5     5   39 use if $DEBUG, 'Smart::Comments';
  5         13  
  5         28  
25              
26 5     5   168 use HTTP::Request;
  5         11  
  5         73  
27 5     5   109 use LWP::UserAgent;
  5         11  
  5         26  
28 5     5   124 use JSON qw( decode_json encode_json );
  5         12  
  5         26  
29 5     5   558 use String::Util qw(trim);
  5         21  
  5         3762  
30              
31             our $VERSION = '1.58_01'; # TRIAL VERSION
32              
33             our @labels = qw/currency name exchange volume open high low cap close year_range last p_change symbol isodate date/;
34              
35             sub labels {
36 5     5 0 15 return ( tmx => \@labels );
37             }
38              
39             sub methods {
40 5     5 0 48 return ( tmx => \&tmx,
41             tsx => \&tmx,
42             canada => \&tmx );
43             }
44              
45             sub tmx {
46 0     0 0   my $quoter = shift;
47 0           my @symbols = @_;
48 0           my $ua = $quoter->user_agent();
49 0           my %info;
50              
51 0           foreach my $symbol (@symbols) {
52 0           eval {
53 0           my $url = 'https://app-money.tmx.com/graphql';
54 0           my $header = ["accept" => "*/*",
55             "accept-language" => "en-US,en;q=0.9",
56             "authorization" => "",
57             "content-type" => "application/json",
58             "locale" => "en",
59             "sec-ch-ua" => "\"Google Chrome\";v=\"87\", \" Not;A Brand\";v=\"99\", \"Chromium\";v=\"87\"",
60             "sec-ch-ua-mobile" => "?0",
61             "sec-fetch-dest" => "empty",
62             "sec-fetch-mode" => "cors",
63             "sec-fetch-site" => "same-site"];
64 0           my $body = "{\"operationName\":\"getQuoteBySymbol\",\"variables\":{\"symbol\":\"$symbol\",\"locale\":\"en\"},\"query\":\"query getQuoteBySymbol(\$symbol: String, \$locale: String) {\\n getQuoteBySymbol(symbol: \$symbol, locale: \$locale) {\\n symbol\\n name\\n price\\n percentChange\\n exchangeName\\n volume\\n openPrice\\n dayHigh\\n dayLow\\n MarketCap\\n prevClose\\n weeks52high\\n weeks52low\\n }\\n}\\n\"}";
65              
66            
67 0           my $request = HTTP::Request->new('POST', $url, $header, $body);
68 0           $request->header("referrer" => "https://money.tmx.com/",
69             "referrerPolicy" => "strict-origin-when-cross-origin",
70             "mode" => "cors");
71              
72 0           my $reply = $ua->request($request);
73 0 0         if (! $reply->is_success) {
74 0           $info{$symbol, 'errormsg'} = 'Failed to connect with TMX website';
75 0           $info{$symbol, 'success'} = 0;
76 0           return;
77             }
78             ### Search : $url, $reply->code
79             ### reply : $reply->content
80            
81 0           my $data = decode_json $reply->content;
82 0 0         if (exists $data->{errors}) {
83 0           $info{$symbol, 'errormsg'} = $data->{errors}[0]->{message};
84 0           $info{$symbol, 'success'} = 0;
85 0           return;
86             }
87              
88 0           $data = $data->{data}->{getQuoteBySymbol};
89 0 0         if (lc($data->{symbol}) ne lc($symbol)) {
90 0           $info{$symbol, 'errormsg'} = "returned symbol was not correct for $symbol";
91 0           $info{$symbol, 'success'} = 0;
92             return
93 0           }
94              
95 0 0         if ( $symbol =~ /:us/ix ) {
96 0           $info{$symbol, 'currency'} = 'USD'; }
97 0           else {$info{$symbol, 'currency'} = 'CAD'}
98              
99 0           $info{$symbol, 'name'} = $data->{name};
100 0           $info{$symbol, 'exchange'} = $data->{exchangeName};
101 0           $info{$symbol, 'volume'} = $data->{volume};
102 0           $info{$symbol, 'open'} = $data->{openPrice};
103 0           $info{$symbol, 'high'} = $data->{dayHigh};
104 0           $info{$symbol, 'low'} = $data->{dayLow};
105 0           $info{$symbol, 'cap'} = $data->{MarketCap};
106 0           $info{$symbol, 'close'} = $data->{prevClose};
107 0           $info{$symbol, 'year_range'} = $data->{weeks52low} . ' - ' . $data->{weeks52high};
108 0           $info{$symbol, 'last'} = $data->{price};
109 0           $info{$symbol, 'symbol'} = $data->{symbol};
110 0           $info{$symbol, 'p_change'} = $data->{percentChange};
111 0           $quoter->store_date(\%info, $symbol, {today => 1});
112              
113 0           $info{$symbol, 'success'} = 1;
114             };
115 0 0         if ($@) {
116 0           my $error = "TMX failed: $@";
117 0           $info{$symbol, 'success'} = 0;
118 0           $info{$symbol, 'errormsg'} = trim($error);
119             }
120             }
121              
122 0 0         return wantarray() ? %info : \%info;
123             }
124              
125             1;
126              
127             =head1 NAME
128              
129             Finance::Quote::TSX - Obtain quotes from the Toronto Stock Exchange
130             (https://money.tmx.com)
131              
132             =head1 SYNOPSIS
133              
134             use Finance::Quote;
135              
136             $q = Finance::Quote->new;
137              
138             %stockinfo = $q->fetch('tmx','NT-T'); # Only query TMX
139             %stockinfo = $q->fetch('canada','NT'); # Failover to other Canadian sources
140              
141             =head1 DESCRIPTION
142              
143             This module obtains information from the Toronto Stock Exchange,
144             https://money.tmx.com.
145              
146             This module is loaded by default on a Finance::Quote object. It's also
147             possible to load it explicitly by placing 'TMX' in the argument list to
148             Finance::Quote->new().
149              
150             =head1 LABELS RETURNED
151              
152             The following labels are returned by Finance::Quote::TMX: name,
153             exchange, volume, open, high, low, cap, close, year_range, symbol, last, p_change
154              
155             =head1 TERMS & CONDITIONS
156              
157             Use of money.tmx.com is governed by any terms & conditions of that
158             site and its data provider quotemedia.com.
159              
160             Finance::Quote is released under the GNU General Public License, version 2,
161             which explicitly carries a "No Warranty" clause.
162              
163             =cut