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

1.1       andrew      1: #!/usr/bin/perl
1.6     ! andrew      2: # $RedRiver: todo.pl,v 1.5 2010/01/10 23:37:12 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 {
                    106:     my ( $config, $entry ) = @_;
                    107:     if ( !$entry ) {
                    108:         die "usage: todo.pl add 'item'\n";
                    109:     }
                    110:
                    111:     my $todo = Text::Todo->new($config);
                    112:     if ( $todo->add($entry) ) {
                    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 {
                    124:     my ( $config, $file, $entry ) = @_;
                    125:     if ( !( $file && $entry ) ) {
                    126:         die "usage: todo.pl addto DEST 'TODO ITEM'\n";
                    127:     }
                    128:
                    129:     my $todo = Text::Todo->new($config);
                    130:
                    131:     $file = $todo->file($file);
                    132:     if ( $todo->addto( $file, $entry ) ) {
                    133:         my @list  = $todo->listfile($file);
                    134:         my $lines = scalar @list;
                    135:
                    136:         print "TODO: '$entry' added to $file on line $lines\n";
                    137:
                    138:         return $lines;
                    139:     }
                    140:     die "Unable to add [$entry]\n";
                    141: }
                    142:
1.4       andrew    143: sub append {
                    144:     my ( $config, $line, $text ) = @_;
                    145:     if ( !( $line && $text && $line =~ /^\d+$/xms ) ) {
                    146:         die 'usage: todo.pl append ITEM# "TEXT TO APPEND"' . "\n";
                    147:     }
                    148:
                    149:     my $todo  = Text::Todo->new($config);
                    150:     my $entry = $todo->list->[ $line - 1 ];
                    151:
                    152:     if ( $entry->append($text) && $todo->save ) {
                    153:         return printf "%02d: %s\n", $line, $entry->text;
                    154:     }
                    155:     die "Unable to append\n";
                    156: }
                    157:
1.5       andrew    158: sub archive {
                    159:     my ( $config ) = @_;
                    160:     my $todo = Text::Todo->new($config);
                    161:
                    162:     my $file = $todo->file;
                    163:
                    164:     my $archived = $todo->archive;
                    165:     if (defined $archived) {
                    166:         return print "TODO: $file archived.\n";
                    167:     }
                    168:     die "Unable to archive $file\n";
                    169: }
                    170:
1.3       andrew    171: sub command   { return &unsupported }
1.6     ! andrew    172:
        !           173: sub del {
        !           174:     my ( $config, $line ) = @_;
        !           175:     if ( !( $line && $line =~ /^\d+$/xms ) ) {
        !           176:         die 'usage: todo.pl del ITEM#' . "\n";
        !           177:     }
        !           178:     my $todo = Text::Todo->new($config);
        !           179:
        !           180:     my $entry = $todo->list->[$line - 1];
        !           181:     print "Delete '" . $entry->text . "'?  (y/n)\n";
        !           182:     warn "XXX No delete confirmation currently!\n";
        !           183:
        !           184:     if ($opts{n}) {
        !           185:         if ($todo->del($entry) && $todo->save) {
        !           186:             return print 'TODO: \'', $entry->text, "' deleted.\n";
        !           187:         }
        !           188:     }
        !           189:     else {
        !           190:         my $text = $entry->text;
        !           191:         if ($entry->replace(q{}) && $todo->save) {
        !           192:             return print 'TODO: \'', $text, "' deleted.\n";
        !           193:         }
        !           194:     }
        !           195:
        !           196:     die "Unable to delete entry\n";
        !           197: }
        !           198:
1.3       andrew    199: sub depri     { return &unsupported }
                    200: sub mark_done { return &unsupported }
                    201: sub help      { return &unsupported }
                    202:
1.2       andrew    203: sub list {
1.3       andrew    204:     my ( $config, $term ) = @_;
                    205:     my $todo = Text::Todo->new($config);
                    206:
                    207:     my @list = _number_list( $todo->list );
                    208:     my $shown = _show_sorted_list( $term, @list );
                    209:
                    210:     return _show_list_footer( $shown, scalar @list, $config->{todo_file} );
                    211: }
                    212:
                    213: sub listall {
                    214:     my ( $config, $term ) = @_;
                    215:     my $todo = Text::Todo->new($config);
                    216:
                    217:     my @list = _number_list(
                    218:         $todo->listfile('todo_file'),
                    219:         $todo->listfile('done_file'),
                    220:     );
                    221:     my $shown = _show_sorted_list( $term, @list );
                    222:
                    223:     return _show_list_footer( $shown, scalar @list, $config->{'todo_dir'} );
                    224: }
                    225:
                    226: sub listcon {
1.2       andrew    227:     my ($config) = @_;
                    228:     my $todo = Text::Todo->new($config);
1.3       andrew    229:     return print map {"\@$_\n"} $todo->listcon;
                    230: }
1.2       andrew    231:
1.3       andrew    232: sub listfile {
                    233:     my ( $config, $file, $term ) = @_;
                    234:     if ( !$file ) {
                    235:         die "usage: todo.pl listfile SRC [TERM]\n";
1.2       andrew    236:     }
1.3       andrew    237:     my $todo = Text::Todo->new($config);
                    238:
                    239:     my @list = _number_list( $todo->listfile($file) );
                    240:     my $shown = _show_sorted_list( $term, @list );
                    241:
                    242:     return _show_list_footer( $shown, scalar @list, $file );
                    243: }
                    244:
                    245: sub listpri {
                    246:     my ( $config, $pri ) = @_;
                    247:
                    248:     my $todo = Text::Todo->new($config);
                    249:
                    250:     my @list = _number_list( $todo->listfile('todo_file') );
                    251:     my @pri_list;
                    252:     if ($pri) {
                    253:         $pri = uc $pri;
                    254:         if ( $pri !~ /^[A-Z]$/xms ) {
                    255:             die "usage: todo.pl listpri PRIORITY\n",
                    256:                 "note: PRIORITY must a single letter from A to Z.\n";
                    257:         }
                    258:         @pri_list = grep {
                    259:             defined $_->{entry}->priority
                    260:                 && $_->{entry}->priority eq $pri
                    261:         } @list;
                    262:     }
                    263:     else {
                    264:         @pri_list = grep { $_->{entry}->priority } @list;
                    265:     }
                    266:
                    267:     my $shown = _show_sorted_list( undef, @pri_list );
                    268:
                    269:     return _show_list_footer( $shown, scalar @list, $config->{todo_file} );
                    270: }
                    271:
                    272: sub listproj {
                    273:     my ($config) = @_;
                    274:     my $todo = Text::Todo->new($config);
                    275:     return print map {"\+$_\n"} $todo->listproj;
                    276: }
                    277:
                    278: sub move    { return &unsupported }
                    279: sub prepend { return &unsupported }
                    280: sub pri     { return &unsupported }
                    281: sub replace { return &unsupported }
                    282: sub report  { return &unsupported }
                    283:
                    284: sub _number_list {
                    285:     my (@list) = @_;
                    286:
                    287:     my $line = 1;
                    288:     return map { { line => $line++, entry => $_, } } @list;
                    289: }
                    290:
                    291: sub _show_sorted_list {
                    292:     my ( $term, @list ) = @_;
                    293:     $term = defined $term ? quotemeta($term) : '';
                    294:
                    295:     my $shown = 0;
1.4       andrew    296:     my @sorted
                    297:         = map { sprintf "%02d %s", $_->{line}, $_->{entry}->text }
                    298:         sort { lc $a->{entry}->text cmp lc $b->{entry}->text } @list;
                    299:
                    300:     foreach my $line ( grep {/$term/xms} @sorted ) {
                    301:         print $line, "\n";
1.3       andrew    302:         $shown++;
                    303:     }
                    304:
                    305:     return $shown;
                    306: }
                    307:
                    308: sub _show_list_footer {
                    309:     my ( $shown, $total, $file ) = @_;
                    310:
                    311:     $shown ||= 0;
                    312:     $total ||= 0;
                    313:
                    314:     print "-- \n";
                    315:     print "TODO: $shown of $total tasks shown from $file\n";
                    316:
                    317:     return 1;
1.2       andrew    318: }
                    319:
                    320: sub unsupported { die "Unsupported action\n" }
                    321:
                    322: sub usage {
                    323:     my ($long) = @_;
                    324:
                    325:     print <<'EOL';
                    326:   * command list taken from todo.sh for compatibility
                    327:   Usage: todo.pl [-fhpantvV] [-d todo_config] action
                    328: EOL
                    329:
                    330:     if ($long) {
                    331:         print <<'EOL';
1.3       andrew    332:
1.2       andrew    333:   Actions:
                    334:     add|a "THING I NEED TO DO +project @context"
                    335:     addto DEST "TEXT TO ADD"
                    336:     append|app NUMBER "TEXT TO APPEND"
                    337:     archive
                    338:     command [ACTIONS]
                    339:     del|rm NUMBER [TERM]
                    340:     dp|depri NUMBER
                    341:     do NUMBER
                    342:     help
                    343:     list|ls [TERM...]
                    344:     listall|lsa [TERM...]
                    345:     listcon|lsc
                    346:     listfile|lf SRC [TERM...]
                    347:     listpri|lsp [PRIORITY]
                    348:     listproj|lsprj
                    349:     move|mv NUMBER DEST [SRC]
                    350:     prepend|prep NUMBER "TEXT TO PREPEND"
                    351:     pri|p NUMBER PRIORITY
                    352:     replace NUMBER "UPDATED TODO"
                    353:     report
                    354: EOL
                    355:     }
                    356:     else {
                    357:         print <<'EOL';
                    358: Try 'todo.pl -h' for more information.
                    359: EOL
                    360:     }
                    361:
                    362:     exit;
                    363: }
                    364:
                    365: sub read_config {
                    366:     my ($file) = @_;
                    367:
                    368:     my %config;
1.3       andrew    369:     open my $fh, '< ', $file or die "Unable to open [$file]: $!";
1.2       andrew    370: LINE: while (<$fh>) {
                    371:         s/\r?\n$//xms;
                    372:         s/\s*\#.*$//xms;
                    373:         next LINE unless $_;
                    374:
                    375:         if (s/^\s*export\s+//xms) {
                    376:             my ( $key, $value ) = /^([^=]+)\s*=\s*"?(.*?)"?\s*$/xms;
                    377:             if ($key) {
                    378:                 foreach my $k ( keys %config ) {
                    379:                     $value =~ s/\$\Q$k\E/$config{$k}/gxms;
                    380:                     $value =~ s/\${\Q$k\E}/$config{$k}/gxms;
                    381:                 }
                    382:                 foreach my $k ( keys %ENV ) {
                    383:                     $value =~ s/\$\Q$k\E/$ENV{$k}/gxms;
                    384:                     $value =~ s/\${\Q$k\E}/$ENV{$k}/gxms;
                    385:                 }
                    386:                 $value =~ s/\$\w+//gxms;
                    387:                 $value =~ s/\${\w+}//gxms;
                    388:
                    389:                 $config{$key} = $value;
                    390:             }
                    391:         }
                    392:     }
                    393:     close $fh;
1.1       andrew    394:
1.2       andrew    395:     my %lc_config;
                    396:     foreach my $k ( keys %config ) {
                    397:         $lc_config{ lc($k) } = $config{$k};
                    398:     }
1.1       andrew    399:
1.2       andrew    400:     return \%lc_config;
1.1       andrew    401: }

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