line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/bin/env perl |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# TODO: |
4
|
|
|
|
|
|
|
# |
5
|
|
|
|
|
|
|
# Ideally, this would be able to handle the following gracefully: |
6
|
|
|
|
|
|
|
# |
7
|
|
|
|
|
|
|
# wrt ls 2016 # all entries for 2016 |
8
|
|
|
|
|
|
|
# wrt ls 2016/4 # all entries for April 2016 |
9
|
|
|
|
|
|
|
# wrt ls 2016/4/1 # everything for April 1, 2016 |
10
|
|
|
|
|
|
|
# |
11
|
|
|
|
|
|
|
# ...but I think doing that right requires a much cleaner separation of how |
12
|
|
|
|
|
|
|
# entries are _structured_ from how they're _displayed_, probably by moving |
13
|
|
|
|
|
|
|
# more operations into WRT::EntryStore. |
14
|
|
|
|
|
|
|
# |
15
|
|
|
|
|
|
|
# It makes some sense that wrt-ls would just expose the interface of |
16
|
|
|
|
|
|
|
# EntryStore in a relatively safe way, including the operations that find |
17
|
|
|
|
|
|
|
# things by depth, locate the next/previous entry, etc. All of these could |
18
|
|
|
|
|
|
|
# be useful in scripting and publishing pipelines. |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
=pod |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 NAME |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
wrt-ls - list |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
=head1 USAGE |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
wrt ls # all entries |
29
|
|
|
|
|
|
|
wrt ls --days # entries for individual days |
30
|
|
|
|
|
|
|
wrt ls --months # entries for individual months |
31
|
|
|
|
|
|
|
wrt ls --years # entries for years |
32
|
|
|
|
|
|
|
wrt ls --props # all properties |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# Display help: |
35
|
|
|
|
|
|
|
wrt ls --help |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# Specify a different config file: |
38
|
|
|
|
|
|
|
wrt ls --config ./wrt.json ... |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
=head1 DESCRIPTION |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
Lists entries in the current wrt archive. |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
This interface is experimental and subject to revision in upcoming releases. |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
Detailed documentation can be found in the L man page or at |
47
|
|
|
|
|
|
|
L. |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
=head1 LICENSE |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
wrt is free software; you can redistribute it and/or modify |
52
|
|
|
|
|
|
|
it under the terms of the GNU General Public License as published by |
53
|
|
|
|
|
|
|
the Free Software Foundation; either version 2 of the License, or |
54
|
|
|
|
|
|
|
(at your option) any later version. |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
=head1 AUTHOR |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
Brennen Bearnes |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
=cut |
61
|
|
|
|
|
|
|
|
62
|
1
|
|
|
1
|
|
587
|
use 5.10.0; |
|
1
|
|
|
|
|
4
|
|
63
|
|
|
|
|
|
|
|
64
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
19
|
|
65
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
26
|
|
66
|
|
|
|
|
|
|
|
67
|
1
|
|
|
1
|
|
730
|
use Getopt::Long qw(GetOptionsFromArray); |
|
1
|
|
|
|
|
10818
|
|
|
1
|
|
|
|
|
4
|
|
68
|
1
|
|
|
1
|
|
686
|
use Pod::Usage; |
|
1
|
|
|
|
|
38871
|
|
|
1
|
|
|
|
|
135
|
|
69
|
1
|
|
|
1
|
|
519
|
use App::WRT; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
37
|
|
70
|
1
|
|
|
1
|
|
8
|
use Carp; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
474
|
|
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
# If invoked directly from the command-line, caller() will return undef. |
73
|
|
|
|
|
|
|
# Execute main() with a callback to print output directly, and a copy of |
74
|
|
|
|
|
|
|
# our real @ARGV: |
75
|
|
|
|
|
|
|
if (not caller()) { |
76
|
|
|
|
|
|
|
my $output = sub { say @_; }; |
77
|
|
|
|
|
|
|
main($output, @ARGV); |
78
|
|
|
|
|
|
|
exit(0); |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
# main() takes an output callback and an @ARGV to pass in to |
82
|
|
|
|
|
|
|
# GetOptionsFromArray(). This allows relatively simple integration |
83
|
|
|
|
|
|
|
# tests to be written. See also: t/bin-wrt-ls.t |
84
|
|
|
|
|
|
|
sub main { |
85
|
5
|
|
|
5
|
|
2461
|
my ($output, @local_argv) = @_; |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
# Handle options, including help generated from the POD above. See: |
88
|
|
|
|
|
|
|
# - http://perldoc.perl.org/Getopt/Long.html#User-defined-subroutines-to-handle-options |
89
|
|
|
|
|
|
|
# - https://metacpan.org/pod/Pod::Usage |
90
|
|
|
|
|
|
|
# - http://michael.thegrebs.com/2014/06/08/Pod-Usage/ |
91
|
5
|
|
|
|
|
10
|
my $config_file = 'wrt.json'; |
92
|
5
|
|
|
|
|
6
|
my $with_titles = 0; |
93
|
|
|
|
|
|
|
|
94
|
5
|
|
|
|
|
7
|
my $list_days = 0; |
95
|
5
|
|
|
|
|
6
|
my $list_months = 0; |
96
|
5
|
|
|
|
|
7
|
my $list_years = 0; |
97
|
5
|
|
|
|
|
5
|
my $list_props = 0; |
98
|
5
|
|
|
|
|
7
|
my $list_all = 1; |
99
|
|
|
|
|
|
|
GetOptionsFromArray( |
100
|
|
|
|
|
|
|
\@local_argv, |
101
|
|
|
|
|
|
|
'config=s' => \$config_file, |
102
|
0
|
|
|
0
|
|
0
|
help => sub { pod2usage(0) }, |
103
|
5
|
50
|
|
|
|
37
|
days => \$list_days, |
104
|
|
|
|
|
|
|
months => \$list_months, |
105
|
|
|
|
|
|
|
years => \$list_years, |
106
|
|
|
|
|
|
|
props => \$list_props, |
107
|
|
|
|
|
|
|
'with-titles' => \$with_titles, |
108
|
|
|
|
|
|
|
) or pod2usage(2); |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
# Allow only one of --days, --months, --years, --props. Default to listing |
111
|
|
|
|
|
|
|
# all entries if none of these are specified. |
112
|
5
|
|
|
|
|
3022
|
my $option_count = 0; |
113
|
5
|
|
|
|
|
14
|
foreach ($list_days, $list_months, $list_years, $list_props) { |
114
|
20
|
|
|
|
|
24
|
$option_count += $_; |
115
|
|
|
|
|
|
|
} |
116
|
5
|
100
|
|
|
|
15
|
if ($option_count > 1) { |
|
|
50
|
|
|
|
|
|
117
|
1
|
|
|
|
|
249
|
croak("Please specify at most one of --days, --months, --years, --props."); |
118
|
|
|
|
|
|
|
} elsif ($option_count == 1) { |
119
|
4
|
|
|
|
|
6
|
$list_all = 0; |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
|
122
|
4
|
50
|
|
|
|
75
|
unless (-e $config_file) { |
123
|
0
|
|
|
|
|
0
|
croak("No wrt config file found. Tried: $config_file"); |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
4
|
|
|
|
|
21
|
my $w = App::WRT::new_from_file($config_file); |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
# Define the function that'll return the base list of entries to match |
129
|
|
|
|
|
|
|
# against: |
130
|
4
|
|
|
|
|
13
|
my $base_list; |
131
|
4
|
100
|
|
|
|
18
|
if ($list_days) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
132
|
1
|
|
|
1
|
|
7
|
$base_list = sub { $w->{entries}->all_days(); }; |
|
1
|
|
|
|
|
4
|
|
133
|
|
|
|
|
|
|
} elsif ($list_months) { |
134
|
1
|
|
|
1
|
|
6
|
$base_list = sub { $w->{entries}->all_months(); }; |
|
1
|
|
|
|
|
4
|
|
135
|
|
|
|
|
|
|
} elsif ($list_years) { |
136
|
1
|
|
|
1
|
|
6
|
$base_list = sub { $w->{entries}->all_years(); }; |
|
1
|
|
|
|
|
4
|
|
137
|
|
|
|
|
|
|
} elsif ($list_props) { |
138
|
1
|
|
|
1
|
|
6
|
$base_list = sub { $w->{entries}->all_props(); }; |
|
1
|
|
|
|
|
5
|
|
139
|
|
|
|
|
|
|
} elsif ($list_all) { |
140
|
0
|
|
|
0
|
|
0
|
$base_list = sub { $w->{entries}->all(); }; |
|
0
|
|
|
|
|
0
|
|
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
|
143
|
4
|
|
|
|
|
9
|
foreach my $entry ($base_list->()) { |
144
|
|
|
|
|
|
|
# When invoked from command line, this will normally be a simple |
145
|
|
|
|
|
|
|
# routine that does `say $entry`. Under testing, it may instead |
146
|
|
|
|
|
|
|
# accumulate output for checking elsewhere. |
147
|
|
|
|
|
|
|
|
148
|
16
|
50
|
|
|
|
41
|
if ($with_titles) { |
149
|
0
|
|
|
|
|
0
|
$output->($entry . "\t" . $w->get_title($entry)); |
150
|
|
|
|
|
|
|
} else { |
151
|
16
|
|
|
|
|
30
|
$output->($entry); |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
1; |