#!/usr/bin/perl -w # Copyright 2009, 2010, 2011, 2015, 2019 Kevin Ryde # This file is part of Finance-Quote-Grab. # # Finance-Quote-Grab is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by the # Free Software Foundation; either version 3, or (at your option) any later # version. # # Finance-Quote-Grab is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License # for more details. # # You should have received a copy of the GNU General Public License along # with Finance-Quote-Grab. If not, see . # Download symbols mentioned as examples in the POD of the various modules, # to see that they exist and have sensible data. # use 5.005; use strict; use ExtUtils::Manifest; use File::Spec; use FindBin; use Finance::Quote; use Test::More; use lib 't'; use MyTestHelpers; BEGIN { MyTestHelpers::nowarnings() } # uncomment this to run the ### lines # use Smart::Comments; # new in 5.6, so unless you've got it separately with 5.005 eval { require Pod::Parser } or plan skip_all => "Pod::Parser not available -- $@"; plan tests => 1; use Data::Dumper; $Data::Dumper::Sortkeys = $Data::Dumper::Sortkeys = 1; my $toplevel_dir = File::Spec->catdir ($FindBin::Bin, File::Spec->updir); my $manifest_file = File::Spec->catfile ($toplevel_dir, 'MANIFEST'); my $manifest = ExtUtils::Manifest::maniread ($manifest_file); my $t_lib_dir = File::Spec->catdir ($toplevel_dir, 'xt'); unshift @INC, $t_lib_dir; require MyPodParser; my @check_files = grep {m{^lib/.*\.pm$}} keys %$manifest; ### @check_files # @check_files = grep {/MGEX/} @check_files; # @check_files = grep {/MLC/} @check_files; my @check_modules; my %symbols; foreach my $filename (@check_files) { my $class = $filename; $class =~ s{^lib/|\.pm$}{}g; $class =~ s{/}{::}g; ### check_file ### $filename ### $class $filename = File::Spec->rel2abs ($filename, $toplevel_dir); my $parser = MyPodParser->new; $parser->parse_from_file ($filename); push @{$symbols{$class}}, @{$parser->symbols_found}; my $module = $class; $module =~ s/.*:://; push @check_modules, $module; } ### %symbols diag "check_modules: ",join(' ',@check_modules); my $good; my $all_good = 1; foreach my $class (sort keys %symbols) { diag "download ",$class; $good = 1; download_symbols ($class, $symbols{$class}); if (! $good) { $all_good = 0; } } ok ($all_good); sub download_symbols { my ($class, $symbol_list) = @_; $class =~ m/([^:]+)$/ or die "Oops, class basename not matched"; my $method = lc($1); # return unless $method eq 'ghana'; my $fq = Finance::Quote->new (@check_modules); my %quotes = $fq->fetch ($method, @$symbol_list); ### %quotes my %numeric_fields = (p_change => 1, volume => 1, eps => 1, div_yield => 1, cap => 1, # Casablanca.pm bid_quantity => 1, ask_quantity => 1, dollar_volume_both_sides => 1, year_high => 1, year_low => 1, net_profit => 1, payout_percent => 1, par_value => 1, shares_on_issue => 1, nominal_capital => 1, ); my $currency_fields_func = ($class->can('currency_fields') || \&Finance::Quote::default_currency_fields); @numeric_fields{&$currency_fields_func()} = (); # hash slice foreach my $symbol (@$symbol_list) { if (! exists $quotes{$symbol,'success'}) { diag "$symbol no 'success' field: ", $quotes{$symbol,'success'}; $good = 0; } elsif (! $quotes{$symbol,'success'}) { diag "$symbol 'success' false: ", $quotes{$symbol,'success'}; $good = 0; } if (! defined $quotes{$symbol,'method'} || $quotes{$symbol,'method'} ne $method) { diag "$symbol wrong 'method': ", $quotes{$symbol,'method'}; $good = 0; } if (! defined $quotes{$symbol,'source'} || $quotes{$symbol,'source'} ne $class) { diag "$symbol wrong 'source': ", $quotes{$symbol,'source'}; $good = 0; } } while (my ($key,$value) = each %quotes) { my ($symbol, $field) = split $;, $key; next if $field eq 'a'; # diagnostic left by $fq->store_date() if (defined $value) { if ($value =~ /\240/) { diag "'$key' '$value' latin-1 non-breaking space"; $good = 0; } if ($value =~ /^(\s|\240)/) { diag "'$key' '$value' leading whitespace"; $good = 0; } if ($value =~ /(\s|\240)$/) { diag "'$key' '$value' trailing whitespace"; $good = 0; } } if ($field =~ /_range$/ && defined $value) { if ($value =~ /^(.+)-(.+)$/) { my $hi = $1; my $lo = $2; check_number ($key, $lo); check_number ($key, $hi); if ($lo > $hi) { diag "'$key' '$value' has lo > hi"; $good = 0; } } else { diag "'$key' '$value' not NUMBER-NUMBER format"; $good = 0; } } elsif (exists $numeric_fields{$field} && defined $value) { check_number ($key, $value); } if ($field eq 'isodate' || $field eq 'ex_div') { unless (! defined $value || $value =~ /^([0-9]{4})-([0-9]{2})-([0-9]{2})$/) { diag "'$key' '$value' not an ISO date"; $good = 0; } } if ($field eq 'time') { unless (! defined $value || $value =~ /^[0-9]{2}:[0-9]{2}(:[0-9]{2})?$/) { diag "'$key' '$value' not an ISO time"; $good = 0; } } } if (! $good) { require Data::Dumper; print Data::Dumper->new([\%quotes],['quotes'])->Useqq(1)->Dump; } } sub check_number { my ($key, $value) = @_; unless ($value =~ m{^-?[0-9]+.[0-9]+$ # decimal |^-?[0-9]+$ # integer |^$}x) { # allow empty for Casablanca ... diag "'$key' '$value' not a number"; $good = 0; } if ($value =~ /^0[0-9]/) { diag "'$key' '$value' leading zero"; $good = 0; } } exit 0;