File Coverage

bin/wrt-ls
Criterion Covered Total %
statement 50 55 90.9
branch 13 20 65.0
condition n/a
subroutine 12 14 85.7
pod n/a
total 75 89 84.2


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;