[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.11

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 ) ) {
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.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.11    ! andrew    317: sub pri {
        !           318:     my ( $config, $line, $priority ) = @_;
        !           319:     my $error = 'usage: todo.pl pri ITEM# PRIORITY';
        !           320:     if ( !( $line && $line =~ /^\d+$/xms && $priority ) ) {
        !           321:         die $error;
        !           322:     }
        !           323:     if ( $priority !~ /^[A-Z]$/xms ) {
        !           324:         die $error . "\n"
        !           325:             . "note: PRIORITY must a single letter from A to Z.\n";
        !           326:     }
        !           327:
        !           328:     my $todo = Text::Todo->new($config);
        !           329:
        !           330:     my $entry = $todo->list->[ $line - 1 ];
        !           331:     if ( $entry->pri($priority) && $todo->save ) {
        !           332:         return print $line, ': ', $entry->text, "\n",
        !           333:             'TODO: ', $line, ' prioritized (', $entry->priority, ").\n";
        !           334:     }
        !           335:     die "Unable to prioritize entry\n";
        !           336: }
        !           337:
1.3       andrew    338: sub replace { return &unsupported }
                    339: sub report  { return &unsupported }
                    340:
                    341: sub _number_list {
                    342:     my (@list) = @_;
                    343:
                    344:     my $line = 1;
                    345:     return map { { line => $line++, entry => $_, } } @list;
                    346: }
                    347:
                    348: sub _show_sorted_list {
                    349:     my ( $term, @list ) = @_;
                    350:     $term = defined $term ? quotemeta($term) : '';
                    351:
                    352:     my $shown = 0;
1.10      andrew    353:     my @sorted = map { sprintf "%02d %s", $_->{line}, $_->{entry}->text }
1.4       andrew    354:         sort { lc $a->{entry}->text cmp lc $b->{entry}->text } @list;
                    355:
                    356:     foreach my $line ( grep {/$term/xms} @sorted ) {
                    357:         print $line, "\n";
1.3       andrew    358:         $shown++;
                    359:     }
                    360:
                    361:     return $shown;
                    362: }
                    363:
                    364: sub _show_list_footer {
                    365:     my ( $shown, $total, $file ) = @_;
                    366:
                    367:     $shown ||= 0;
                    368:     $total ||= 0;
                    369:
                    370:     print "-- \n";
                    371:     print "TODO: $shown of $total tasks shown from $file\n";
                    372:
                    373:     return 1;
1.2       andrew    374: }
                    375:
                    376: sub unsupported { die "Unsupported action\n" }
                    377:
                    378: sub usage {
                    379:     my ($long) = @_;
                    380:
                    381:     print <<'EOL';
                    382:   * command list taken from todo.sh for compatibility
                    383:   Usage: todo.pl [-fhpantvV] [-d todo_config] action
                    384: EOL
                    385:
                    386:     if ($long) {
                    387:         print <<'EOL';
1.3       andrew    388:
1.2       andrew    389:   Actions:
                    390:     add|a "THING I NEED TO DO +project @context"
                    391:     addto DEST "TEXT TO ADD"
                    392:     append|app NUMBER "TEXT TO APPEND"
                    393:     archive
                    394:     command [ACTIONS]
                    395:     del|rm NUMBER [TERM]
                    396:     dp|depri NUMBER
                    397:     do NUMBER
                    398:     help
                    399:     list|ls [TERM...]
                    400:     listall|lsa [TERM...]
                    401:     listcon|lsc
                    402:     listfile|lf SRC [TERM...]
                    403:     listpri|lsp [PRIORITY]
                    404:     listproj|lsprj
                    405:     move|mv NUMBER DEST [SRC]
                    406:     prepend|prep NUMBER "TEXT TO PREPEND"
                    407:     pri|p NUMBER PRIORITY
                    408:     replace NUMBER "UPDATED TODO"
                    409:     report
                    410: EOL
                    411:     }
                    412:     else {
                    413:         print <<'EOL';
                    414: Try 'todo.pl -h' for more information.
                    415: EOL
                    416:     }
                    417:
                    418:     exit;
                    419: }
                    420:
                    421: sub read_config {
                    422:     my ($file) = @_;
                    423:
                    424:     my %config;
1.9       andrew    425:     open my $fh, '<', $file or die "Unable to open [$file] : $!";
1.2       andrew    426: LINE: while (<$fh>) {
                    427:         s/\r?\n$//xms;
                    428:         s/\s*\#.*$//xms;
                    429:         next LINE unless $_;
                    430:
                    431:         if (s/^\s*export\s+//xms) {
                    432:             my ( $key, $value ) = /^([^=]+)\s*=\s*"?(.*?)"?\s*$/xms;
                    433:             if ($key) {
                    434:                 foreach my $k ( keys %config ) {
                    435:                     $value =~ s/\$\Q$k\E/$config{$k}/gxms;
                    436:                     $value =~ s/\${\Q$k\E}/$config{$k}/gxms;
                    437:                 }
                    438:                 foreach my $k ( keys %ENV ) {
                    439:                     $value =~ s/\$\Q$k\E/$ENV{$k}/gxms;
                    440:                     $value =~ s/\${\Q$k\E}/$ENV{$k}/gxms;
                    441:                 }
                    442:                 $value =~ s/\$\w+//gxms;
                    443:                 $value =~ s/\${\w+}//gxms;
                    444:
                    445:                 $config{$key} = $value;
                    446:             }
                    447:         }
                    448:     }
                    449:     close $fh;
1.1       andrew    450:
1.2       andrew    451:     my %lc_config;
                    452:     foreach my $k ( keys %config ) {
                    453:         $lc_config{ lc($k) } = $config{$k};
                    454:     }
1.1       andrew    455:
1.2       andrew    456:     return \%lc_config;
1.1       andrew    457: }

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