Annotation of todotxt/Text-Todo/bin/todo.pl, Revision 1.10
1.1 andrew 1: #!/usr/bin/perl
1.10 ! andrew 2: # $RedRiver: todo.pl,v 1.9 2010/01/11 00:17:38 andrew Exp $
1.1 andrew 3: ########################################################################
4: # todo.pl *** a perl version of todo.sh. Uses Text::Todo.
5: #
6: # 2010.01.07 #*#*# andrew fresh <andrew@cpan.org>
7: ########################################################################
8: # Copyright 2010 Andrew Fresh, all rights reserved
9: #
10: # This program is free software; you can redistribute it and/or modify
11: # it under the same terms as Perl itself.
12: ########################################################################
13: use strict;
14: use warnings;
15:
16: use Data::Dumper;
1.2 andrew 17:
18: use Getopt::Std;
1.1 andrew 19: use Text::Todo;
20:
21: use version; our $VERSION = qv('0.0.1');
22:
1.2 andrew 23: # option defaults
24: my $config_file = $ENV{HOME} . '/todo.cfg';
1.3 andrew 25: CONFIG: foreach my $f ( $config_file, $ENV{HOME} . '/.todo.cfg', ) {
26: if ( -e $f ) {
27: $config_file = $f;
28: last CONFIG;
29: }
30: }
1.2 andrew 31:
32: my %actions = (
1.3 andrew 33: add => \&add,
34: addto => \&addto,
35: append => \&append,
36: archive => \&archive,
37: command => \&command,
38: del => \&del,
39: depri => \&depri,
40: do => \&mark_done,
41: help => \&help,
1.2 andrew 42: list => \&list,
1.3 andrew 43: listall => \&listall,
44: listcon => \&listcon,
45: listfile => \&listfile,
46: listpri => \&listpri,
47: listproj => \&listproj,
48: move => \&move,
49: prepend => \&prepend,
50: pri => \&pri,
51: replace => \&replace,
52: report => \&report,
1.2 andrew 53: );
54:
55: my %aliases = (
56: a => 'add',
57: app => 'append',
58: rm => 'del',
59: dp => 'depri',
60: ls => 'list',
61: lsa => 'listall',
62: lsc => 'listcon',
63: lf => 'listfile',
1.3 andrew 64: lsp => 'listpri',
1.2 andrew 65: lsprj => 'listproj',
66: mv => 'move',
67: prep => 'prepend',
68: p => 'pri',
69: );
70:
71: my %opts;
72: getopts( '@+d:fhpPntvV', \%opts );
73:
74: my $action = shift @ARGV;
75: if ( $action && $action eq 'command' ) {
76:
77: # We don't support action scripts so . . .
78: $action = shift @ARGV;
79: }
80: if ( $action && exists $aliases{$action} ) {
81: $action = $aliases{$action};
82: }
83:
84: if ( $opts{h} || !$action ) {
85: usage( $opts{h} );
86: }
87:
1.6 andrew 88: my @unsupported = grep { defined $opts{$_} } qw( @ + f h p P t v V );
1.2 andrew 89: if (@unsupported) {
1.3 andrew 90: warn 'Unsupported options: ' . ( join q{, }, @unsupported ) . "\n";
1.2 andrew 91: }
92:
93: if ( $opts{d} ) {
94: $config_file = $opts{d};
95: }
96:
97: if ( exists $actions{$action} ) {
98: my $config = read_config($config_file);
99: my $action = $actions{$action}->( $config, @ARGV );
100: }
101: else {
102: usage();
103: }
104:
1.3 andrew 105: sub add {
1.7 andrew 106: my ( $config, @entry ) = @_;
107: if ( !@entry ) {
1.3 andrew 108: die "usage: todo.pl add 'item'\n";
109: }
110:
1.7 andrew 111: my $entry = join q{ }, @entry;
112:
1.3 andrew 113: my $todo = Text::Todo->new($config);
114: if ( $todo->add($entry) ) {
115: my @list = $todo->list;
116: my $lines = scalar @list;
117:
118: print "TODO: '$entry' added on line $lines\n";
119:
120: return $lines;
121: }
122: die "Unable to add [$entry]\n";
123: }
124:
125: sub addto {
1.7 andrew 126: my ( $config, $file, @entry ) = @_;
127: if ( !( $file && @entry ) ) {
1.3 andrew 128: die "usage: todo.pl addto DEST 'TODO ITEM'\n";
129: }
130:
1.7 andrew 131: my $entry = join q{ }, @entry;
132:
1.3 andrew 133: my $todo = Text::Todo->new($config);
134:
135: $file = $todo->file($file);
136: if ( $todo->addto( $file, $entry ) ) {
137: my @list = $todo->listfile($file);
138: my $lines = scalar @list;
139:
140: print "TODO: '$entry' added to $file on line $lines\n";
141:
142: return $lines;
143: }
144: die "Unable to add [$entry]\n";
145: }
146:
1.4 andrew 147: sub append {
1.9 andrew 148: my ( $config, $line, @text ) = @_;
1.7 andrew 149: if ( !( $line && @text && $line =~ /^\d+$/xms ) ) {
1.4 andrew 150: die 'usage: todo.pl append ITEM# "TEXT TO APPEND"' . "\n";
151: }
1.7 andrew 152:
153: my $text = join q{ }, @text;
1.4 andrew 154:
155: my $todo = Text::Todo->new($config);
156: my $entry = $todo->list->[ $line - 1 ];
157:
158: if ( $entry->append($text) && $todo->save ) {
159: return printf "%02d: %s\n", $line, $entry->text;
160: }
161: die "Unable to append\n";
162: }
163:
1.9 andrew 164: sub archive {
165: my ($config) = @_;
1.5 andrew 166: my $todo = Text::Todo->new($config);
1.9 andrew 167:
1.5 andrew 168: my $file = $todo->file;
169:
170: my $archived = $todo->archive;
1.9 andrew 171: if ( defined $archived ) {
1.5 andrew 172: return print "TODO: $file archived.\n";
173: }
174: die "Unable to archive $file\n";
175: }
176:
1.9 andrew 177: sub command { return &unsupported }
1.6 andrew 178:
1.9 andrew 179: sub del {
1.6 andrew 180: my ( $config, $line ) = @_;
181: if ( !( $line && $line =~ /^\d+$/xms ) ) {
182: die 'usage: todo.pl del ITEM#' . "\n";
183: }
184: my $todo = Text::Todo->new($config);
1.9 andrew 185:
1.10 ! andrew 186: my $entry = $todo->list->[ $line - 1 ];
1.6 andrew 187: print "Delete '" . $entry->text . "'? (y/n)\n";
188: warn "XXX No delete confirmation currently!\n";
189:
1.9 andrew 190: if ( $opts{n} ) {
191: if ( $todo->del($entry) && $todo->save ) {
1.6 andrew 192: return print 'TODO: \'', $entry->text, "' deleted.\n";
193: }
194: }
195: else {
196: my $text = $entry->text;
1.9 andrew 197: if ( $entry->replace(q{}) && $todo->save ) {
1.6 andrew 198: return print 'TODO: \'', $text, "' deleted.\n";
199: }
200: }
201:
202: die "Unable to delete entry\n";
203: }
204:
1.9 andrew 205: sub depri {
206: my ( $config, $line ) = @_;
207: if ( !( $line && $line =~ /^\d+$/xms ) ) {
208: die 'usage: todo.pl del ITEM#' . "\n";
209: }
210: my $todo = Text::Todo->new($config);
211:
212: my $entry = $todo->list->[ $line - 1 ];
213: if ( $entry->depri && $todo->save ) {
214: return print $line, ': ', $entry->text, "\n",
215: 'TODO: ', $line, " deprioritized.\n";
216: }
217: die "Unable to deprioritize entry\n";
218: }
219:
1.3 andrew 220: sub mark_done { return &unsupported }
221: sub help { return &unsupported }
222:
1.2 andrew 223: sub list {
1.3 andrew 224: my ( $config, $term ) = @_;
225: my $todo = Text::Todo->new($config);
226:
227: my @list = _number_list( $todo->list );
228: my $shown = _show_sorted_list( $term, @list );
229:
230: return _show_list_footer( $shown, scalar @list, $config->{todo_file} );
231: }
232:
233: sub listall {
234: my ( $config, $term ) = @_;
235: my $todo = Text::Todo->new($config);
236:
237: my @list = _number_list(
238: $todo->listfile('todo_file'),
239: $todo->listfile('done_file'),
240: );
241: my $shown = _show_sorted_list( $term, @list );
242:
243: return _show_list_footer( $shown, scalar @list, $config->{'todo_dir'} );
244: }
245:
246: sub listcon {
1.2 andrew 247: my ($config) = @_;
248: my $todo = Text::Todo->new($config);
1.3 andrew 249: return print map {"\@$_\n"} $todo->listcon;
250: }
1.2 andrew 251:
1.3 andrew 252: sub listfile {
253: my ( $config, $file, $term ) = @_;
254: if ( !$file ) {
255: die "usage: todo.pl listfile SRC [TERM]\n";
1.2 andrew 256: }
1.3 andrew 257: my $todo = Text::Todo->new($config);
258:
259: my @list = _number_list( $todo->listfile($file) );
260: my $shown = _show_sorted_list( $term, @list );
261:
262: return _show_list_footer( $shown, scalar @list, $file );
263: }
264:
265: sub listpri {
266: my ( $config, $pri ) = @_;
267:
268: my $todo = Text::Todo->new($config);
269:
270: my @list = _number_list( $todo->listfile('todo_file') );
271: my @pri_list;
272: if ($pri) {
273: $pri = uc $pri;
274: if ( $pri !~ /^[A-Z]$/xms ) {
275: die "usage: todo.pl listpri PRIORITY\n",
276: "note: PRIORITY must a single letter from A to Z.\n";
277: }
278: @pri_list = grep {
279: defined $_->{entry}->priority
280: && $_->{entry}->priority eq $pri
281: } @list;
282: }
283: else {
284: @pri_list = grep { $_->{entry}->priority } @list;
285: }
286:
287: my $shown = _show_sorted_list( undef, @pri_list );
288:
289: return _show_list_footer( $shown, scalar @list, $config->{todo_file} );
290: }
291:
292: sub listproj {
293: my ($config) = @_;
294: my $todo = Text::Todo->new($config);
295: return print map {"\+$_\n"} $todo->listproj;
296: }
297:
1.10 ! andrew 298: sub move { return &unsupported }
1.8 andrew 299:
300: sub prepend {
1.10 ! andrew 301: my ( $config, $line, @text ) = @_;
1.8 andrew 302: if ( !( $line && @text && $line =~ /^\d+$/xms ) ) {
1.9 andrew 303: die 'usage: todo.pl prepend ITEM# "TEXT TO PREPEND"' . "\n";
1.8 andrew 304: }
305:
306: my $text = join q{ }, @text;
307:
308: my $todo = Text::Todo->new($config);
309: my $entry = $todo->list->[ $line - 1 ];
310:
311: if ( $entry->prepend($text) && $todo->save ) {
312: return printf "%02d: %s\n", $line, $entry->text;
313: }
1.9 andrew 314: die "Unable to prepend\n";
1.8 andrew 315: }
316:
1.3 andrew 317: sub pri { return &unsupported }
318: sub replace { return &unsupported }
319: sub report { return &unsupported }
320:
321: sub _number_list {
322: my (@list) = @_;
323:
324: my $line = 1;
325: return map { { line => $line++, entry => $_, } } @list;
326: }
327:
328: sub _show_sorted_list {
329: my ( $term, @list ) = @_;
330: $term = defined $term ? quotemeta($term) : '';
331:
332: my $shown = 0;
1.10 ! andrew 333: my @sorted = map { sprintf "%02d %s", $_->{line}, $_->{entry}->text }
1.4 andrew 334: sort { lc $a->{entry}->text cmp lc $b->{entry}->text } @list;
335:
336: foreach my $line ( grep {/$term/xms} @sorted ) {
337: print $line, "\n";
1.3 andrew 338: $shown++;
339: }
340:
341: return $shown;
342: }
343:
344: sub _show_list_footer {
345: my ( $shown, $total, $file ) = @_;
346:
347: $shown ||= 0;
348: $total ||= 0;
349:
350: print "-- \n";
351: print "TODO: $shown of $total tasks shown from $file\n";
352:
353: return 1;
1.2 andrew 354: }
355:
356: sub unsupported { die "Unsupported action\n" }
357:
358: sub usage {
359: my ($long) = @_;
360:
361: print <<'EOL';
362: * command list taken from todo.sh for compatibility
363: Usage: todo.pl [-fhpantvV] [-d todo_config] action
364: EOL
365:
366: if ($long) {
367: print <<'EOL';
1.3 andrew 368:
1.2 andrew 369: Actions:
370: add|a "THING I NEED TO DO +project @context"
371: addto DEST "TEXT TO ADD"
372: append|app NUMBER "TEXT TO APPEND"
373: archive
374: command [ACTIONS]
375: del|rm NUMBER [TERM]
376: dp|depri NUMBER
377: do NUMBER
378: help
379: list|ls [TERM...]
380: listall|lsa [TERM...]
381: listcon|lsc
382: listfile|lf SRC [TERM...]
383: listpri|lsp [PRIORITY]
384: listproj|lsprj
385: move|mv NUMBER DEST [SRC]
386: prepend|prep NUMBER "TEXT TO PREPEND"
387: pri|p NUMBER PRIORITY
388: replace NUMBER "UPDATED TODO"
389: report
390: EOL
391: }
392: else {
393: print <<'EOL';
394: Try 'todo.pl -h' for more information.
395: EOL
396: }
397:
398: exit;
399: }
400:
401: sub read_config {
402: my ($file) = @_;
403:
404: my %config;
1.9 andrew 405: open my $fh, '<', $file or die "Unable to open [$file] : $!";
1.2 andrew 406: LINE: while (<$fh>) {
407: s/\r?\n$//xms;
408: s/\s*\#.*$//xms;
409: next LINE unless $_;
410:
411: if (s/^\s*export\s+//xms) {
412: my ( $key, $value ) = /^([^=]+)\s*=\s*"?(.*?)"?\s*$/xms;
413: if ($key) {
414: foreach my $k ( keys %config ) {
415: $value =~ s/\$\Q$k\E/$config{$k}/gxms;
416: $value =~ s/\${\Q$k\E}/$config{$k}/gxms;
417: }
418: foreach my $k ( keys %ENV ) {
419: $value =~ s/\$\Q$k\E/$ENV{$k}/gxms;
420: $value =~ s/\${\Q$k\E}/$ENV{$k}/gxms;
421: }
422: $value =~ s/\$\w+//gxms;
423: $value =~ s/\${\w+}//gxms;
424:
425: $config{$key} = $value;
426: }
427: }
428: }
429: close $fh;
1.1 andrew 430:
1.2 andrew 431: my %lc_config;
432: foreach my $k ( keys %config ) {
433: $lc_config{ lc($k) } = $config{$k};
434: }
1.1 andrew 435:
1.2 andrew 436: return \%lc_config;
1.1 andrew 437: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to todo.pl CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / todotxt / Text-Todo / bin