[BACK]Return to todo.pl CVS log [TXT][DIR] Up to [local] / todotxt / Text-Todo / bin

Annotation of todotxt/Text-Todo/bin/todo.pl, Revision 1.14

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>