line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Weather::GHCN::Options.pm - class for GHCN options
|
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
## no critic (Documentation::RequirePodAtEnd)
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 NAME
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
Weather::GHCN::Options - create and manage option lists/objects used by GHCN modules and scripts
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 VERSION |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
version v0.0.011 |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=head1 SYNOPSIS
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
use Weather::GHCN::Options;
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=head1 DESCRIPTION
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
The B module provides a class and methods that are
|
21
|
|
|
|
|
|
|
used within GHCN modules or from application scripts that use GHCN
|
22
|
|
|
|
|
|
|
modules to create and manage options that determine the behaviour of
|
23
|
|
|
|
|
|
|
GHCN methods.
|
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
The module is primarily for use by module Weather::GHCN::StationTable.
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
=cut
|
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# these are needed because perlcritic fails to detect that Object::Pad handles these things
|
30
|
|
|
|
|
|
|
## no critic [ValuesAndExpressions::ProhibitVersionStrings]
|
31
|
|
|
|
|
|
|
## no critic [TestingAndDebugging::RequireUseWarnings]
|
32
|
|
|
|
|
|
|
|
33
|
6
|
|
|
6
|
|
2277
|
use v5.18; # minimum for Object::Pad
|
|
6
|
|
|
|
|
23
|
|
34
|
6
|
|
|
6
|
|
39
|
use warnings;
|
|
6
|
|
|
|
|
15
|
|
|
6
|
|
|
|
|
226
|
|
35
|
6
|
|
|
6
|
|
31
|
use Object::Pad 0.66 qw( :experimental(init_expr) );
|
|
6
|
|
|
|
|
87
|
|
|
6
|
|
|
|
|
40
|
|
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
package Weather::GHCN::Options;
|
38
|
|
|
|
|
|
|
class Weather::GHCN::Options;
|
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
our $VERSION = 'v0.0.011'; |
41
|
|
|
|
|
|
|
|
42
|
6
|
|
|
6
|
|
2488
|
use Carp qw(carp croak);
|
|
6
|
|
|
|
|
22
|
|
|
6
|
|
|
|
|
410
|
|
43
|
6
|
|
|
6
|
|
41
|
use Const::Fast;
|
|
6
|
|
|
|
|
19
|
|
|
6
|
|
|
|
|
52
|
|
44
|
6
|
|
|
6
|
|
3654
|
use Hash::Wrap {-lvalue => 1, -defined => 1, -as => '_wrap_hash'};
|
|
6
|
|
|
|
|
21622
|
|
|
6
|
|
|
|
|
48
|
|
45
|
6
|
|
|
6
|
|
8423
|
use Path::Tiny;
|
|
6
|
|
|
|
|
13699
|
|
|
6
|
|
|
|
|
368
|
|
46
|
6
|
|
|
6
|
|
3893
|
use Text::Abbrev;
|
|
6
|
|
|
|
|
284
|
|
|
6
|
|
|
|
|
346
|
|
47
|
6
|
|
|
6
|
|
545
|
use Try::Tiny;
|
|
6
|
|
|
|
|
2209
|
|
|
6
|
|
|
|
|
414
|
|
48
|
6
|
|
|
6
|
|
1161
|
use Weather::GHCN::CountryCodes qw( search_country );
|
|
6
|
|
|
|
|
15
|
|
|
6
|
|
|
|
|
430
|
|
49
|
6
|
|
|
6
|
|
1050
|
use Weather::GHCN::Common qw( :all );
|
|
6
|
|
|
|
|
15
|
|
|
6
|
|
|
|
|
957
|
|
50
|
6
|
|
|
6
|
|
3842
|
use YAML::Tiny;
|
|
6
|
|
|
|
|
37491
|
|
|
6
|
|
|
|
|
39777
|
|
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
######################################################################
|
53
|
|
|
|
|
|
|
# Constants
|
54
|
|
|
|
|
|
|
######################################################################
|
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
const my $TRUE => 1; # perl's usual TRUE
|
57
|
|
|
|
|
|
|
const my $FALSE => not $TRUE; # a dual-var consisting of '' and 0
|
58
|
|
|
|
|
|
|
const my $SPACE => q( );
|
59
|
|
|
|
|
|
|
const my $EMPTY => q();
|
60
|
|
|
|
|
|
|
const my $DASH => q(-);
|
61
|
|
|
|
|
|
|
const my $BAR => q(|);
|
62
|
|
|
|
|
|
|
const my $BANG => q(!);
|
63
|
|
|
|
|
|
|
const my $NEWLINE => qq(\n);
|
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
const my $DEFAULT_PROFILE_FILE => '~/.ghcn_fetch.yaml';
|
66
|
|
|
|
|
|
|
const my $ALIAS_NAME_RE => qr{ \A [_]?[[:lower:]]+ \Z }xms;
|
67
|
|
|
|
|
|
|
const my @REPORT_TYPE_LIST => qw(detail daily monthly yearly url curl kml stn id);
|
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=head1 METHODS
|
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=head2 new
|
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
Create a new Options object.
|
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=cut
|
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
######################################################################
|
78
|
|
|
|
|
|
|
# Set up the default Tk::Getopt option table, which we will use for
|
79
|
|
|
|
|
|
|
# both Tk::Getopt and to derive an options list of Getopt::Long
|
80
|
|
|
|
|
|
|
# for when Tk::Getopt is not installed.
|
81
|
|
|
|
|
|
|
######################################################################
|
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
## no critic [ValuesAndExpressions::ProhibitMagicNumbers]
|
84
|
|
|
|
|
|
|
## no critic [ValuesAndExpressions::ProhibitNoisyQuotes]
|
85
|
|
|
|
|
|
|
## no critic [ValuesAndExpressions::ProhibitEmptyQuotes]
|
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
my $Tk_opt_table = [
|
88
|
|
|
|
|
|
|
'Basic options',
|
89
|
|
|
|
|
|
|
['location', '=s', undef, label => 'Filter stations by their location name (regex)'],
|
90
|
|
|
|
|
|
|
['state', '=s', undef, label => 'Filter stations by state or province',
|
91
|
|
|
|
|
|
|
alias => ['province'] ],
|
92
|
|
|
|
|
|
|
['country', '=s', undef, label => 'Filter station by the country they are in'],
|
93
|
|
|
|
|
|
|
['gsn', '!', undef, label => 'Include only GSN reference stations'],
|
94
|
|
|
|
|
|
|
['', '', '-'],
|
95
|
|
|
|
|
|
|
['report', '=s', '',
|
96
|
|
|
|
|
|
|
label => 'Type of report',
|
97
|
|
|
|
|
|
|
strict => 1,
|
98
|
|
|
|
|
|
|
choices => [
|
99
|
|
|
|
|
|
|
[ 'station list', '' ],
|
100
|
|
|
|
|
|
|
[ 'yearly summary', 'yearly' ],
|
101
|
|
|
|
|
|
|
[ 'monthly summary', 'monthly' ],
|
102
|
|
|
|
|
|
|
[ 'daily summary', 'daily' ],
|
103
|
|
|
|
|
|
|
[ 'detail level', 'detail' ],
|
104
|
|
|
|
|
|
|
[ 'station KML', 'kml' ],
|
105
|
|
|
|
|
|
|
[ 'station url list', 'url' ],
|
106
|
|
|
|
|
|
|
[ 'station curl list', 'curl' ],
|
107
|
|
|
|
|
|
|
[ 'station list only', 'stn' ],
|
108
|
|
|
|
|
|
|
]
|
109
|
|
|
|
|
|
|
],
|
110
|
|
|
|
|
|
|
['', '', '-'],
|
111
|
|
|
|
|
|
|
['dataonly', '!', undef, label => 'Only print the data table'],
|
112
|
|
|
|
|
|
|
['performance', '!', undef, label => 'Report performance statistics'],
|
113
|
|
|
|
|
|
|
['verbose', '!', undef, label => 'Print information messages'],
|
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
'Date filters',
|
116
|
|
|
|
|
|
|
['range', '=s', undef, label => 'Filter selected station data by year range'],
|
117
|
|
|
|
|
|
|
['active', '=s', undef, label => 'Filter stations by their active year range'],
|
118
|
|
|
|
|
|
|
['partial', '!', undef, label => 'Allow stations only active for part of the active range'],
|
119
|
|
|
|
|
|
|
['quality', '=i', 90, label => 'Quality threshold (percent as an integer)'],
|
120
|
|
|
|
|
|
|
['', '','-'],
|
121
|
|
|
|
|
|
|
['fday', '=s', undef, label => 'Filter output to include a specific day'],
|
122
|
|
|
|
|
|
|
['fmonth', '=s', undef, label => 'Filter output to include a specific month'],
|
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
'GIS filters',
|
125
|
|
|
|
|
|
|
['gps', '=s', undef, label => 'Filter stations by latitude and longitude',
|
126
|
|
|
|
|
|
|
help => 'Enter decimal latitude and longitude'],
|
127
|
|
|
|
|
|
|
['radius', '=i', 50, label => 'Radius to search for stations near coordinates'],
|
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
'Analysis Options',
|
131
|
|
|
|
|
|
|
['anomalies', '!', undef, label => 'Provide calculated anomalies in the output'],
|
132
|
|
|
|
|
|
|
['baseline', '=s', '1971-2000',
|
133
|
|
|
|
|
|
|
label => 'Baseline year range'],
|
134
|
|
|
|
|
|
|
['precip', '!', undef, label => 'Include precipitation stats in the results'],
|
135
|
|
|
|
|
|
|
['tavg', '!', undef, label => 'Include TAVG in the results'],
|
136
|
|
|
|
|
|
|
['nogaps', '!', undef, label => 'Emit extra rows for missing months or days'],
|
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
'Other Options',
|
139
|
|
|
|
|
|
|
['kmlcolor', '=s', 'red', label => 'Color to use for KML placemarks' ],
|
140
|
|
|
|
|
|
|
['profile', '=s', $DEFAULT_PROFILE_FILE,
|
141
|
|
|
|
|
|
|
label => 'Profile file location (for option preloading)'], #, nogui => 1],
|
142
|
|
|
|
|
|
|
['cachedir', '=s', undef, label => 'Directory for cached files'],
|
143
|
|
|
|
|
|
|
['refresh', '=s', 'yearly',
|
144
|
|
|
|
|
|
|
help => 'Refresh yearly, (default), never, always, or if N days old (N > 1)',
|
145
|
|
|
|
|
|
|
label => 'Cache refresh option',
|
146
|
|
|
|
|
|
|
choices => [ 'yearly', 'always', 'never', '' ],
|
147
|
|
|
|
|
|
|
],
|
148
|
|
|
|
|
|
|
];
|
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
## use critic [ValuesAndExpressions::ProhibitMagicNumbers]
|
151
|
|
|
|
|
|
|
## use critic [ValuesAndExpressions::ProhibitNoisyQuotes]
|
152
|
|
|
|
|
|
|
## use critic [ValuesAndExpressions::ProhibitEmptyQuotes]
|
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
#####################################################################
|
155
|
|
|
|
|
|
|
# Class fields
|
156
|
|
|
|
|
|
|
######################################################################
|
157
|
|
|
|
|
|
|
|
158
|
24
|
|
|
24
|
1
|
7523
|
field $_opt_href :mutator; # a hashref of merged options (with default values applied))
|
|
24
|
|
|
|
|
95
|
|
159
|
24
|
|
|
24
|
1
|
112
|
field $_opt_obj :mutator; # a Hash::Wrap object derived from $_opt_href
|
|
24
|
|
|
|
|
102
|
|
160
|
285
|
|
|
285
|
1
|
1191
|
field $_profile_href :mutator; # a hash containing profile file options
|
|
285
|
|
|
|
|
645
|
|
161
|
|
|
|
|
|
|
field $_tk_opt_aref; # the Tk:Getopt array that defines all GHCN options
|
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
=head1 FIELD ACCESSORS
|
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
Writeable (mutator) access is provided for some fields primarily so
|
166
|
|
|
|
|
|
|
an Options object can be tested independantly from StationTable.
|
167
|
|
|
|
|
|
|
In general, an Options object is set by the StationTable set_options
|
168
|
|
|
|
|
|
|
method and should not be modified directly by the consuming application
|
169
|
|
|
|
|
|
|
using these mutators.
|
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=over 4
|
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
=item opt_href
|
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
This writable field is set by StationTable->set_options and is a
|
176
|
|
|
|
|
|
|
hashref of user options merged with default values.
|
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
For programmatic access to option values, use of B is
|
179
|
|
|
|
|
|
|
preferred to prevent mispellings. (See B.)
|
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
=item opt_obj
|
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
This writable field is set by StationTable->set_options and is a
|
184
|
|
|
|
|
|
|
Hash::Wrap object composed from the B hashref field. It
|
185
|
|
|
|
|
|
|
provides accessor field methods for user options (merged with default
|
186
|
|
|
|
|
|
|
values).
|
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
Using this object, rather than B, for access to option
|
189
|
|
|
|
|
|
|
values is safer programming choice as any misspelling of an option
|
190
|
|
|
|
|
|
|
name will result in a run time error. In contrast, mispelling a hash
|
191
|
|
|
|
|
|
|
key will simply result in an undef being returned.
|
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
=item profile_href
|
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
This writable field is set by StationTable->set_options and contains
|
196
|
|
|
|
|
|
|
the profile options it was given.
|
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
=back
|
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
=cut
|
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
######################################################################
|
203
|
|
|
|
|
|
|
=head1 CLASS METHODS
|
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
The following class methods are supported. Class Options uses
|
206
|
|
|
|
|
|
|
Object::Perl, so these class methods (specified using the :common
|
207
|
|
|
|
|
|
|
method attribute) should be accessed using -> not :: because ->
|
208
|
|
|
|
|
|
|
will shift off the $class argument and :: won't.
|
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
=head2 get_tk_options_table
|
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
Returns: @tk_opttable or \@tk_opttable
|
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
Provides access to the predefined TK::Getopt options list that define
|
215
|
|
|
|
|
|
|
the Getopt::Long arguments supported by class StationTable for user
|
216
|
|
|
|
|
|
|
options.
|
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
The table is a list of lists and strings. The strings define
|
219
|
|
|
|
|
|
|
sections that Tk::Getopt renders as panels or tabs in the GUI it
|
220
|
|
|
|
|
|
|
constructs. The lists contain option names and types (in Getopt::Long
|
221
|
|
|
|
|
|
|
style) as well as default values, aliases, and labels to be displayed
|
222
|
|
|
|
|
|
|
in the GUI, choices for multi-select options, and other extensions.
|
223
|
|
|
|
|
|
|
See Tk::Getopt OPTTABLE ARGUMENTS for details.
|
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
=cut
|
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
method get_tk_options_table :common () {
|
228
|
|
|
|
|
|
|
return wantarray ? ( $Tk_opt_table->@* ) : $Tk_opt_table;
|
229
|
|
|
|
|
|
|
}
|
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
=head2 get_getopt_list
|
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
Returns: @options or \@options
|
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
In scalar context, return a list reference to a translation of the
|
236
|
|
|
|
|
|
|
TK::Getopt options list into the simpler list used by Getopt::Long.
|
237
|
|
|
|
|
|
|
This gives application authors a choice between using Tk::Getopt and
|
238
|
|
|
|
|
|
|
the non-GUI and more traditional Getopt::Long.
|
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
In list context, this method returns a Getopt::Long-style list
|
241
|
|
|
|
|
|
|
options.
|
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
Typically, this method would be called prior to Getopt::Long in order
|
244
|
|
|
|
|
|
|
to obtain an options list for using the StationTable class; e.g.
|
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
my %opt;
|
247
|
|
|
|
|
|
|
my @options = ( Weather::GHCN::Options->get_getopt_list() );
|
248
|
|
|
|
|
|
|
GetOptions( \%opt, @options);
|
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
=cut
|
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
method get_getopt_list :common () {
|
253
|
|
|
|
|
|
|
## no critic [ProhibitDoubleSigils]
|
254
|
|
|
|
|
|
|
my @options_text;
|
255
|
|
|
|
|
|
|
my @options_list;
|
256
|
|
|
|
|
|
|
my @options;
|
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
# According to https://metacpan.org/pod/Tk::Getopt -opttable
|
259
|
|
|
|
|
|
|
# should be a reference to an array containing all options.
|
260
|
|
|
|
|
|
|
# Elements of this array may be strings, which indicate the
|
261
|
|
|
|
|
|
|
# beginning of a new group, or array references describing the
|
262
|
|
|
|
|
|
|
# options. The first element of this array is the name of the
|
263
|
|
|
|
|
|
|
# option, the second is the type (=s for string, =i for integer,
|
264
|
|
|
|
|
|
|
# ! for boolean, =f for float etc., see Getopt::Long) for a
|
265
|
|
|
|
|
|
|
# detailed list. The third element is optional and contains the
|
266
|
|
|
|
|
|
|
# default value (otherwise the default is undefined).
|
267
|
|
|
|
|
|
|
# Further elements are optional too and describe more attributes. For a
|
268
|
|
|
|
|
|
|
# complete list of these attributes refer to "OPTTABLE ARGUMENTS".
|
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
foreach my $row ( $Tk_opt_table->@* ) {
|
271
|
|
|
|
|
|
|
next if ref $row ne 'ARRAY';
|
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
# pick off the first three values, then slurp the rest
|
274
|
|
|
|
|
|
|
my ($opt_kw, $opt_type, $default, @other) = $row->@*;
|
275
|
|
|
|
|
|
|
# skip the group dividers
|
276
|
|
|
|
|
|
|
next if not $opt_kw;
|
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
my %h;
|
279
|
|
|
|
|
|
|
while (my $item = shift @other) {
|
280
|
|
|
|
|
|
|
if (ref $item eq 'HASH') {
|
281
|
|
|
|
|
|
|
while (my ($k,$v) = each $item->%*) {
|
282
|
|
|
|
|
|
|
$h{$k} = $v;
|
283
|
|
|
|
|
|
|
}
|
284
|
|
|
|
|
|
|
} else {
|
285
|
|
|
|
|
|
|
my $value = shift @other;
|
286
|
|
|
|
|
|
|
$h{$item} = $value;
|
287
|
|
|
|
|
|
|
}
|
288
|
|
|
|
|
|
|
}
|
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
my $label = $h{'label'} // $SPACE;
|
291
|
|
|
|
|
|
|
my $alias_aref = $h{'alias'} // [];
|
292
|
|
|
|
|
|
|
my $opt_kw_with_aliases = join $BAR, $opt_kw, $alias_aref->@*;
|
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
push @options_list, $opt_kw_with_aliases . $opt_type;
|
295
|
|
|
|
|
|
|
push @options, [$opt_kw_with_aliases, $opt_type, $label];
|
296
|
|
|
|
|
|
|
}
|
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
# calculate the width of the option spec column so the labels,
|
299
|
|
|
|
|
|
|
# which we print as comment in the text output, will line up
|
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
my $colwidth = 0;
|
302
|
|
|
|
|
|
|
foreach my $opt_aref (@options) {
|
303
|
|
|
|
|
|
|
my ($opt_kw_with_aliases, $opt_type, $label) = $opt_aref->@*;
|
304
|
|
|
|
|
|
|
my $len = length( q(') . $opt_kw_with_aliases . $opt_type . q(', ) );
|
305
|
|
|
|
|
|
|
$colwidth = $len if $len > $colwidth;
|
306
|
|
|
|
|
|
|
}
|
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
my $fmt = sprintf '%%-%ds', $colwidth;
|
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
foreach my $opt_aref (@options) {
|
311
|
|
|
|
|
|
|
my ($opt_kw_with_aliases, $opt_type, $label) = $opt_aref->@*;
|
312
|
|
|
|
|
|
|
my $kw = sprintf $fmt, q(') . $opt_kw_with_aliases . $opt_type . q(',);
|
313
|
|
|
|
|
|
|
push @options_text, $kw . '# ' . $label;
|
314
|
|
|
|
|
|
|
}
|
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
return wantarray ? ( @options_list ) : join $NEWLINE, sort @options_text;
|
317
|
|
|
|
|
|
|
}
|
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
=head2 get_option_choices ( $option )
|
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
Returns: \%choices
|
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
Find all the options which have a multiple choice response, and return
|
325
|
|
|
|
|
|
|
a hash keyed on the option name and with a values consisting
|
326
|
|
|
|
|
|
|
of a hash of the valid responses as value/label pairs.
|
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
=cut
|
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
method get_option_choices :common () {
|
331
|
|
|
|
|
|
|
my %choices;
|
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
foreach my $row ( $Tk_opt_table->@* ) {
|
334
|
|
|
|
|
|
|
next if ref $row ne 'ARRAY';
|
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
# pick off the first three values, then slurp the rest
|
337
|
|
|
|
|
|
|
my ($opt_kw, $opt_type, $default, @others) = $row->@*;
|
338
|
|
|
|
|
|
|
# skip the group dividers
|
339
|
|
|
|
|
|
|
next if not $opt_kw;
|
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
my $href;
|
342
|
|
|
|
|
|
|
if (@others and ref $others[0] eq 'HASH' ) {
|
343
|
|
|
|
|
|
|
$href = $others[0];
|
344
|
|
|
|
|
|
|
} elsif (@others % 2 == 0) {
|
345
|
|
|
|
|
|
|
$href = { @others };
|
346
|
|
|
|
|
|
|
} else {
|
347
|
|
|
|
|
|
|
croak "*E* unable to parse opttable: @others";
|
348
|
|
|
|
|
|
|
}
|
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
my %hv;
|
351
|
|
|
|
|
|
|
if ( $href->{'choices'} and ref $href->{'choices'} eq 'ARRAY' ) {
|
352
|
|
|
|
|
|
|
foreach my $slot ( $href->{'choices'}->@* ) {
|
353
|
|
|
|
|
|
|
if (ref $slot eq 'ARRAY') {
|
354
|
|
|
|
|
|
|
$hv{ $slot->[1] } = $slot->[0];
|
355
|
|
|
|
|
|
|
}
|
356
|
|
|
|
|
|
|
elsif (ref $slot eq $EMPTY) {
|
357
|
|
|
|
|
|
|
$hv{ $slot } = $TRUE;
|
358
|
|
|
|
|
|
|
}
|
359
|
|
|
|
|
|
|
}
|
360
|
|
|
|
|
|
|
$choices{$opt_kw} = \%hv;
|
361
|
|
|
|
|
|
|
}
|
362
|
|
|
|
|
|
|
}
|
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
return \%choices;
|
365
|
|
|
|
|
|
|
}
|
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
=head2 get_option_defaults
|
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
Returns: \%defaults
|
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
Returns the option defaults, obtained from the same predefined list
|
372
|
|
|
|
|
|
|
of lists/strings returned by get_tk_options_table.
|
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
=cut
|
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
method get_option_defaults :common () {
|
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
my %defaults = ();
|
379
|
|
|
|
|
|
|
foreach my $slot ($Tk_opt_table->@*) {
|
380
|
|
|
|
|
|
|
next if ref $slot ne 'ARRAY';
|
381
|
|
|
|
|
|
|
my $key = $slot->[0];
|
382
|
|
|
|
|
|
|
next if not $key;
|
383
|
|
|
|
|
|
|
my $default_value = $slot->[2];
|
384
|
|
|
|
|
|
|
$defaults{$key} = $default_value;
|
385
|
|
|
|
|
|
|
}
|
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
return \%defaults;
|
388
|
|
|
|
|
|
|
}
|
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
=head2 get_profile_filespec ($filespec='')
|
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
Returns the filespec for the user profile file. If the optional
|
393
|
|
|
|
|
|
|
$filespec argument is null or an empty string, then the default
|
394
|
|
|
|
|
|
|
profile is returned. If a $filespec argument is provided, it can
|
395
|
|
|
|
|
|
|
contain '~' (to represent the user HOME directory) and that will be
|
396
|
|
|
|
|
|
|
converted to an absolute path.
|
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
=cut
|
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
method get_profile_filespec :common ($filespec=$EMPTY) {
|
401
|
|
|
|
|
|
|
# an EMPTY arg will default to ~/.ghcn_fetch.yaml
|
402
|
|
|
|
|
|
|
$filespec ||= $DEFAULT_PROFILE_FILE;
|
403
|
|
|
|
|
|
|
# Path::Tiny::path will replace ~ or ~username with the corresponding path
|
404
|
|
|
|
|
|
|
return path($filespec)->absolute->stringify;
|
405
|
|
|
|
|
|
|
}
|
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
=head2 get_profile_options ($profile='')
|
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
Return a hashref containing the options and aliases defined in the
|
410
|
|
|
|
|
|
|
the user profile file. If called with undef, returns a ref to an
|
411
|
|
|
|
|
|
|
empty hash. If called with an empty string, it reads from the default
|
412
|
|
|
|
|
|
|
profile file '~/.ghcn_fetch.yaml'.
|
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
=cut
|
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
method get_profile_options :common ($profile=$EMPTY) {
|
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
#debug# use DDP;
|
419
|
|
|
|
|
|
|
#debug# use Log::Dispatch;
|
420
|
|
|
|
|
|
|
#debug# my $log = Log::Dispatch->new(
|
421
|
|
|
|
|
|
|
#debug# outputs => [
|
422
|
|
|
|
|
|
|
#debug# [ 'File', min_level => 'debug', filename => 'c:/sandbox/log.log' ],
|
423
|
|
|
|
|
|
|
#debug# [ 'Screen', min_level => 'debug' ],
|
424
|
|
|
|
|
|
|
#debug#
|
425
|
|
|
|
|
|
|
#debug# ]
|
426
|
|
|
|
|
|
|
#debug# );
|
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
my $profile_href = {};
|
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
# passing undef will result in an empty config
|
431
|
|
|
|
|
|
|
return $profile_href if not defined $profile;
|
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
# #debug# use FindBin;
|
434
|
|
|
|
|
|
|
# #debug# open my $fh, '>>', 'c:/sandbox/log.log' or die;
|
435
|
|
|
|
|
|
|
# #debug# $log->debug( 'program ' . $0 );
|
436
|
|
|
|
|
|
|
# #debug# $log->debug( 'caller ' . join(' | ', caller) );
|
437
|
|
|
|
|
|
|
# #debug# $log->debug( 'received profile_file: ' . $_profile );
|
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
my $profile_filespec = Weather::GHCN::Options->get_profile_filespec($profile);
|
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
my $yaml_struct;
|
442
|
|
|
|
|
|
|
my $msg = $EMPTY;
|
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
# uncoverable branch false
|
445
|
|
|
|
|
|
|
if (-e $profile_filespec) {
|
446
|
|
|
|
|
|
|
# uncoverable branch false
|
447
|
|
|
|
|
|
|
try {
|
448
|
9
|
|
|
9
|
|
988
|
$yaml_struct = YAML::Tiny->read($profile_filespec);
|
449
|
|
|
|
|
|
|
} catch {
|
450
|
0
|
|
|
0
|
|
0
|
$msg = '*W* no cache or aliases: failed reading YAML in ' . $profile_filespec;
|
451
|
0
|
|
|
|
|
0
|
carp $msg;
|
452
|
|
|
|
|
|
|
}
|
453
|
|
|
|
|
|
|
} else {
|
454
|
|
|
|
|
|
|
return $profile_href;
|
455
|
|
|
|
|
|
|
}
|
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
$profile_href = $yaml_struct->[0]
|
458
|
|
|
|
|
|
|
if $yaml_struct;
|
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
#debug# $log->( 'yaml_struct length = ' . length $yaml_struct );
|
461
|
|
|
|
|
|
|
#debug# $log->( "\n" );
|
462
|
|
|
|
|
|
|
#debug# $log->( 'profile_filespec: ' . $profile_filespec );
|
463
|
|
|
|
|
|
|
#debug# $log->( 'carp ' . $msg );
|
464
|
|
|
|
|
|
|
#debug# $log->( 'FindBin::Bin ' . $FindBin::Bin );
|
465
|
|
|
|
|
|
|
#debug# $log->( "\n");
|
466
|
|
|
|
|
|
|
#debug# $log->( 'profile_href ' . np($profile_href) );
|
467
|
|
|
|
|
|
|
#debug# $log->( "\n" );
|
468
|
|
|
|
|
|
|
#debug# $log->( "================" );
|
469
|
|
|
|
|
|
|
#debug# $log->( "\n" );
|
470
|
|
|
|
|
|
|
#debug# close $fh;
|
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
return $profile_href;
|
473
|
|
|
|
|
|
|
}
|
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
=head2 valid_report_type ($rt, \@opttable)
|
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
This function is used to validate the report type. Valid values are
|
479
|
|
|
|
|
|
|
defined in the built-in Tk options table, which can be obtained by
|
480
|
|
|
|
|
|
|
calling:
|
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
my @opttable = ( Weather::GHCN::Options->get_tk_options_table() );
|
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
=cut
|
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
method valid_report_type :common ($rt, $opttable_aref) {
|
487
|
|
|
|
|
|
|
my $choices_href = Weather::GHCN::Options->get_option_choices;
|
488
|
|
|
|
|
|
|
return $choices_href->{'report'}->{ lc $rt };
|
489
|
|
|
|
|
|
|
}
|
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
=head2 deabbrev_report_type ($rt)
|
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
The report types supported by the -report option can be abbrevated,
|
494
|
|
|
|
|
|
|
so long as the abbrevation is unambiquous. For example, 'daily' can
|
495
|
|
|
|
|
|
|
be abbreviated to 'dail', 'dai', or 'da', but not 'd' because 'detail'
|
496
|
|
|
|
|
|
|
is also a valid report type and 'd' would not disambiguate the two.
|
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
This function takes a (possibly abbreviated) report type and returns
|
499
|
|
|
|
|
|
|
an unabbreviated report type.
|
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
=cut
|
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
method deabbrev_report_type :common ($rt) {
|
504
|
|
|
|
|
|
|
my %r_abbrev = abbrev( @REPORT_TYPE_LIST );
|
505
|
|
|
|
|
|
|
my $deabbreved = $r_abbrev{ lc $rt };
|
506
|
|
|
|
|
|
|
return $deabbreved;
|
507
|
|
|
|
|
|
|
}
|
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
=head2 valid_refresh_option ($refresh, \@opttable)
|
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
This function is used to validate the refresh option. Valid values are
|
512
|
|
|
|
|
|
|
defined in the built-in Tk options table, which can be obtained by
|
513
|
|
|
|
|
|
|
calling:
|
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
my @opttable = ( Weather::GHCN::Options->get_tk_options_table() );
|
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
=cut
|
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
method valid_refresh_option :common ($refresh, $opttable_aref) {
|
520
|
|
|
|
|
|
|
my $choices_href = Weather::GHCN::Options->get_option_choices;
|
521
|
|
|
|
|
|
|
# we only validate the non-numeric options
|
522
|
|
|
|
|
|
|
return $TRUE if $refresh =~ m{ \A \d+ \Z }xms;
|
523
|
|
|
|
|
|
|
return $choices_href->{'refresh'}->{ lc $refresh };
|
524
|
|
|
|
|
|
|
}
|
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
=head2 deabbrev_refresh_option ($refresh)
|
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
The refresh option values can be abbrevated, so long as the abbrevation
|
529
|
|
|
|
|
|
|
is unambiquous. For example, 'yearly' can
|
530
|
|
|
|
|
|
|
be abbreviated to 'y', 'ye', 'yea', etc.
|
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
This function takes a (possibly abbreviated) refresh option and returns
|
533
|
|
|
|
|
|
|
an unabbreviated refresh option.
|
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
=cut
|
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
method deabbrev_refresh_option :common ($refresh) {
|
538
|
|
|
|
|
|
|
# we only deabbreviate the non-numeric options
|
539
|
|
|
|
|
|
|
return $refresh if $refresh =~ m{ \A \d+ \Z }xms;
|
540
|
|
|
|
|
|
|
my %r_abbrev = abbrev( qw(yearly never always) );
|
541
|
|
|
|
|
|
|
my $deabbreved = $r_abbrev{ lc $refresh };
|
542
|
|
|
|
|
|
|
return $deabbreved;
|
543
|
|
|
|
|
|
|
}
|
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
######################################################################
|
546
|
|
|
|
|
|
|
=head1 INSTANCE METHODS
|
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
=over 4
|
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
=item combine_options ( $user_opt_href, $profile_href={} )
|
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
Returns: ($opt_href, $opt_obj)
|
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
This method takes a hash reference containing user options, and optionally
|
555
|
|
|
|
|
|
|
a hash reference of profile options, and combines them with default
|
556
|
|
|
|
|
|
|
values. The end result is a complete set of all the options
|
557
|
|
|
|
|
|
|
supported by Weather::GHCN::StationTable with user-specified options taking
|
558
|
|
|
|
|
|
|
precedence over profile options, and profile options taking precedence
|
559
|
|
|
|
|
|
|
over defaults.
|
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
This set of options is returned as both a hash reference and as a
|
562
|
|
|
|
|
|
|
Hash::Wrap object. The latter is preferred for use by consuming
|
563
|
|
|
|
|
|
|
applications, because it provides accessor methods for each option.
|
564
|
|
|
|
|
|
|
In addition, an ->defined( " |
565
|
|
|
|
|
|
|
your code can determine whether an option value was set to B.
|
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
The advantage to using an option object rather than an option hash
|
568
|
|
|
|
|
|
|
is that a misspelled option name will cause a runtime error.
|
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
=back
|
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
=cut
|
573
|
|
|
|
|
|
|
|
574
|
125
|
|
|
125
|
1
|
198650
|
method combine_options ( $user_opt_href, $profile_href={} ) {
|
|
125
|
|
|
|
|
251
|
|
|
125
|
|
|
|
|
211
|
|
|
125
|
|
|
|
|
210
|
|
|
125
|
|
|
|
|
183
|
|
575
|
|
|
|
|
|
|
# assign the class-level tk_options_table aref, generated before BUILD, to the instance field
|
576
|
125
|
|
|
|
|
216
|
$_tk_opt_aref = $Tk_opt_table;
|
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
# start with the user options
|
579
|
125
|
|
|
|
|
504
|
my %merged_options = ( $user_opt_href->%* );
|
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
# merge in the profile options
|
582
|
125
|
|
|
|
|
591
|
while ( my ($k,$v) = each $profile_href->%* ) {
|
583
|
9
|
|
33
|
|
|
75
|
$merged_options{$k} //= $v;
|
584
|
|
|
|
|
|
|
}
|
585
|
|
|
|
|
|
|
|
586
|
125
|
|
|
|
|
343
|
my $defaults_href = get_option_defaults();
|
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
# merge in the defaults
|
589
|
125
|
|
|
|
|
579
|
while ( my ($k,$v) = each $defaults_href->%* ) {
|
590
|
3125
|
|
100
|
|
|
11244
|
$merged_options{$k} //= $v;
|
591
|
|
|
|
|
|
|
}
|
592
|
|
|
|
|
|
|
|
593
|
125
|
|
|
|
|
254
|
$_opt_href = \%merged_options;
|
594
|
125
|
|
|
|
|
3228
|
$_opt_obj = _wrap_hash \%merged_options;
|
595
|
|
|
|
|
|
|
|
596
|
125
|
|
|
|
|
2402
|
return ($_opt_href, $_opt_obj);
|
597
|
|
|
|
|
|
|
}
|
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
=head2 initialize
|
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
Returns: @errors
|
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
This method initializes options that can't simply be initialized by
|
604
|
|
|
|
|
|
|
constants. Specifically:
|
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
=over 4
|
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
=item Aliases
|
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
Alias entries defined in the user profile are matched against
|
611
|
|
|
|
|
|
|
the -location option value. If a match is found to the alias name,
|
612
|
|
|
|
|
|
|
the alias value is substituted for the location value.
|
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
Alias names must be lowercase letters only. An optional underscore
|
615
|
|
|
|
|
|
|
prefix is permitted. Names not matching this rule will be silently
|
616
|
|
|
|
|
|
|
ignored by initialize().
|
617
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
=item country
|
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
The B option value can be:
|
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
* a 2-character GEC (FIPS) country code
|
623
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
* a 3-character alpha ISO 3166 country code
|
625
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
* a 3-digit numeric ISO 3166 country number
|
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
* an internet domain country suffix (e.g. '.ca')
|
629
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
* a 3-character regex string
|
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
If a regex string is given, then it will be matched (unanchored and
|
633
|
|
|
|
|
|
|
case insensitve) against country names. If multiple matches are
|
634
|
|
|
|
|
|
|
found, then an error is returned and the user will need to provide a
|
635
|
|
|
|
|
|
|
more specific pattern.
|
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
=item active
|
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
The B option filters stations according to the years that
|
640
|
|
|
|
|
|
|
they were active. If the B option is specified, but the
|
641
|
|
|
|
|
|
|
B option is not, then B will set the B
|
642
|
|
|
|
|
|
|
option value to the B option value so that only stations that
|
643
|
|
|
|
|
|
|
were active during the requested data range will be selected.
|
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
=item quality
|
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
The B option determines whether a station's data will be
|
648
|
|
|
|
|
|
|
included in the output when it has missing data. Quality is
|
649
|
|
|
|
|
|
|
expressed as a number between 0 and 100, representing the percentage
|
650
|
|
|
|
|
|
|
of data that cannot be missing; 90% is the default For example, if
|
651
|
|
|
|
|
|
|
you have a range of 3 years (1095 days) when B is 90, then
|
652
|
|
|
|
|
|
|
you need 90% x 1095 = 985 days of data. Anything less and the
|
653
|
|
|
|
|
|
|
station is rejected.
|
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
When filters fmonth and fday are used, the amount of data included
|
656
|
|
|
|
|
|
|
will typically drop far below 90% thereby rejecting all stations.
|
657
|
|
|
|
|
|
|
To avoid this nuisance, B will set quality to 0% if
|
658
|
|
|
|
|
|
|
either the B or B options are present.
|
659
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
=back
|
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
=cut
|
663
|
|
|
|
|
|
|
|
664
|
125
|
|
|
125
|
1
|
413
|
method initialize () {
|
|
125
|
|
|
|
|
226
|
|
|
125
|
|
|
|
|
174
|
|
665
|
125
|
|
|
|
|
198
|
my @errors;
|
666
|
|
|
|
|
|
|
|
667
|
125
|
100
|
|
|
|
2130
|
if ( $_opt_obj->country ) {
|
668
|
|
|
|
|
|
|
# using undef as the search type so it will figure it out based
|
669
|
|
|
|
|
|
|
# on the value pattern and length
|
670
|
8
|
|
|
|
|
261
|
my @cou = search_country( $_opt_obj->country, undef );
|
671
|
|
|
|
|
|
|
|
672
|
8
|
100
|
|
|
|
47
|
push @errors, '*E* unrecognized country code or name'
|
673
|
|
|
|
|
|
|
if not @cou;
|
674
|
|
|
|
|
|
|
|
675
|
8
|
100
|
|
|
|
28
|
push @errors, '*E* ambiguous country code or name'
|
676
|
|
|
|
|
|
|
if @cou > 1;
|
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
# return the GEC (FIPS) country code, which is what GHCN uses
|
679
|
8
|
|
|
|
|
221
|
$_opt_obj->country = $cou[0]->{gec};
|
680
|
|
|
|
|
|
|
}
|
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
# default the station active range to the year filter range if its value is an empty string
|
683
|
125
|
100
|
100
|
|
|
5109
|
if ( $_opt_obj->defined('active') and $_opt_obj->active eq $EMPTY ) {
|
684
|
5
|
|
|
|
|
244
|
$_opt_obj->active = $_opt_obj->range;
|
685
|
|
|
|
|
|
|
}
|
686
|
|
|
|
|
|
|
|
687
|
125
|
100
|
100
|
|
|
3188
|
$_opt_obj->quality = 0
|
688
|
|
|
|
|
|
|
if $_opt_obj->fmonth or $_opt_obj->fday;
|
689
|
|
|
|
|
|
|
|
690
|
125
|
|
|
|
|
8339
|
return @errors;
|
691
|
|
|
|
|
|
|
}
|
692
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
=head2 options_as_string
|
694
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
This option returns a string that contains all the options and their
|
696
|
|
|
|
|
|
|
values, in a format similar to what they would look like when entered
|
697
|
|
|
|
|
|
|
as command-line arguments. For boolean options only the option name
|
698
|
|
|
|
|
|
|
is include (no value). Option values containing whitespace are
|
699
|
|
|
|
|
|
|
enclosed in double quotes. Option/value pairs are separated by
|
700
|
|
|
|
|
|
|
two spaces.
|
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
This method is primarily provided so the consuming application can
|
703
|
|
|
|
|
|
|
print the options that were used during a run, perhaps to a log or
|
704
|
|
|
|
|
|
|
in the output.
|
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
=cut
|
707
|
|
|
|
|
|
|
|
708
|
6
|
|
|
6
|
1
|
474
|
method options_as_string () {
|
|
6
|
|
|
|
|
13
|
|
|
6
|
|
|
|
|
12
|
|
709
|
6
|
|
|
|
|
12
|
my @options;
|
710
|
6
|
|
|
|
|
23
|
my $boolean = _get_boolean_options($Tk_opt_table);
|
711
|
|
|
|
|
|
|
|
712
|
6
|
|
|
|
|
92
|
foreach my $k ( sort keys $_opt_href->%* ) {
|
713
|
153
|
100
|
|
|
|
331
|
next if $k eq 'aliases';
|
714
|
150
|
100
|
|
|
|
254
|
next if $k eq 'cachedir';
|
715
|
144
|
100
|
|
|
|
231
|
next if $k eq 'profile';
|
716
|
138
|
|
|
|
|
232
|
my $v = $_opt_href->{$k};
|
717
|
138
|
100
|
|
|
|
244
|
next if not defined $v;
|
718
|
|
|
|
|
|
|
|
719
|
49
|
100
|
|
|
|
95
|
if ( $boolean->{$k} ) {
|
720
|
2
|
|
|
|
|
9
|
push @options, $DASH . $k;
|
721
|
2
|
|
|
|
|
6
|
next;
|
722
|
|
|
|
|
|
|
}
|
723
|
|
|
|
|
|
|
|
724
|
47
|
|
|
|
|
94
|
my $val = $v;
|
725
|
|
|
|
|
|
|
|
726
|
47
|
50
|
|
|
|
134
|
if ( $val =~ m{\A \s* \Z}xms ) {
|
727
|
0
|
|
|
|
|
0
|
$val = q(") . $val . q(");
|
728
|
|
|
|
|
|
|
}
|
729
|
47
|
|
|
|
|
130
|
push @options, $DASH . $k. $SPACE . $val;
|
730
|
|
|
|
|
|
|
}
|
731
|
6
|
|
|
|
|
77
|
return join $SPACE x 2, @options;
|
732
|
|
|
|
|
|
|
}
|
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
=head2 validate
|
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
Returns: @errors
|
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
This method is called by StationTable->set_options to make sure all
|
739
|
|
|
|
|
|
|
the options that were provided to B are valid. It also
|
740
|
|
|
|
|
|
|
handles abbreviations for options color and report. Any errors
|
741
|
|
|
|
|
|
|
arising from invalid value or from problems detected during
|
742
|
|
|
|
|
|
|
B (which is called at the end of B) are returned
|
743
|
|
|
|
|
|
|
in a list.
|
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
=cut
|
746
|
|
|
|
|
|
|
|
747
|
125
|
|
|
125
|
1
|
4622
|
method validate () {
|
|
125
|
|
|
|
|
207
|
|
|
125
|
|
|
|
|
192
|
|
748
|
125
|
|
|
|
|
225
|
my @errors;
|
749
|
125
|
|
|
|
|
210
|
my $bad_range_cnt = 0;
|
750
|
|
|
|
|
|
|
|
751
|
125
|
100
|
|
|
|
2392
|
if ( $_opt_obj->defined('aliases') ) {
|
752
|
10
|
|
|
|
|
273
|
foreach my $alias_name ( keys $_opt_obj->aliases->%* ) {
|
753
|
26
|
|
|
|
|
2178
|
my $errmsg = '*E* alias names in profile must be lowercase letters with optional underscore prefix: ' . $alias_name;
|
754
|
26
|
100
|
|
|
|
195
|
push @errors, $errmsg
|
755
|
|
|
|
|
|
|
unless $alias_name =~ $ALIAS_NAME_RE;
|
756
|
|
|
|
|
|
|
}
|
757
|
|
|
|
|
|
|
}
|
758
|
|
|
|
|
|
|
|
759
|
125
|
100
|
|
|
|
2577
|
if ( $_opt_obj->active ) {
|
760
|
24
|
100
|
|
|
|
709
|
if ( not $_opt_obj->active =~ m{ \A (18|19|20)\d\d [-] (18|19|20)\d\d }xms ) {
|
761
|
7
|
|
|
|
|
167
|
push @errors, '*E* invalid -active year range ' . $_opt_obj->active;
|
762
|
7
|
|
|
|
|
78
|
$bad_range_cnt++;
|
763
|
|
|
|
|
|
|
}
|
764
|
|
|
|
|
|
|
}
|
765
|
|
|
|
|
|
|
|
766
|
125
|
100
|
|
|
|
5184
|
if ( $_opt_obj->range ) {
|
767
|
33
|
100
|
|
|
|
863
|
if ( not $_opt_obj->range =~ m{ \A (18|19|20)\d\d [-,] (18|19|20)\d\d }xms ) {
|
768
|
7
|
|
|
|
|
175
|
push @errors, '*E* invalid -range ' . $_opt_obj->range;
|
769
|
7
|
|
|
|
|
79
|
$bad_range_cnt++;
|
770
|
|
|
|
|
|
|
}
|
771
|
|
|
|
|
|
|
}
|
772
|
|
|
|
|
|
|
|
773
|
125
|
100
|
100
|
|
|
4980
|
push @errors, '*E* invalid 2-character state or province code ' . $_opt_obj->state
|
774
|
|
|
|
|
|
|
if $_opt_obj->defined('state') and not $_opt_obj->state =~ m{ \A [[:alpha:]]{2} \Z }xms;
|
775
|
|
|
|
|
|
|
|
776
|
125
|
100
|
100
|
|
|
3641
|
push @errors, '*E* -partial only allowed if -active specified'
|
777
|
|
|
|
|
|
|
if $_opt_obj->partial and not $_opt_obj->defined('active');
|
778
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
# Note: full Condition Coverage in Devel::Cover seems impossible if these two ifs are combined
|
780
|
|
|
|
|
|
|
# (I tried every combination of uncoverable branch and condition I could think of to
|
781
|
|
|
|
|
|
|
# to suppress the missing case. In the end, this was the only thing that worked.)
|
782
|
125
|
100
|
100
|
|
|
5103
|
if ( $_opt_obj->range and $_opt_obj->active ) {
|
783
|
|
|
|
|
|
|
# uncoverable branch false
|
784
|
9
|
50
|
|
|
|
312
|
if ( $bad_range_cnt == 0 ) {
|
785
|
9
|
|
|
|
|
138
|
my $r = rng_new( $_opt_obj->range );
|
786
|
9
|
|
|
|
|
189
|
my $a = rng_new( $_opt_obj->active );
|
787
|
|
|
|
|
|
|
|
788
|
9
|
100
|
|
|
|
27
|
push @errors, '*E* -range must be a subset of -active'
|
789
|
|
|
|
|
|
|
if not $r->subset($a);
|
790
|
|
|
|
|
|
|
}
|
791
|
|
|
|
|
|
|
}
|
792
|
|
|
|
|
|
|
|
793
|
125
|
100
|
100
|
|
|
7526
|
push @errors, '*E* -gps argument must be decimal lat/long, separated by spaces or punctuation'
|
794
|
|
|
|
|
|
|
if $_opt_obj->gps and $_opt_obj->gps !~ m{ \A [+-]? \d{1,3} [.] \d+ (?: [[:punct:]] | \s+ ) [+-]? \d{1,3} [.] \d+ \Z }xms;
|
795
|
|
|
|
|
|
|
|
796
|
125
|
|
|
|
|
3912
|
my %report_abbrev = abbrev( @REPORT_TYPE_LIST );
|
797
|
|
|
|
|
|
|
|
798
|
125
|
|
|
|
|
28990
|
my $report = lc $_opt_obj->report;
|
799
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
# uncoverable branch true
|
801
|
125
|
50
|
|
|
|
3519
|
croak '*E* undef report type'
|
802
|
|
|
|
|
|
|
if not defined $report;
|
803
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
push @errors, '*E* invalid report option: ' . $report
|
805
|
125
|
100
|
100
|
|
|
411
|
if $report and not $report_abbrev{ $report };
|
806
|
|
|
|
|
|
|
|
807
|
125
|
|
|
|
|
2061
|
$_opt_obj->report = $report_abbrev{ $report };
|
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
|
810
|
125
|
|
|
|
|
1429
|
my %refresh_abbrev = abbrev( qw(yearly never always) );
|
811
|
|
|
|
|
|
|
|
812
|
125
|
|
|
|
|
14986
|
my $refresh = lc $_opt_obj->refresh;
|
813
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
# uncoverable branch true
|
815
|
125
|
50
|
|
|
|
2014
|
croak '*E* undef refresh option'
|
816
|
|
|
|
|
|
|
if not defined $refresh;
|
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
push @errors, '*E* invalid refresh option: ' . $refresh
|
819
|
125
|
50
|
33
|
|
|
612
|
if $refresh and not $refresh_abbrev{ $refresh };
|
820
|
|
|
|
|
|
|
|
821
|
125
|
|
|
|
|
2044
|
$_opt_obj->refresh = $refresh_abbrev{ $refresh };
|
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
#-----------------------------------------------------------------
|
824
|
|
|
|
|
|
|
# end of noted section
|
825
|
|
|
|
|
|
|
#-----------------------------------------------------------------
|
826
|
|
|
|
|
|
|
|
827
|
125
|
|
|
|
|
1354
|
my %color_abbrev = abbrev( qw(blue green azure purple red white yellow) );
|
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
# uncoverable branch false
|
830
|
125
|
50
|
|
|
|
26385
|
if ( $_opt_obj->defined('kmlcolor') ) {
|
831
|
125
|
|
|
|
|
2609
|
my $kmlcolor = $_opt_obj->kmlcolor;
|
832
|
125
|
100
|
|
|
|
3291
|
if ( $kmlcolor eq $EMPTY ) {
|
833
|
1
|
|
|
|
|
2
|
push @errors, '*E* invalid -kmlcolor value ""'
|
834
|
|
|
|
|
|
|
} else {
|
835
|
|
|
|
|
|
|
push @errors, '*E* invalid -kmlcolor value'
|
836
|
124
|
100
|
|
|
|
352
|
if not $color_abbrev{ $kmlcolor };
|
837
|
|
|
|
|
|
|
}
|
838
|
125
|
|
|
|
|
1968
|
$_opt_obj->kmlcolor = $color_abbrev{ $kmlcolor };
|
839
|
|
|
|
|
|
|
}
|
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
|
842
|
125
|
100
|
|
|
|
2962
|
if ( $_opt_obj->defined('fmonth') ) {
|
843
|
15
|
100
|
100
|
|
|
314
|
push @errors, '*E* -fmonth must be a single number or valid range spec (e.g. 1-5,9)'
|
844
|
|
|
|
|
|
|
if not rng_valid($_opt_obj->fmonth)
|
845
|
|
|
|
|
|
|
or not rng_within($_opt_obj->fmonth, '1-12');
|
846
|
|
|
|
|
|
|
}
|
847
|
|
|
|
|
|
|
|
848
|
125
|
100
|
|
|
|
8842
|
if ( $_opt_obj->defined('fday') ) {
|
849
|
15
|
100
|
100
|
|
|
303
|
push @errors, '*E* -fday must be a single number or valid range spec (e.g. 3,15,20-31)'
|
850
|
|
|
|
|
|
|
if not rng_valid($_opt_obj->fday)
|
851
|
|
|
|
|
|
|
or not rng_within($_opt_obj->fday, '1-31');
|
852
|
|
|
|
|
|
|
}
|
853
|
|
|
|
|
|
|
|
854
|
125
|
|
|
|
|
7195
|
my @init_errors = $self->initialize();
|
855
|
|
|
|
|
|
|
|
856
|
125
|
|
|
|
|
1828
|
return (@errors, @init_errors);
|
857
|
|
|
|
|
|
|
}
|
858
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
=head2 DOES
|
860
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
Defined by Object::Pad. Included for POD::Coverage.
|
862
|
|
|
|
|
|
|
|
863
|
|
|
|
|
|
|
=head2 META
|
864
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
Defined by Object::Pad. Included for POD::Coverage.
|
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
=cut
|
868
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
######################################################################
|
870
|
|
|
|
|
|
|
# Subroutines
|
871
|
|
|
|
|
|
|
######################################################################
|
872
|
|
|
|
|
|
|
|
873
|
7
|
|
|
7
|
|
18
|
sub _get_boolean_options ($_tk_opt_aref) {
|
|
7
|
|
|
|
|
18
|
|
|
7
|
|
|
|
|
14
|
|
874
|
|
|
|
|
|
|
|
875
|
7
|
|
|
|
|
12
|
my %boolean;
|
876
|
|
|
|
|
|
|
|
877
|
7
|
|
|
|
|
22
|
foreach my $row ( $_tk_opt_aref->@* ) {
|
878
|
231
|
100
|
|
|
|
444
|
next unless ref $row eq 'ARRAY';
|
879
|
196
|
|
|
|
|
437
|
my ($name, $type) = $row->@*;
|
880
|
196
|
100
|
|
|
|
423
|
$boolean{$name}++ if $type eq $BANG;
|
881
|
|
|
|
|
|
|
}
|
882
|
|
|
|
|
|
|
|
883
|
7
|
|
|
|
|
25
|
return \%boolean;
|
884
|
|
|
|
|
|
|
}
|
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
1; |