File Coverage

blib/lib/Finance/Quote/ASEGR.pm
Criterion Covered Total %
statement 26 79 32.9
branch 0 14 0.0
condition 0 3 0.0
subroutine 10 13 76.9
pod 0 4 0.0
total 36 113 31.8


line stmt bran cond sub pod time code
1             #!/usr/bin/perl -w
2             # This program is free software; you can redistribute it and/or modify
3             # it under the terms of the GNU General Public License as published by
4             # the Free Software Foundation; either version 2 of the License, or
5             # (at your option) any later version.
6             #
7             # This program is distributed in the hope that it will be useful,
8             # but WITHOUT ANY WARRANTY; without even the implied warranty of
9             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10             # GNU General Public License for more details.
11             #
12             # You should have received a copy of the GNU General Public License
13             # along with this program; if not, write to the Free Software
14             # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
15             # 02110-1301, USA
16             package Finance::Quote::ASEGR;
17              
18 5     5   3511 use strict;
  5         13  
  5         153  
19 5     5   46 use warnings;
  5         14  
  5         202  
20              
21 5     5   32 use constant DEBUG => $ENV{DEBUG};
  5         33  
  5         525  
22 5     5   50 use if DEBUG, 'Smart::Comments';
  5         11  
  5         51  
23              
24 5     5   254 use LWP::UserAgent;
  5         13  
  5         86  
25 5     5   173 use Web::Scraper;
  5         30  
  5         30  
26 5     5   2775 use Spreadsheet::XLSX;
  5         643954  
  5         66  
27 5     5   232 use String::Util qw(trim);
  5         19  
  5         4390  
28              
29             our $VERSION = '1.57_03'; # TRIAL VERSION
30              
31             our @labels = qw/symbol date isodate close volume high low isin/;
32              
33             our %labels = (symbol => ['symbol', 'trading symbol'],
34             date => ['date'],
35             close => ['price', 'current nominal value', 'closing price'],
36             volume => ['volume'],
37             high => ['max'],
38             low => ['min'],
39             isin => ['isin']);
40              
41             sub methods {
42 5     5 0 81 return ( greece => \&asegr,
43             asegr => \&asegr,
44             europe => \&asegr);
45             }
46              
47             sub labels {
48 5     5 0 23 return ( greece => \@labels,
49             asegr => \@labels,
50             europe => \@labels);
51             }
52              
53             our @sources = qw/statistics-end-of-day-securities
54             statistics-end-of-day-etfs
55             statistics-end-of-day-bonds
56             statistics-end-of-day-warrants
57             statistics-end-of-day-derivatives
58             statistics-end-of-day-lending
59             statistics-end-of-day-indices/;
60              
61             sub load_source {
62 0     0 0   my $ua = shift;
63 0           my $table = shift;
64 0           my $source = shift;
65              
66 0           eval {
67 0           my $url = "https://www.athexgroup.gr/web/guest/$source";
68 0           my $reply = $ua->get($url);
69              
70             ### Fetched : $url, $reply->code
71              
72             my $data = scraper {
73 0     0     process 'div.portlet-content-container div.portlet-body table ~ p:last-child > a:first-child', 'link[]' => '@href';
74 0           };
75            
76 0           my $result = $data->scrape($reply);
77            
78 0           foreach my $link (@{$result->{link}}) {
  0            
79 0           $reply = $ua->get($link);
80              
81             ### Fetched : $link, $reply->code
82 0           my $xlsx = $reply->content();
83 0           my $io;
84 0           open($io, '<', \$xlsx);
85              
86 0           my $workbook = Spreadsheet::XLSX->new($io);
87              
88 0           for my $worksheet ($workbook->worksheets()) {
89 0           my ($row_min, $row_max) = $worksheet->row_range();
90 0           my ($col_min, $col_max) = $worksheet->col_range();
91              
92 0           my %head = map {$_ => trim(lc($worksheet->get_cell($row_min, $_)->value()))} ($col_min .. $col_max);
  0            
93              
94 0           for my $row (($row_min+1) .. $row_max) {
95 0           my $this = {};
96              
97 0           for my $col ($col_min .. $col_max) {
98              
99 0           my $cell = $worksheet->get_cell($row, $col);
100 0 0         next unless $cell;
101              
102 0           $this->{$head{$col}} = trim($cell->value());
103             }
104              
105 0 0         $table->{$this->{'symbol'}} = $this if exists $this->{'symbol'};
106 0 0         $table->{$this->{'trading symbol'}} = $this if exists $this->{'trading symbol'};
107             }
108             }
109             }
110             };
111 0 0         if ($@) {
112             ### Error: $@
113             }
114             }
115              
116             sub asegr {
117 0     0 0   my $quoter = shift;
118 0           my @symbols = @_;
119 0           my $ua = $quoter->user_agent();
120 0           my @found;
121             my %info;
122              
123 0           my %table;
124 0           my $index = 0;
125              
126 0   0       while (@symbols and $index < @sources) {
127             # Load the next source
128 0           load_source($ua, \%table, $sources[$index++]);
129              
130             # Sift through @symbols
131 0           push(@found, grep {exists $table{$_}} @symbols);
  0            
132 0           @symbols = grep {not exists $table{$_}} @symbols;
  0            
133             }
134              
135             ### Found : @found
136             ### Not found : @symbols
137              
138 0           foreach my $symbol (@found) {
139 0           foreach my $label (@labels) {
140 0 0         next if $label eq 'isodate';
141 0           foreach my $key (@{$labels{$label}}) {
  0            
142 0 0         $info{$symbol,$label} = $table{$symbol}->{$key} if exists $table{$symbol}->{$key};
143             }
144             }
145              
146 0           $quoter->store_date(\%info, $symbol, {eurodate => $info{$symbol,'date'}});
147             }
148              
149             # Anything left in @symbols is a failure
150 0           foreach my $symbol (@symbols) {
151 0           $info{$symbol, 'success'} = 0;
152 0           $info{$symbol, 'errormsg'} = 'Not found';
153             }
154              
155 0 0         return wantarray() ? %info : \%info;
156             }
157              
158             1;
159              
160             =head1 NAME
161              
162             Finance::Quote::ASEGR - Obtain quotes from Athens Exchange Group
163              
164             =head1 SYNOPSIS
165              
166             use Finance::Quote;
167              
168             $q = Finance::Quote->new;
169              
170             %info = Finance::Quote->fetch("asegr","minoa"); # Only query ASEGR
171             %info = Finance::Quote->fetch("greece","aaak"); # Failover to other sources OK.
172              
173             =head1 DESCRIPTION
174              
175             This module fetches information from https://www.athexgroup.gr.
176              
177             This module is loaded by default on a Finance::Quote object. It's also possible
178             to load it explicitly by placing 'asegr' in the argument list to
179             Finance::Quote->new().
180              
181             This module provides both the 'asegr' and 'greece' fetch methods.
182              
183             =head1 LABELS RETURNED
184              
185             The following labels may be returned: symbol date isodate close volume high low isin.
186              
187             =head1 Terms & Conditions
188              
189             Use of www.athexgroup.gr is governed by any terms & conditions of that site.
190              
191             Finance::Quote is released under the GNU General Public License, version 2,
192             which explicitly carries a "No Warranty" clause.
193              
194             =cut