Annotation of todotxt/Text-Todo/bin/todo.pl, Revision 1.21
1.1 andrew 1: #!/usr/bin/perl
1.21 ! andrew 2: # $AFresh1: todo.pl,v 1.20 2010/01/22 01:30:45 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:
1.2 andrew 16: use Getopt::Std;
1.1 andrew 17: use Text::Todo;
18:
1.20 andrew 19: use version; our $VERSION = qv('0.1.1');
1.1 andrew 20:
1.2 andrew 21: # option defaults
22: my $config_file = $ENV{HOME} . '/todo.cfg';
1.3 andrew 23: CONFIG: foreach my $f ( $config_file, $ENV{HOME} . '/.todo.cfg', ) {
24: if ( -e $f ) {
25: $config_file = $f;
26: last CONFIG;
27: }
28: }
1.2 andrew 29:
30: my %actions = (
1.3 andrew 31: add => \&add,
32: addto => \&addto,
33: append => \&append,
34: archive => \&archive,
35: command => \&command,
36: del => \&del,
37: depri => \&depri,
38: do => \&mark_done,
39: help => \&help,
1.2 andrew 40: list => \&list,
1.3 andrew 41: listall => \&listall,
42: listcon => \&listcon,
43: listfile => \&listfile,
44: listpri => \&listpri,
45: listproj => \&listproj,
46: move => \&move,
47: prepend => \&prepend,
48: pri => \&pri,
49: replace => \&replace,
50: report => \&report,
1.2 andrew 51: );
52:
53: my %aliases = (
54: a => 'add',
55: app => 'append',
56: rm => 'del',
57: dp => 'depri',
58: ls => 'list',
59: lsa => 'listall',
60: lsc => 'listcon',
61: lf => 'listfile',
1.3 andrew 62: lsp => 'listpri',
1.2 andrew 63: lsprj => 'listproj',
64: mv => 'move',
65: prep => 'prepend',
66: p => 'pri',
67: );
68:
69: my %opts;
1.15 andrew 70: getopts( q{+d:fhpPntvV@}, \%opts );
1.2 andrew 71:
72: my $action = shift @ARGV;
73: if ( $action && $action eq 'command' ) {
74:
75: # We don't support action scripts so . . .
76: $action = shift @ARGV;
77: }
78: if ( $action && exists $aliases{$action} ) {
79: $action = $aliases{$action};
80: }
81:
82: if ( $opts{h} || !$action ) {
83: usage( $opts{h} );
84: }
85:
1.6 andrew 86: my @unsupported = grep { defined $opts{$_} } qw( @ + f h p P t v V );
1.2 andrew 87: if (@unsupported) {
1.3 andrew 88: warn 'Unsupported options: ' . ( join q{, }, @unsupported ) . "\n";
1.2 andrew 89: }
90:
91: if ( $opts{d} ) {
92: $config_file = $opts{d};
93: }
94:
95: if ( exists $actions{$action} ) {
96: my $config = read_config($config_file);
1.16 andrew 97: my $result = $actions{$action}->( $config, @ARGV );
1.2 andrew 98: }
99: else {
100: usage();
101: }
102:
1.3 andrew 103: sub add {
1.7 andrew 104: my ( $config, @entry ) = @_;
105: if ( !@entry ) {
1.3 andrew 106: die "usage: todo.pl add 'item'\n";
107: }
108:
1.7 andrew 109: my $entry = join q{ }, @entry;
110:
1.3 andrew 111: my $todo = Text::Todo->new($config);
1.21 ! andrew 112: if ( $todo->add($entry) && $todo->save ) {
1.3 andrew 113: my @list = $todo->list;
114: my $lines = scalar @list;
115:
116: print "TODO: '$entry' added on line $lines\n";
117:
118: return $lines;
119: }
120: die "Unable to add [$entry]\n";
121: }
122:
123: sub addto {
1.7 andrew 124: my ( $config, $file, @entry ) = @_;
125: if ( !( $file && @entry ) ) {
1.3 andrew 126: die "usage: todo.pl addto DEST 'TODO ITEM'\n";
127: }
128:
1.7 andrew 129: my $entry = join q{ }, @entry;
130:
1.3 andrew 131: my $todo = Text::Todo->new($config);
132:
133: $file = $todo->file($file);
134: if ( $todo->addto( $file, $entry ) ) {
135: my @list = $todo->listfile($file);
136: my $lines = scalar @list;
137:
138: print "TODO: '$entry' added to $file on line $lines\n";
139:
140: return $lines;
141: }
142: die "Unable to add [$entry]\n";
143: }
144:
1.4 andrew 145: sub append {
1.9 andrew 146: my ( $config, $line, @text ) = @_;
1.7 andrew 147: if ( !( $line && @text && $line =~ /^\d+$/xms ) ) {
1.4 andrew 148: die 'usage: todo.pl append ITEM# "TEXT TO APPEND"' . "\n";
149: }
1.7 andrew 150:
151: my $text = join q{ }, @text;
1.4 andrew 152:
153: my $todo = Text::Todo->new($config);
154: my $entry = $todo->list->[ $line - 1 ];
155:
156: if ( $entry->append($text) && $todo->save ) {
157: return printf "%02d: %s\n", $line, $entry->text;
158: }
159: die "Unable to append\n";
160: }
161:
1.9 andrew 162: sub archive {
163: my ($config) = @_;
1.5 andrew 164: my $todo = Text::Todo->new($config);
1.9 andrew 165:
1.5 andrew 166: my $file = $todo->file;
167:
168: my $archived = $todo->archive;
1.9 andrew 169: if ( defined $archived ) {
1.5 andrew 170: return print "TODO: $file archived.\n";
171: }
172: die "Unable to archive $file\n";
173: }
174:
1.15 andrew 175: ## no critic 'sigal'
1.9 andrew 176: sub command { return &unsupported }
1.15 andrew 177: ## use critic
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.15 andrew 187: print 'Delete \'', $entry->text . "'? (y/n)\n";
1.6 andrew 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 ) ) {
1.11 andrew 208: die 'usage: todo.pl depri ITEM#' . "\n";
1.9 andrew 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.12 andrew 220: # since "do" is reserved
1.15 andrew 221: sub mark_done {
1.12 andrew 222: my ( $config, $line ) = @_;
223: if ( !( $line && $line =~ /^\d+$/xms ) ) {
224: die 'usage: todo.pl del ITEM#' . "\n";
225: }
226: my $todo = Text::Todo->new($config);
227:
228: my $entry = $todo->list->[ $line - 1 ];
229:
230: if ( $entry->do && $todo->save ) {
231: my $status = print $line, ': ', $entry->text, "\n",
232: 'TODO: ', $line, " marked as done.\n";
1.15 andrew 233: if ( !$opts{a} ) {
1.12 andrew 234: return archive($config);
235: }
236: return $status;
237: }
238: die "Unable to mark as done\n";
239: }
240:
1.15 andrew 241: ## no critic 'sigal'
242: sub help { return &unsupported }
243: ## use critic
1.3 andrew 244:
1.2 andrew 245: sub list {
1.3 andrew 246: my ( $config, $term ) = @_;
247: my $todo = Text::Todo->new($config);
248:
249: my @list = _number_list( $todo->list );
250: my $shown = _show_sorted_list( $term, @list );
251:
252: return _show_list_footer( $shown, scalar @list, $config->{todo_file} );
253: }
254:
255: sub listall {
256: my ( $config, $term ) = @_;
257: my $todo = Text::Todo->new($config);
258:
259: my @list = _number_list(
260: $todo->listfile('todo_file'),
261: $todo->listfile('done_file'),
262: );
263: my $shown = _show_sorted_list( $term, @list );
264:
265: return _show_list_footer( $shown, scalar @list, $config->{'todo_dir'} );
266: }
267:
268: sub listcon {
1.2 andrew 269: my ($config) = @_;
270: my $todo = Text::Todo->new($config);
1.3 andrew 271: return print map {"\@$_\n"} $todo->listcon;
272: }
1.2 andrew 273:
1.3 andrew 274: sub listfile {
275: my ( $config, $file, $term ) = @_;
276: if ( !$file ) {
277: die "usage: todo.pl listfile SRC [TERM]\n";
1.2 andrew 278: }
1.3 andrew 279: my $todo = Text::Todo->new($config);
280:
281: my @list = _number_list( $todo->listfile($file) );
282: my $shown = _show_sorted_list( $term, @list );
283:
284: return _show_list_footer( $shown, scalar @list, $file );
285: }
286:
287: sub listpri {
288: my ( $config, $pri ) = @_;
289:
290: my $todo = Text::Todo->new($config);
291:
292: my @list = _number_list( $todo->listfile('todo_file') );
293: my @pri_list;
294: if ($pri) {
295: $pri = uc $pri;
1.16 andrew 296: if ( $pri !~ /^[[:upper:]]$/xms ) {
1.3 andrew 297: die "usage: todo.pl listpri PRIORITY\n",
298: "note: PRIORITY must a single letter from A to Z.\n";
299: }
300: @pri_list = grep {
301: defined $_->{entry}->priority
302: && $_->{entry}->priority eq $pri
303: } @list;
304: }
305: else {
306: @pri_list = grep { $_->{entry}->priority } @list;
307: }
308:
309: my $shown = _show_sorted_list( undef, @pri_list );
310:
311: return _show_list_footer( $shown, scalar @list, $config->{todo_file} );
312: }
313:
314: sub listproj {
315: my ($config) = @_;
316: my $todo = Text::Todo->new($config);
317: return print map {"\+$_\n"} $todo->listproj;
318: }
319:
1.15 andrew 320: ## no critic 'sigal'
1.10 andrew 321: sub move { return &unsupported }
1.15 andrew 322: ## use critic
1.8 andrew 323:
324: sub prepend {
1.10 andrew 325: my ( $config, $line, @text ) = @_;
1.8 andrew 326: if ( !( $line && @text && $line =~ /^\d+$/xms ) ) {
1.9 andrew 327: die 'usage: todo.pl prepend ITEM# "TEXT TO PREPEND"' . "\n";
1.8 andrew 328: }
329:
330: my $text = join q{ }, @text;
331:
332: my $todo = Text::Todo->new($config);
333: my $entry = $todo->list->[ $line - 1 ];
334:
335: if ( $entry->prepend($text) && $todo->save ) {
336: return printf "%02d: %s\n", $line, $entry->text;
337: }
1.9 andrew 338: die "Unable to prepend\n";
1.8 andrew 339: }
340:
1.11 andrew 341: sub pri {
342: my ( $config, $line, $priority ) = @_;
343: my $error = 'usage: todo.pl pri ITEM# PRIORITY';
344: if ( !( $line && $line =~ /^\d+$/xms && $priority ) ) {
1.15 andrew 345: die "$error\n";
1.11 andrew 346: }
1.16 andrew 347: elsif ( $priority !~ /^[[:upper:]]$/xms ) {
1.15 andrew 348: $error .= "\n" . 'note: PRIORITY must a single letter from A to Z.';
349: die "$error\n";
1.11 andrew 350: }
351:
352: my $todo = Text::Todo->new($config);
353:
354: my $entry = $todo->list->[ $line - 1 ];
355: if ( $entry->pri($priority) && $todo->save ) {
356: return print $line, ': ', $entry->text, "\n",
357: 'TODO: ', $line, ' prioritized (', $entry->priority, ").\n";
358: }
359: die "Unable to prioritize entry\n";
360: }
361:
1.15 andrew 362: ## no critic 'sigal'
1.3 andrew 363: sub replace { return &unsupported }
364: sub report { return &unsupported }
1.15 andrew 365: ## use critic
1.3 andrew 366:
367: sub _number_list {
368: my (@list) = @_;
369:
370: my $line = 1;
371: return map { { line => $line++, entry => $_, } } @list;
372: }
373:
374: sub _show_sorted_list {
375: my ( $term, @list ) = @_;
1.15 andrew 376: $term = defined $term ? quotemeta($term) : q{};
1.3 andrew 377:
378: my $shown = 0;
1.15 andrew 379: my @sorted = map { sprintf '%02d %s', $_->{line}, $_->{entry}->text }
1.4 andrew 380: sort { lc $a->{entry}->text cmp lc $b->{entry}->text } @list;
381:
382: foreach my $line ( grep {/$term/xms} @sorted ) {
1.15 andrew 383: print "$line\n";
1.3 andrew 384: $shown++;
385: }
386:
387: return $shown;
388: }
389:
390: sub _show_list_footer {
391: my ( $shown, $total, $file ) = @_;
392:
393: $shown ||= 0;
394: $total ||= 0;
395:
396: print "-- \n";
397: print "TODO: $shown of $total tasks shown from $file\n";
398:
399: return 1;
1.2 andrew 400: }
401:
402: sub unsupported { die "Unsupported action\n" }
403:
404: sub usage {
405: my ($long) = @_;
406:
407: print <<'EOL';
408: * command list taken from todo.sh for compatibility
409: Usage: todo.pl [-fhpantvV] [-d todo_config] action
410: EOL
411:
412: if ($long) {
413: print <<'EOL';
1.3 andrew 414:
1.2 andrew 415: Actions:
416: add|a "THING I NEED TO DO +project @context"
417: addto DEST "TEXT TO ADD"
418: append|app NUMBER "TEXT TO APPEND"
419: archive
420: command [ACTIONS]
421: del|rm NUMBER [TERM]
422: dp|depri NUMBER
423: do NUMBER
424: help
425: list|ls [TERM...]
426: listall|lsa [TERM...]
427: listcon|lsc
428: listfile|lf SRC [TERM...]
429: listpri|lsp [PRIORITY]
430: listproj|lsprj
431: move|mv NUMBER DEST [SRC]
432: prepend|prep NUMBER "TEXT TO PREPEND"
433: pri|p NUMBER PRIORITY
434: replace NUMBER "UPDATED TODO"
435: report
436: EOL
437: }
438: else {
439: print <<'EOL';
440: Try 'todo.pl -h' for more information.
441: EOL
442: }
443:
444: exit;
445: }
446:
447: sub read_config {
448: my ($file) = @_;
449:
450: my %config;
1.15 andrew 451: open my $fh, '<', $file or die "Unable to open [$file] : $!\n";
1.2 andrew 452: LINE: while (<$fh>) {
1.15 andrew 453: _parse_line( $_, \%config );
1.2 andrew 454: }
1.15 andrew 455: close $fh or die "Unable to close [$file]: $!\n";
1.1 andrew 456:
1.2 andrew 457: my %lc_config;
458: foreach my $k ( keys %config ) {
1.15 andrew 459: $lc_config{ lc $k } = $config{$k};
1.2 andrew 460: }
1.1 andrew 461:
1.2 andrew 462: return \%lc_config;
1.1 andrew 463: }
1.13 andrew 464:
1.15 andrew 465: sub _parse_line {
466: my ( $line, $config ) = @_;
467:
468: $line =~ s/\r?\n$//xms;
469: $line =~ s/\s*\#.*$//xms;
470: return if !$line;
471:
472: if (s/^\s*export\s+//xms) {
473: my ( $key, $value ) = /^([^=]+)\s*=\s*"?(.*?)"?\s*$/xms;
474: if ($key) {
1.19 andrew 475: foreach my $k ( keys %{ $config } ) {
476: $value =~ s/\$\Q$k\E/$config->{$k}/gxms;
477: $value =~ s/\${\Q$k\E}/$config->{$k}/gxms;
1.15 andrew 478: }
479: foreach my $k ( keys %ENV ) {
480: $value =~ s/\$\Q$k\E/$ENV{$k}/gxms;
481: $value =~ s/\${\Q$k\E}/$ENV{$k}/gxms;
482: }
483: $value =~ s/\$\w+//gxms;
484: $value =~ s/\${\w+}//gxms;
485:
486: $config->{$key} = $value;
487: }
488: }
489:
490: return 1;
491: }
492:
1.13 andrew 493: __END__
494:
495: =head1 NAME
496:
497: todo.pl - a perl replacement for todo.sh
498:
499:
500: =head1 VERSION
501:
502: Since the $VERSION can't be automatically included,
503: here is the RCS Id instead, you'll have to look up $VERSION.
504:
1.21 ! andrew 505: $Id: todo.pl,v 1.20 2010/01/22 01:30:45 andrew Exp $
1.13 andrew 506:
507:
508: =head1 SYNOPSIS
509:
510: todo.pl list
511:
512: todo.pl -h
513:
514: =head1 DESCRIPTION
515:
516: Mostly compatible with todo.sh but not completely.
517: Any differences are either noted under limitations is a bug.
1.14 andrew 518:
519: Ideally todo.pl should pass all the todo.sh tests.
1.13 andrew 520:
521: This is a proof of concept to get the Text::Todo modules used.
522:
523: The modules are there to give more access to my todo.txt file from more
524: places. My goal is a web API for a web interface and then a WebOS version for
525: my Palm Pre.
526:
527: For more information see L<http://todotxt.com>
528:
1.15 andrew 529: =head1 USAGE
530:
531: See todo.pl -h
532:
533: =head1 OPTIONS
534:
535: See todo.pl -h
536:
537: =head1 REQUIRED ARGUMENTS
538:
539: See todo.pl -h
1.13 andrew 540:
541: =head1 CONFIGURATION AND ENVIRONMENT
542:
543: todo.pl should read the todo.cfg file that todo.sh uses. It is a very
544: simplistic reader and would probably be easy to break.
545:
546: It only uses TODO_DIR, TODO_FILE and DONE_DIR
547:
548: It does not currently support any of the environment variables that todo.sh
549: uses.
550:
1.15 andrew 551: =head1 DIAGNOSTICS
1.13 andrew 552:
553: =head1 DEPENDENCIES
554:
555: Perl Modules:
556:
557: =over
558:
559: =item Text::Todo
560:
561: =item version
562:
563: =back
564:
565:
566: =head1 INCOMPATIBILITIES
567:
568: Text::Todo::Entry actually checks if the entry is done before marking it
569: complete again.
570:
571: Text::Todo::Entry will keep the completed marker and then the priority at the
572: beginning of the line in that order.
573:
574:
575: =head1 BUGS AND LIMITATIONS
576:
577: No bugs have been reported.
578:
579: Known limitations:
580:
581: Does not support some command line arguments.
582: @, +, f, h, p, P, t, v or V.
583:
584: Does not yet support some actions. Specifically, command, help and report.
585:
586: Does not colorize output.
587:
588:
589: =head1 AUTHOR
590:
591: Andrew Fresh C<< <andrew@cpan.org> >>
592:
593:
594: =head1 LICENSE AND COPYRIGHT
595:
596: Copyright (c) 2009, Andrew Fresh C<< <andrew@cpan.org> >>. All rights reserved.
597:
598: This module is free software; you can redistribute it and/or
599: modify it under the same terms as Perl itself. See L<perlartistic>.
600:
601:
602: =head1 DISCLAIMER OF WARRANTY
603:
604: BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
605: FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
606: OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
607: PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
608: EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
609: WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
610: ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
611: YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
612: NECESSARY SERVICING, REPAIR, OR CORRECTION.
613:
614: IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
615: WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
616: REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
617: LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
618: OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
619: THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
620: RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
621: FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
622: SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
623: 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