Annotation of todotxt/Text-Todo/bin/todo.pl, Revision 1.16
1.1 andrew 1: #!/usr/bin/perl
1.16 ! andrew 2: # $AFresh1: todo.pl,v 1.15 2010/01/12 20:30:55 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;
1.15 andrew 72: getopts( q{+d:fhpPntvV@}, \%opts );
1.2 andrew 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);
1.16 ! andrew 99: my $result = $actions{$action}->( $config, @ARGV );
1.2 andrew 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.15 andrew 177: ## no critic 'sigal'
1.9 andrew 178: sub command { return &unsupported }
1.15 andrew 179: ## use critic
1.6 andrew 180:
1.9 andrew 181: sub del {
1.6 andrew 182: my ( $config, $line ) = @_;
183: if ( !( $line && $line =~ /^\d+$/xms ) ) {
184: die 'usage: todo.pl del ITEM#' . "\n";
185: }
186: my $todo = Text::Todo->new($config);
1.9 andrew 187:
1.10 andrew 188: my $entry = $todo->list->[ $line - 1 ];
1.15 andrew 189: print 'Delete \'', $entry->text . "'? (y/n)\n";
1.6 andrew 190: warn "XXX No delete confirmation currently!\n";
191:
1.9 andrew 192: if ( $opts{n} ) {
193: if ( $todo->del($entry) && $todo->save ) {
1.6 andrew 194: return print 'TODO: \'', $entry->text, "' deleted.\n";
195: }
196: }
197: else {
198: my $text = $entry->text;
1.9 andrew 199: if ( $entry->replace(q{}) && $todo->save ) {
1.6 andrew 200: return print 'TODO: \'', $text, "' deleted.\n";
201: }
202: }
203:
204: die "Unable to delete entry\n";
205: }
206:
1.9 andrew 207: sub depri {
208: my ( $config, $line ) = @_;
209: if ( !( $line && $line =~ /^\d+$/xms ) ) {
1.11 andrew 210: die 'usage: todo.pl depri ITEM#' . "\n";
1.9 andrew 211: }
212: my $todo = Text::Todo->new($config);
213:
214: my $entry = $todo->list->[ $line - 1 ];
215: if ( $entry->depri && $todo->save ) {
216: return print $line, ': ', $entry->text, "\n",
217: 'TODO: ', $line, " deprioritized.\n";
218: }
219: die "Unable to deprioritize entry\n";
220: }
221:
1.12 andrew 222: # since "do" is reserved
1.15 andrew 223: sub mark_done {
1.12 andrew 224: my ( $config, $line ) = @_;
225: if ( !( $line && $line =~ /^\d+$/xms ) ) {
226: die 'usage: todo.pl del ITEM#' . "\n";
227: }
228: my $todo = Text::Todo->new($config);
229:
230: my $entry = $todo->list->[ $line - 1 ];
231:
232: if ( $entry->do && $todo->save ) {
233: my $status = print $line, ': ', $entry->text, "\n",
234: 'TODO: ', $line, " marked as done.\n";
1.15 andrew 235: if ( !$opts{a} ) {
1.12 andrew 236: return archive($config);
237: }
238: return $status;
239: }
240: die "Unable to mark as done\n";
241: }
242:
1.15 andrew 243: ## no critic 'sigal'
244: sub help { return &unsupported }
245: ## use critic
1.3 andrew 246:
1.2 andrew 247: sub list {
1.3 andrew 248: my ( $config, $term ) = @_;
249: my $todo = Text::Todo->new($config);
250:
251: my @list = _number_list( $todo->list );
252: my $shown = _show_sorted_list( $term, @list );
253:
254: return _show_list_footer( $shown, scalar @list, $config->{todo_file} );
255: }
256:
257: sub listall {
258: my ( $config, $term ) = @_;
259: my $todo = Text::Todo->new($config);
260:
261: my @list = _number_list(
262: $todo->listfile('todo_file'),
263: $todo->listfile('done_file'),
264: );
265: my $shown = _show_sorted_list( $term, @list );
266:
267: return _show_list_footer( $shown, scalar @list, $config->{'todo_dir'} );
268: }
269:
270: sub listcon {
1.2 andrew 271: my ($config) = @_;
272: my $todo = Text::Todo->new($config);
1.3 andrew 273: return print map {"\@$_\n"} $todo->listcon;
274: }
1.2 andrew 275:
1.3 andrew 276: sub listfile {
277: my ( $config, $file, $term ) = @_;
278: if ( !$file ) {
279: die "usage: todo.pl listfile SRC [TERM]\n";
1.2 andrew 280: }
1.3 andrew 281: my $todo = Text::Todo->new($config);
282:
283: my @list = _number_list( $todo->listfile($file) );
284: my $shown = _show_sorted_list( $term, @list );
285:
286: return _show_list_footer( $shown, scalar @list, $file );
287: }
288:
289: sub listpri {
290: my ( $config, $pri ) = @_;
291:
292: my $todo = Text::Todo->new($config);
293:
294: my @list = _number_list( $todo->listfile('todo_file') );
295: my @pri_list;
296: if ($pri) {
297: $pri = uc $pri;
1.16 ! andrew 298: if ( $pri !~ /^[[:upper:]]$/xms ) {
1.3 andrew 299: die "usage: todo.pl listpri PRIORITY\n",
300: "note: PRIORITY must a single letter from A to Z.\n";
301: }
302: @pri_list = grep {
303: defined $_->{entry}->priority
304: && $_->{entry}->priority eq $pri
305: } @list;
306: }
307: else {
308: @pri_list = grep { $_->{entry}->priority } @list;
309: }
310:
311: my $shown = _show_sorted_list( undef, @pri_list );
312:
313: return _show_list_footer( $shown, scalar @list, $config->{todo_file} );
314: }
315:
316: sub listproj {
317: my ($config) = @_;
318: my $todo = Text::Todo->new($config);
319: return print map {"\+$_\n"} $todo->listproj;
320: }
321:
1.15 andrew 322: ## no critic 'sigal'
1.10 andrew 323: sub move { return &unsupported }
1.15 andrew 324: ## use critic
1.8 andrew 325:
326: sub prepend {
1.10 andrew 327: my ( $config, $line, @text ) = @_;
1.8 andrew 328: if ( !( $line && @text && $line =~ /^\d+$/xms ) ) {
1.9 andrew 329: die 'usage: todo.pl prepend ITEM# "TEXT TO PREPEND"' . "\n";
1.8 andrew 330: }
331:
332: my $text = join q{ }, @text;
333:
334: my $todo = Text::Todo->new($config);
335: my $entry = $todo->list->[ $line - 1 ];
336:
337: if ( $entry->prepend($text) && $todo->save ) {
338: return printf "%02d: %s\n", $line, $entry->text;
339: }
1.9 andrew 340: die "Unable to prepend\n";
1.8 andrew 341: }
342:
1.11 andrew 343: sub pri {
344: my ( $config, $line, $priority ) = @_;
345: my $error = 'usage: todo.pl pri ITEM# PRIORITY';
346: if ( !( $line && $line =~ /^\d+$/xms && $priority ) ) {
1.15 andrew 347: die "$error\n";
1.11 andrew 348: }
1.16 ! andrew 349: elsif ( $priority !~ /^[[:upper:]]$/xms ) {
1.15 andrew 350: $error .= "\n" . 'note: PRIORITY must a single letter from A to Z.';
351: die "$error\n";
1.11 andrew 352: }
353:
354: my $todo = Text::Todo->new($config);
355:
356: my $entry = $todo->list->[ $line - 1 ];
357: if ( $entry->pri($priority) && $todo->save ) {
358: return print $line, ': ', $entry->text, "\n",
359: 'TODO: ', $line, ' prioritized (', $entry->priority, ").\n";
360: }
361: die "Unable to prioritize entry\n";
362: }
363:
1.15 andrew 364: ## no critic 'sigal'
1.3 andrew 365: sub replace { return &unsupported }
366: sub report { return &unsupported }
1.15 andrew 367: ## use critic
1.3 andrew 368:
369: sub _number_list {
370: my (@list) = @_;
371:
372: my $line = 1;
373: return map { { line => $line++, entry => $_, } } @list;
374: }
375:
376: sub _show_sorted_list {
377: my ( $term, @list ) = @_;
1.15 andrew 378: $term = defined $term ? quotemeta($term) : q{};
1.3 andrew 379:
380: my $shown = 0;
1.15 andrew 381: my @sorted = map { sprintf '%02d %s', $_->{line}, $_->{entry}->text }
1.4 andrew 382: sort { lc $a->{entry}->text cmp lc $b->{entry}->text } @list;
383:
384: foreach my $line ( grep {/$term/xms} @sorted ) {
1.15 andrew 385: print "$line\n";
1.3 andrew 386: $shown++;
387: }
388:
389: return $shown;
390: }
391:
392: sub _show_list_footer {
393: my ( $shown, $total, $file ) = @_;
394:
395: $shown ||= 0;
396: $total ||= 0;
397:
398: print "-- \n";
399: print "TODO: $shown of $total tasks shown from $file\n";
400:
401: return 1;
1.2 andrew 402: }
403:
404: sub unsupported { die "Unsupported action\n" }
405:
406: sub usage {
407: my ($long) = @_;
408:
409: print <<'EOL';
410: * command list taken from todo.sh for compatibility
411: Usage: todo.pl [-fhpantvV] [-d todo_config] action
412: EOL
413:
414: if ($long) {
415: print <<'EOL';
1.3 andrew 416:
1.2 andrew 417: Actions:
418: add|a "THING I NEED TO DO +project @context"
419: addto DEST "TEXT TO ADD"
420: append|app NUMBER "TEXT TO APPEND"
421: archive
422: command [ACTIONS]
423: del|rm NUMBER [TERM]
424: dp|depri NUMBER
425: do NUMBER
426: help
427: list|ls [TERM...]
428: listall|lsa [TERM...]
429: listcon|lsc
430: listfile|lf SRC [TERM...]
431: listpri|lsp [PRIORITY]
432: listproj|lsprj
433: move|mv NUMBER DEST [SRC]
434: prepend|prep NUMBER "TEXT TO PREPEND"
435: pri|p NUMBER PRIORITY
436: replace NUMBER "UPDATED TODO"
437: report
438: EOL
439: }
440: else {
441: print <<'EOL';
442: Try 'todo.pl -h' for more information.
443: EOL
444: }
445:
446: exit;
447: }
448:
449: sub read_config {
450: my ($file) = @_;
451:
452: my %config;
1.15 andrew 453: open my $fh, '<', $file or die "Unable to open [$file] : $!\n";
1.2 andrew 454: LINE: while (<$fh>) {
1.15 andrew 455: _parse_line( $_, \%config );
1.2 andrew 456: }
1.15 andrew 457: close $fh or die "Unable to close [$file]: $!\n";
1.1 andrew 458:
1.2 andrew 459: my %lc_config;
460: foreach my $k ( keys %config ) {
1.15 andrew 461: $lc_config{ lc $k } = $config{$k};
1.2 andrew 462: }
1.1 andrew 463:
1.2 andrew 464: return \%lc_config;
1.1 andrew 465: }
1.13 andrew 466:
1.15 andrew 467: sub _parse_line {
468: my ( $line, $config ) = @_;
469:
470: $line =~ s/\r?\n$//xms;
471: $line =~ s/\s*\#.*$//xms;
472: return if !$line;
473:
474: if (s/^\s*export\s+//xms) {
475: my ( $key, $value ) = /^([^=]+)\s*=\s*"?(.*?)"?\s*$/xms;
476: if ($key) {
477: foreach my $k ( keys %config ) {
478: $value =~ s/\$\Q$k\E/$config{$k}/gxms;
479: $value =~ s/\${\Q$k\E}/$config{$k}/gxms;
480: }
481: foreach my $k ( keys %ENV ) {
482: $value =~ s/\$\Q$k\E/$ENV{$k}/gxms;
483: $value =~ s/\${\Q$k\E}/$ENV{$k}/gxms;
484: }
485: $value =~ s/\$\w+//gxms;
486: $value =~ s/\${\w+}//gxms;
487:
488: $config->{$key} = $value;
489: }
490: }
491:
492: return 1;
493: }
494:
1.13 andrew 495: __END__
496:
497: =head1 NAME
498:
499: todo.pl - a perl replacement for todo.sh
500:
501:
502: =head1 VERSION
503:
504: Since the $VERSION can't be automatically included,
505: here is the RCS Id instead, you'll have to look up $VERSION.
506:
1.16 ! andrew 507: $Id: todo.pl,v 1.15 2010/01/12 20:30:55 andrew Exp $
1.13 andrew 508:
509:
510: =head1 SYNOPSIS
511:
512: todo.pl list
513:
514: todo.pl -h
515:
516: =head1 DESCRIPTION
517:
518: Mostly compatible with todo.sh but not completely.
519: Any differences are either noted under limitations is a bug.
1.14 andrew 520:
521: Ideally todo.pl should pass all the todo.sh tests.
1.13 andrew 522:
523: This is a proof of concept to get the Text::Todo modules used.
524:
525: The modules are there to give more access to my todo.txt file from more
526: places. My goal is a web API for a web interface and then a WebOS version for
527: my Palm Pre.
528:
529: For more information see L<http://todotxt.com>
530:
1.15 andrew 531: =head1 USAGE
532:
533: See todo.pl -h
534:
535: =head1 OPTIONS
536:
537: See todo.pl -h
538:
539: =head1 REQUIRED ARGUMENTS
540:
541: See todo.pl -h
1.13 andrew 542:
543: =head1 CONFIGURATION AND ENVIRONMENT
544:
545: todo.pl should read the todo.cfg file that todo.sh uses. It is a very
546: simplistic reader and would probably be easy to break.
547:
548: It only uses TODO_DIR, TODO_FILE and DONE_DIR
549:
550: It does not currently support any of the environment variables that todo.sh
551: uses.
552:
1.15 andrew 553: =head1 DIAGNOSTICS
1.13 andrew 554:
555: =head1 DEPENDENCIES
556:
557: Perl Modules:
558:
559: =over
560:
561: =item Text::Todo
562:
563: =item version
564:
565: =back
566:
567:
568: =head1 INCOMPATIBILITIES
569:
570: Text::Todo::Entry actually checks if the entry is done before marking it
571: complete again.
572:
573: Text::Todo::Entry will keep the completed marker and then the priority at the
574: beginning of the line in that order.
575:
576:
577: =head1 BUGS AND LIMITATIONS
578:
579: No bugs have been reported.
580:
581: Known limitations:
582:
583: Does not support some command line arguments.
584: @, +, f, h, p, P, t, v or V.
585:
586: Does not yet support some actions. Specifically, command, help and report.
587:
588: Does not colorize output.
589:
590:
591: =head1 AUTHOR
592:
593: Andrew Fresh C<< <andrew@cpan.org> >>
594:
595:
596: =head1 LICENSE AND COPYRIGHT
597:
598: Copyright (c) 2009, Andrew Fresh C<< <andrew@cpan.org> >>. All rights reserved.
599:
600: This module is free software; you can redistribute it and/or
601: modify it under the same terms as Perl itself. See L<perlartistic>.
602:
603:
604: =head1 DISCLAIMER OF WARRANTY
605:
606: BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
607: FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
608: OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
609: PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
610: EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
611: WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
612: ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
613: YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
614: NECESSARY SERVICING, REPAIR, OR CORRECTION.
615:
616: IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
617: WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
618: REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
619: LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
620: OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
621: THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
622: RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
623: FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
624: SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
625: SUCH DAMAGES.
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