1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
package My::Journal::Command::Entry;
use base qw( CLI::Framework::Command );
use strict;
use warnings;
#-------
sub usage_text {
q{
entry [--date=yyyy-mm-dd] [subcommands...]
OPTIONS
--date=yyyy-mm-dd: set date that entry appiles to
ARGUMENTS (subcommands)
add: add an entry
remove: remove an entry
modify: modify an entry
search: search for entries by regex; show summary
print: display full text of entries
}
}
sub option_spec {
return unless ref $_[0] eq __PACKAGE__; # non-inheritable behavior
(
[ 'date=s' => 'date that entry applies to' ],
)
}
sub subcommand_alias {
return unless ref $_[0] eq __PACKAGE__; # non-inheritable behavior
(
a => 'add',
s => 'search',
p => 'print',
rm => 'remove',
del => 'remove',
rem => 'remove',
m => 'modify',
mod => 'modify',
)
}
sub validate {
my ($self, $opts, @args) = @_;
return unless ref $_[0] eq __PACKAGE__; # non-inheritable behavior
# ...
}
sub notify_master {
my ($self, $subcommand, $opts, @args ) = @_;
return unless ref $_[0] eq __PACKAGE__; # non-inheritable behavior
# ...
}
#-------
#
# Inline subcommand example...
#
# NOTE that the 'search' subcommand is defined inline in the same package
# file as its master commnd, 'entry.'
#
# This is supported as an alternative to defining the subcommand in its
# own separate package file.
#
package My::Journal::Command::Entry::Search;
use base qw( My::Journal::Command::Entry );
use strict;
use warnings;
sub usage_text {
q{
entry search --regex=<regex> [--tag=<tag>]: search for journal entries
}
}
sub option_spec {
[ 'regex=s' => 'regex' ],
[ 'tag=s@' => 'tag' ],
}
sub validate {
my ($self, $opts, @args) = @_;
die "missing required option 'regex'\n" unless $opts->{regex};
}
sub run {
my ($self, $opts, @args) = @_;
my $regex = $opts->{regex};
my $tags = $opts->{tag};
my $r = eval { qr/$regex/ };
$r ||= qr/.*/;
warn "searching...\n" if $self->cache->get('verbose');
my $db = $self->cache->get('db'); # model class object
# Show a brief summary of truncated entries with their ids...
my @entries;
if( defined $tags ) {
for my $tag ( @$tags ) {
push @entries, $db->entries_by_tag($tag);
}
}
else {
@entries = $db->all_entries();
}
my $matching;
for my $entry (@entries) {
if( $entry->{entry_text} =~ /$r/m ) {
my $id = $entry->{id};
my $entry_summary = sprintf "%10d: %s",
$id, substr( $entry->{entry_text}, 0, 80 );
$matching->{$id} = $entry_summary;
}
}
return join "\n", values %$matching;
}
#-------
1;
__END__
=pod
=head1 NAME
My::Journal::Command::Entry - Command to work with journal entries
=head2 My::Journal::Command::Entry::Search
Subcommand to search for journal entries
=cut
|
