line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Copyright 2007, 2008, 2009, 2010, 2011, 2012, 2014, 2015, 2016, 2017 Kevin Ryde |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# This file is part of Chart. |
4
|
|
|
|
|
|
|
# |
5
|
|
|
|
|
|
|
# Chart is free software; you can redistribute it and/or modify it under the |
6
|
|
|
|
|
|
|
# terms of the GNU General Public License as published by the Free Software |
7
|
|
|
|
|
|
|
# Foundation; either version 3, or (at your option) any later version. |
8
|
|
|
|
|
|
|
# |
9
|
|
|
|
|
|
|
# Chart is distributed in the hope that it will be useful, but WITHOUT ANY |
10
|
|
|
|
|
|
|
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
11
|
|
|
|
|
|
|
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more |
12
|
|
|
|
|
|
|
# details. |
13
|
|
|
|
|
|
|
# |
14
|
|
|
|
|
|
|
# You should have received a copy of the GNU General Public License along |
15
|
|
|
|
|
|
|
# with Chart. If not, see <http://www.gnu.org/licenses/>. |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
package App::Chart; |
18
|
45
|
|
|
45
|
|
1399
|
use 5.010; |
|
45
|
|
|
|
|
200
|
|
19
|
45
|
|
|
45
|
|
220
|
use strict; |
|
45
|
|
|
|
|
74
|
|
|
45
|
|
|
|
|
1050
|
|
20
|
45
|
|
|
45
|
|
229
|
use warnings; |
|
45
|
|
|
|
|
91
|
|
|
45
|
|
|
|
|
1116
|
|
21
|
45
|
|
|
45
|
|
205
|
use Carp; |
|
45
|
|
|
|
|
85
|
|
|
45
|
|
|
|
|
2165
|
|
22
|
45
|
|
|
45
|
|
8970
|
use Date::Calc; |
|
45
|
|
|
|
|
185463
|
|
|
45
|
|
|
|
|
1597
|
|
23
|
45
|
|
|
45
|
|
281
|
use File::Spec; |
|
45
|
|
|
|
|
86
|
|
|
45
|
|
|
|
|
1145
|
|
24
|
45
|
|
|
45
|
|
203
|
use List::Util qw(min max); |
|
45
|
|
|
|
|
81
|
|
|
45
|
|
|
|
|
2743
|
|
25
|
45
|
|
|
45
|
|
11386
|
use POSIX qw(floor ceil); |
|
45
|
|
|
|
|
185594
|
|
|
45
|
|
|
|
|
246
|
|
26
|
45
|
|
|
45
|
|
68074
|
use Regexp::Common 'whitespace'; |
|
45
|
|
|
|
|
90530
|
|
|
45
|
|
|
|
|
174
|
|
27
|
45
|
|
|
45
|
|
32757
|
use Scalar::Util; |
|
45
|
|
|
|
|
105
|
|
|
45
|
|
|
|
|
1835
|
|
28
|
45
|
|
|
45
|
|
2111
|
use Locale::TextDomain; |
|
45
|
|
|
|
|
92640
|
|
|
45
|
|
|
|
|
298
|
|
29
|
45
|
|
|
45
|
|
58937
|
use Locale::TextDomain ('App-Chart'); |
|
45
|
|
|
|
|
93
|
|
|
45
|
|
|
|
|
158
|
|
30
|
45
|
|
|
45
|
|
19235
|
use Glib; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
# uncomment this to run the ### lines |
33
|
|
|
|
|
|
|
#use Smart::Comments; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
our $VERSION = 262; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
use Locale::Messages 1.16; # version 1.16 for turn_utf_8_on() |
38
|
|
|
|
|
|
|
BEGIN { |
39
|
|
|
|
|
|
|
Locale::Messages::bind_textdomain_codeset ('App-Chart','UTF-8'); |
40
|
|
|
|
|
|
|
Locale::Messages::bind_textdomain_filter ('App-Chart', |
41
|
|
|
|
|
|
|
\&Locale::Messages::turn_utf_8_on); |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
# sub chart_gettext_filter { |
44
|
|
|
|
|
|
|
# my ($str) = @_; |
45
|
|
|
|
|
|
|
# Locale::Messages::turn_utf_8_on ($str); |
46
|
|
|
|
|
|
|
# $str =~ s/^CONTEXT\(.*?\): *//; |
47
|
|
|
|
|
|
|
# return $str; |
48
|
|
|
|
|
|
|
# } |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
# Return the user's ~/Chart directory, as an absolute path in filesystem |
51
|
|
|
|
|
|
|
# charset encoding. |
52
|
|
|
|
|
|
|
# Note not using Glib::get_home_dir() here, since it wrongly prefers |
53
|
|
|
|
|
|
|
# /etc/passwd file over $HOME. |
54
|
|
|
|
|
|
|
use constant::defer chart_directory => sub { |
55
|
|
|
|
|
|
|
if (defined $ENV{'CHART_DIRECTORY'}) { |
56
|
|
|
|
|
|
|
return $ENV{'CHART_DIRECTORY'} |
57
|
|
|
|
|
|
|
} else { |
58
|
|
|
|
|
|
|
require File::HomeDir; |
59
|
|
|
|
|
|
|
my $home = File::HomeDir->my_home |
60
|
|
|
|
|
|
|
// die "No home directory can be found by File::HomeDir\n"; |
61
|
|
|
|
|
|
|
return File::Spec->catdir($home, 'Chart'); |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
}; |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
use constant::defer chart_dirbroadcast => sub { |
66
|
|
|
|
|
|
|
require App::Chart::Glib::Ex::DirBroadcast; |
67
|
|
|
|
|
|
|
return App::Chart::Glib::Ex::DirBroadcast->new |
68
|
|
|
|
|
|
|
(File::Spec->catdir(chart_directory(), 'broadcast')); |
69
|
|
|
|
|
|
|
}; |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
# force LC_NUMERIC to the locale, whereas perl normally runs with "C" |
72
|
|
|
|
|
|
|
use constant::defer number_formatter => sub { |
73
|
|
|
|
|
|
|
require Number::Format; |
74
|
|
|
|
|
|
|
my $oldlocale = POSIX::setlocale(POSIX::LC_NUMERIC()); |
75
|
|
|
|
|
|
|
POSIX::setlocale (POSIX::LC_NUMERIC(), ""); |
76
|
|
|
|
|
|
|
my $nf = Number::Format->new; |
77
|
|
|
|
|
|
|
POSIX::setlocale (POSIX::LC_NUMERIC(), $oldlocale); |
78
|
|
|
|
|
|
|
return $nf; |
79
|
|
|
|
|
|
|
}; |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
use constant { UP_COLOUR => 'light green', |
82
|
|
|
|
|
|
|
DOWN_COLOUR => 'pink', |
83
|
|
|
|
|
|
|
BAND_COLOUR => 'blue', |
84
|
|
|
|
|
|
|
GREY_COLOUR => 'grey' }; |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
our %option |
89
|
|
|
|
|
|
|
= (verbose => 0, |
90
|
|
|
|
|
|
|
d_fmt => do { |
91
|
|
|
|
|
|
|
# langinfo D_FMT if available, otherwise fallback to a neutral YYYY-MM-DD |
92
|
|
|
|
|
|
|
eval { |
93
|
|
|
|
|
|
|
require I18N::Langinfo; |
94
|
|
|
|
|
|
|
require I18N::Langinfo::Wide; |
95
|
|
|
|
|
|
|
I18N::Langinfo::Wide::langinfo(I18N::Langinfo::D_FMT()) |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
|| '%Y-%m-%d' |
98
|
|
|
|
|
|
|
}, |
99
|
|
|
|
|
|
|
http_get_cost => 3000, |
100
|
|
|
|
|
|
|
); |
101
|
|
|
|
|
|
|
$option{'wd_fmt'} = __x('%a {d_fmt}', d_fmt => $option{'d_fmt'}); |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
sub symbol_sans_suffix { |
108
|
|
|
|
|
|
|
my ($symbol) = @_; |
109
|
|
|
|
|
|
|
return ($symbol =~ /(.*)\./ ? $1 : $symbol); |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
sub symbol_suffix { |
113
|
|
|
|
|
|
|
my ($symbol) = @_; |
114
|
|
|
|
|
|
|
if ($symbol =~ /([.=][^.=]+)$/) { |
115
|
|
|
|
|
|
|
return $1; |
116
|
|
|
|
|
|
|
} else { |
117
|
|
|
|
|
|
|
return ''; |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
my $symbol_re = qr{ |
122
|
|
|
|
|
|
|
((\ (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)\ | |
123
|
|
|
|
|
|
|
\^?[^^]([FGHJKMNQUVXZ])) # $4 M code |
124
|
|
|
|
|
|
|
([0-9]+) # $5 year |
125
|
|
|
|
|
|
|
| ([0-9]+))? # $6 number like LME |
126
|
|
|
|
|
|
|
(\.[^.]+)?$ # $7 suffix |
127
|
|
|
|
|
|
|
}ix; |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
# return commodity part of SYMBOL, or whole symbol (sans suffix) if no |
130
|
|
|
|
|
|
|
# month/year |
131
|
|
|
|
|
|
|
# eg. "GC" for "GCH05.CMX" |
132
|
|
|
|
|
|
|
# "TIN 3" for "TIN 3.LME" -- ????? |
133
|
|
|
|
|
|
|
sub symbol_commodity { |
134
|
|
|
|
|
|
|
my ($symbol) = @_; |
135
|
|
|
|
|
|
|
$symbol =~ $symbol_re or die 'Oops, symbol_re didn\'t match'; |
136
|
|
|
|
|
|
|
my $end = ($+[6] # "TIN 3" num right up to suffix |
137
|
|
|
|
|
|
|
// $-[4] # "X08" M-code stop there |
138
|
|
|
|
|
|
|
// $-[0]); # " JAN 06" named stop there, or whole lot |
139
|
|
|
|
|
|
|
return substr ($symbol, 0, $end); |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
sub symbol_is_front { |
142
|
|
|
|
|
|
|
my ($symbol) = @_; |
143
|
|
|
|
|
|
|
return symbol_commodity($symbol) eq symbol_sans_suffix($symbol); |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
sub symbol_cmp { |
150
|
|
|
|
|
|
|
my ($s1, $s2) = @_; |
151
|
|
|
|
|
|
|
# transform "." so that it comes before a space, so that "ZINC.LME" sorts |
152
|
|
|
|
|
|
|
# before "ZINC 3.LME", etc |
153
|
|
|
|
|
|
|
$s1 =~ tr/^./\000\001/; |
154
|
|
|
|
|
|
|
$s2 =~ tr/^./\000\001/; |
155
|
|
|
|
|
|
|
return (lc($s1) cmp lc($s2)) || ($s1 cmp $s2); |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
my %symbol_setups_done; |
162
|
|
|
|
|
|
|
sub symbol_setups { |
163
|
|
|
|
|
|
|
my ($symbol) = @_; |
164
|
|
|
|
|
|
|
my $suffix = symbol_suffix ($symbol); |
165
|
|
|
|
|
|
|
if ($suffix eq '') { |
166
|
|
|
|
|
|
|
if ($symbol_setups_done{$symbol}) { return; } |
167
|
|
|
|
|
|
|
$symbol_setups_done{$symbol} = 1; |
168
|
|
|
|
|
|
|
### symbol_setups() NoSuffix\n: $symbol |
169
|
|
|
|
|
|
|
require App::Chart::Suffix::NoSuffix; |
170
|
|
|
|
|
|
|
App::Chart::Suffix::NoSuffix::symbol_setups ($symbol); |
171
|
|
|
|
|
|
|
return; |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
if ($symbol_setups_done{$suffix}) { return; } |
174
|
|
|
|
|
|
|
$symbol_setups_done{$suffix} = 1; |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
### symbol_setups() suffix: $suffix |
177
|
|
|
|
|
|
|
if ($symbol =~ /[.=]..?$/) { |
178
|
|
|
|
|
|
|
require App::Chart::Yahoo; |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
# '.AX' or '=X' becomes 'AX' or 'X' |
182
|
|
|
|
|
|
|
$suffix =~ s/[.=]//; |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
# load App::Chart::Suffix::XX and also any App::Chart::Suffix::XX::Foo, the |
185
|
|
|
|
|
|
|
# latter being meant as pluggable add-ons |
186
|
|
|
|
|
|
|
require Module::Util; |
187
|
|
|
|
|
|
|
require Module::Load; |
188
|
|
|
|
|
|
|
require Module::Find; |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
my $top_module = "App::Chart::Suffix::$suffix"; |
191
|
|
|
|
|
|
|
if (Module::Util::find_installed($top_module)) { |
192
|
|
|
|
|
|
|
### load top: $top_module |
193
|
|
|
|
|
|
|
Module::Load::load ($top_module); |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
foreach my $sub_module (Module::Find::findsubmod($top_module)) { |
196
|
|
|
|
|
|
|
### load sub_module: $sub_module |
197
|
|
|
|
|
|
|
Module::Load::load ($sub_module); |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
# =item C<< App::Chart::symbol_source_help ($symbol) >> |
204
|
|
|
|
|
|
|
# |
205
|
|
|
|
|
|
|
# Return the name of the node (or anchor) in the manual for help on the data |
206
|
|
|
|
|
|
|
# source for C<$symbol>. |
207
|
|
|
|
|
|
|
# |
208
|
|
|
|
|
|
|
# =item App::Chart::setup_source_help ($pred, $node) |
209
|
|
|
|
|
|
|
# |
210
|
|
|
|
|
|
|
# =cut |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
my @source_help_list = (); |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
sub symbol_source_help { |
215
|
|
|
|
|
|
|
my ($symbol) = @_; |
216
|
|
|
|
|
|
|
symbol_setups ($symbol); |
217
|
|
|
|
|
|
|
foreach my $elem (@source_help_list) { |
218
|
|
|
|
|
|
|
if ($elem->[0]->match ($symbol)) { |
219
|
|
|
|
|
|
|
return $elem->[1]; |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
return undef; |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
sub setup_source_help { |
225
|
|
|
|
|
|
|
my ($pred, $node) = @_; |
226
|
|
|
|
|
|
|
require App::Chart::Sympred; |
227
|
|
|
|
|
|
|
App::Chart::Sympred::validate ($pred); |
228
|
|
|
|
|
|
|
# newer get higher priority |
229
|
|
|
|
|
|
|
unshift @source_help_list, [ $pred, $node ]; |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
sub hms_to_seconds { |
236
|
|
|
|
|
|
|
my ($hour, $minute, $seconds) = @_; |
237
|
|
|
|
|
|
|
return $hour * 60*60 + $minute * 60 + ($seconds || 0); |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
sub seconds_to_hms { |
243
|
|
|
|
|
|
|
my ($seconds) = @_; |
244
|
|
|
|
|
|
|
return (floor ($seconds/3600) % 60, |
245
|
|
|
|
|
|
|
floor ($seconds/60) % 60, |
246
|
|
|
|
|
|
|
$seconds % 60); |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
sub ymd_to_iso { |
252
|
|
|
|
|
|
|
my ($year, $month, $day) = @_; |
253
|
|
|
|
|
|
|
return sprintf ('%04d-%02d-%02d', $year, $month, $day); |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
sub iso_to_ymd { |
257
|
|
|
|
|
|
|
my ($iso) = @_; |
258
|
|
|
|
|
|
|
return split /-/, $iso; |
259
|
|
|
|
|
|
|
} |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
sub adate_to_ymd { |
262
|
|
|
|
|
|
|
my ($adate) = @_; |
263
|
|
|
|
|
|
|
return Date::Calc::Add_Delta_Days(1970,1,5, $adate); |
264
|
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
|
my $adate_days_base = Date::Calc::Date_to_Days (1970, 1, 5); |
266
|
|
|
|
|
|
|
sub ymd_to_adate { |
267
|
|
|
|
|
|
|
my ($year, $month, $day) = @_; |
268
|
|
|
|
|
|
|
return Date::Calc::Date_to_Days ($year, $month, $day) - $adate_days_base; |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
sub adate_to_iso { |
271
|
|
|
|
|
|
|
my ($tdate) = @_; |
272
|
|
|
|
|
|
|
return App::Chart::ymd_to_iso (App::Chart::adate_to_ymd ($tdate)); |
273
|
|
|
|
|
|
|
} |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
sub tdate_to_ymd { |
276
|
|
|
|
|
|
|
my ($tdate) = @_; |
277
|
|
|
|
|
|
|
return adate_to_ymd (tdate_to_adate ($tdate)); |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
sub tdate_to_iso { |
280
|
|
|
|
|
|
|
my ($tdate) = @_; |
281
|
|
|
|
|
|
|
return adate_to_iso (tdate_to_adate ($tdate)); |
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
sub tdate_to_adate { |
284
|
|
|
|
|
|
|
my ($tdate) = @_; |
285
|
|
|
|
|
|
|
return $tdate + floor ($tdate/5)*2; |
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
sub adate_to_tdate_floor { |
288
|
|
|
|
|
|
|
my ($adate) = @_; |
289
|
|
|
|
|
|
|
return floor ($adate / 7) * 5 + min ($adate % 7, 4); |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
sub adate_to_tdate_ceil { |
292
|
|
|
|
|
|
|
my ($adate) = @_; |
293
|
|
|
|
|
|
|
return floor ($adate / 7) * 5 + min ($adate % 7, 5); |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
sub ymd_to_tdate_floor { |
296
|
|
|
|
|
|
|
my ($year, $month, $day) = @_; |
297
|
|
|
|
|
|
|
return adate_to_tdate_floor (ymd_to_adate ($year, $month, $day)); |
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
sub ymd_to_tdate_ceil { |
300
|
|
|
|
|
|
|
my ($year, $month, $day) = @_; |
301
|
|
|
|
|
|
|
return adate_to_tdate_ceil (ymd_to_adate ($year, $month, $day)); |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
sub collapse_whitespace { |
308
|
|
|
|
|
|
|
my ($str) = @_; |
309
|
|
|
|
|
|
|
$str =~ s/\x{A0}+/ /g; # latin1/unicode non-breaking space |
310
|
|
|
|
|
|
|
$str =~ s/$RE{ws}{crop}//g; # leading and trailing whitespace |
311
|
|
|
|
|
|
|
$str =~ s/\s+/ /g; # middle whitespace |
312
|
|
|
|
|
|
|
return $str; |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
sub decimal_sub { |
318
|
|
|
|
|
|
|
my ($x, $y) = @_; |
319
|
|
|
|
|
|
|
# would prefer an actual decimal-arithmetic subtract here |
320
|
|
|
|
|
|
|
my $decimals = max (count_decimals ($x), count_decimals ($y)); |
321
|
|
|
|
|
|
|
return sprintf ('%.*f', $decimals, $x - $y); |
322
|
|
|
|
|
|
|
} |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
sub count_decimals { |
327
|
|
|
|
|
|
|
my ($str) = @_; |
328
|
|
|
|
|
|
|
my $pos = index ($str, '.'); |
329
|
|
|
|
|
|
|
if ($pos >= 0) { |
330
|
|
|
|
|
|
|
return length($str) - $pos - 1; |
331
|
|
|
|
|
|
|
} else { |
332
|
|
|
|
|
|
|
return 0; |
333
|
|
|
|
|
|
|
} |
334
|
|
|
|
|
|
|
} |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
# Return min or max of the arguments, ignoring any undefs. |
339
|
|
|
|
|
|
|
# If no args (no undefs that is) then return undef. |
340
|
|
|
|
|
|
|
# List::Util min() and max() return undef for no args, but they want all args |
341
|
|
|
|
|
|
|
# to be numeric. |
342
|
|
|
|
|
|
|
# |
343
|
|
|
|
|
|
|
sub min_maybe { |
344
|
|
|
|
|
|
|
return min (grep {defined} @_); |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
sub max_maybe { |
347
|
|
|
|
|
|
|
return max (grep {defined} @_); |
348
|
|
|
|
|
|
|
} |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
# App::Chart::datafilename ($filename) |
353
|
|
|
|
|
|
|
# App::Chart::datafilename ($dir,...,$dir, $filename) |
354
|
|
|
|
|
|
|
# |
355
|
|
|
|
|
|
|
# Return an absolute path like /usr/share/perl5/App/Chart/$filename, |
356
|
|
|
|
|
|
|
# wherever App/Chart/$filename is found in @INC. $dir arguments specify a |
357
|
|
|
|
|
|
|
# subdirectory like App/Chart/$dir1/$dir2/$filename. All args and the |
358
|
|
|
|
|
|
|
# return are in filesystem charset bytes. |
359
|
|
|
|
|
|
|
# |
360
|
|
|
|
|
|
|
# Module::Find and Module::Util have similar @INC searches, but only for .pm |
361
|
|
|
|
|
|
|
# files it seems. |
362
|
|
|
|
|
|
|
# |
363
|
|
|
|
|
|
|
sub datafilename { |
364
|
|
|
|
|
|
|
foreach my $inc (@INC) { |
365
|
|
|
|
|
|
|
my $filename = File::Spec->catfile ($inc, 'App', 'Chart', @_); |
366
|
|
|
|
|
|
|
if (-e $filename) { return $filename; } |
367
|
|
|
|
|
|
|
} |
368
|
|
|
|
|
|
|
require File::Basename; |
369
|
|
|
|
|
|
|
return File::Spec->catfile (File::Basename::dirname($INC{'App/Chart.pm'}), |
370
|
|
|
|
|
|
|
'Chart', @_); |
371
|
|
|
|
|
|
|
} |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
# return true if range ($alo,$ahi) overlaps range ($blo,$bhi) |
374
|
|
|
|
|
|
|
# each endpoint is taken as inclusive, so say (1,4) and (4,7) do overlap |
375
|
|
|
|
|
|
|
# |
376
|
|
|
|
|
|
|
sub overlap_inclusive_p { |
377
|
|
|
|
|
|
|
my ($alo, $ahi, $blo, $bhi) = @_; |
378
|
|
|
|
|
|
|
return ! ($ahi < $blo || $alo > $bhi); |
379
|
|
|
|
|
|
|
} |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
1; |
382
|
|
|
|
|
|
|
__END__ |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
=head1 NAME |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
App::Chart -- various shared Chart things |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
=head1 SYMBOL FUNCTIONS |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
=over 4 |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
=cut |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
=item C<< %App::Chart::option >> |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
Various program options. |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
=over 4 |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
=item C<verbose> (default false) |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
Print more things (mainly during downloads). This is the C<--verbose> |
403
|
|
|
|
|
|
|
command line option. |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
=item C<d_fmt> (default from C<langinfo()>) |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
C<strftime> format string for a date. Non-ASCII can be included as Perl |
408
|
|
|
|
|
|
|
wide-chars. |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
The default is from C<langinfo(D_FMT)> if the L<I18N::Langinfo> and |
411
|
|
|
|
|
|
|
L<I18N::Langinfo::Wide> modules are available. Otherwise the default is |
412
|
|
|
|
|
|
|
C<%Y-%m-%d> which gives an ISO style YYYY-MM-DD. |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
=item C<wd_fmt> (default C<%a> and C<d_fmt>) |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
C<strftime> format string for a weekday name and date. |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
=item C<http_get_cost> (default 3000) |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
Byte cost reckoned for each separate HTTP request. This is used when |
421
|
|
|
|
|
|
|
choosing between an individual download per symbol or a whole-day download |
422
|
|
|
|
|
|
|
of everything at the exchange. |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
If your connection is badly lagged you could increase this to prefer the |
425
|
|
|
|
|
|
|
single big file. If you want to minimize downloaded bytes then reduce this |
426
|
|
|
|
|
|
|
to roughly HTTP per-request overhead (packet and headers each way), which |
427
|
|
|
|
|
|
|
might be a few hundred bytes. |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
=back |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
=item C<< App::Chart::symbol_sans_suffix ($symbol) >> |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
Return C<$symbol> without its suffix. Eg. |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
App::Chart::symbol_sans_suffix ('BHP.AX') # gives 'BHP' |
436
|
|
|
|
|
|
|
App::Chart::symbol_sans_suffix ('GM') # gives 'GM' |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
=item App::Chart::symbol_suffix ($symbol) |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
Return the suffix part of C<$symbol>, or an empty string if no suffix. Eg. |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
App::Chart::symbol_suffix ('BHP.AX') # gives '.AX' |
443
|
|
|
|
|
|
|
App::Chart::symbol_suffix ('GM') # gives '' |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
=item C<< $cmp = App::Chart::symbol_cmp ($s1, $s2) >> |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
Return -1, 0 or 1 according to C<$s1> less than, equal to, or greater than |
448
|
|
|
|
|
|
|
C<$s2>. |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
Symbols are compared alphabetically, except "^" index symbols come before |
451
|
|
|
|
|
|
|
ordinary symbols. |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
=back |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
=head1 DATE/TIME FUNCTIONS |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
=over 4 |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
=item App::Chart::hms_to_seconds ($hour, $minute, [$second]) |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
Return a count of seconds since midnight for the given C<$hour>, C<$minute> |
462
|
|
|
|
|
|
|
and C<$seconds>. C<$seconds> is optional and defaults to 0. C<$hour> is in |
463
|
|
|
|
|
|
|
24-hour format, so for instance 16 for 4pm. |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
=item App::Chart::seconds_to_hms ($seconds) |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
Return three values C<($hour, $minute, $seconds)> split from C<$seconds> |
468
|
|
|
|
|
|
|
which is a count of seconds since midnight. C<$hour> is in 24-hour format, |
469
|
|
|
|
|
|
|
so for instance 16 for 4pm. |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
=cut |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
# =item C<< App::Chart::ymd_to_iso ($year, $month, $day) >> |
474
|
|
|
|
|
|
|
# |
475
|
|
|
|
|
|
|
# ... |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
=back |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
=head1 MISC FUNCTIONS |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
=over 4 |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
=item App::Chart::collapse_whitespace ($str) |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
Return C<$str> with leading and trailing whitespace stripped, and any runs |
486
|
|
|
|
|
|
|
of whitespace within the string collapsed down to a single space character |
487
|
|
|
|
|
|
|
each. |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
=item App::Chart::decimal_sub ($x, $y) |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
Calculate the difference C<$x - $y> of two decimal number strings C<$x> and |
492
|
|
|
|
|
|
|
C<$y> and return such a string. For example, |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
App::Chart::decimal_sub ('2.55', '1.15') # gives '1.40' |
495
|
|
|
|
|
|
|
App::Chart::decimal_sub ('60.5', '1.05') # gives '59.45' |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
The number of decimal places used and returned is whichever of the two |
498
|
|
|
|
|
|
|
values has the most places. |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
=item C<< App::Chart::count_decimals ($str) >> |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
Return the number of decimal places in the number string C<$str>, ie. how |
503
|
|
|
|
|
|
|
many digits after the decimal point, or 0 if no decimal point. Eg. |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
App::Chart::count_decimals ('123') # is 0 |
506
|
|
|
|
|
|
|
App::Chart::count_decimals ('123.') # is 0 |
507
|
|
|
|
|
|
|
App::Chart::count_decimals ('123.5') # is 1 |
508
|
|
|
|
|
|
|
App::Chart::count_decimals ('2.500') # is 3 |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
=item App::Chart::max_maybe ($num, $num, ...) |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
=item App::Chart::min_maybe ($num, $num, ...) |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
Return the maximum or minimum (respectively) among the given numbers. |
515
|
|
|
|
|
|
|
C<undef>s in the arguments are ignored and if there's no arguments, or only |
516
|
|
|
|
|
|
|
C<undef> arguments, the return is C<undef>. |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
=back |
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
=head1 SEE ALSO |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
L<chart> |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
=head1 HOME PAGE |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
L<http://user42.tuxfamily.org/chart/index.html> |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
=head1 LICENCE |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
Copyright 2007, 2008, 2009, 2010, 2011, 2012, 2014, 2015, 2016, 2017 Kevin Ryde |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
Chart is free software; you can redistribute it and/or modify it under the |
533
|
|
|
|
|
|
|
terms of the GNU General Public License as published by the Free Software |
534
|
|
|
|
|
|
|
Foundation; either version 3, or (at your option) any later version. |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
Chart is distributed in the hope that it will be useful, but WITHOUT ANY |
537
|
|
|
|
|
|
|
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
538
|
|
|
|
|
|
|
FOR A PARTICULAR PURPOSE. See the GNU General Public License for more |
539
|
|
|
|
|
|
|
details. |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
You should have received a copy of the GNU General Public License along with |
542
|
|
|
|
|
|
|
Chart; see the file F<COPYING>. Failing that, see |
543
|
|
|
|
|
|
|
L<http://www.gnu.org/licenses/>. |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
=cut |