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

1.1       andrew      1: #!/usr/bin/perl
1.3     ! andrew      2: # $RedRiver: todo.pl,v 1.2 2010/01/10 07:13:54 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:
                     88: my @unsupported = grep { defined $opts{$_} } qw( @ + f h p P n t v V );
                     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:
        !           143: sub append    { return &unsupported }
        !           144: sub archive   { return &unsupported }
        !           145: sub command   { return &unsupported }
        !           146: sub del       { return &unsupported }
        !           147: sub depri     { return &unsupported }
        !           148: sub mark_done { return &unsupported }
        !           149: sub help      { return &unsupported }
        !           150:
1.2       andrew    151: sub list {
1.3     ! andrew    152:     my ( $config, $term ) = @_;
        !           153:     my $todo = Text::Todo->new($config);
        !           154:
        !           155:     my @list = _number_list( $todo->list );
        !           156:     my $shown = _show_sorted_list( $term, @list );
        !           157:
        !           158:     return _show_list_footer( $shown, scalar @list, $config->{todo_file} );
        !           159: }
        !           160:
        !           161: sub listall {
        !           162:     my ( $config, $term ) = @_;
        !           163:     my $todo = Text::Todo->new($config);
        !           164:
        !           165:     my @list = _number_list(
        !           166:         $todo->listfile('todo_file'),
        !           167:         $todo->listfile('done_file'),
        !           168:     );
        !           169:     my $shown = _show_sorted_list( $term, @list );
        !           170:
        !           171:     return _show_list_footer( $shown, scalar @list, $config->{'todo_dir'} );
        !           172: }
        !           173:
        !           174: sub listcon {
1.2       andrew    175:     my ($config) = @_;
                    176:     my $todo = Text::Todo->new($config);
1.3     ! andrew    177:     return print map {"\@$_\n"} $todo->listcon;
        !           178: }
1.2       andrew    179:
1.3     ! andrew    180: sub listfile {
        !           181:     my ( $config, $file, $term ) = @_;
        !           182:     if ( !$file ) {
        !           183:         die "usage: todo.pl listfile SRC [TERM]\n";
1.2       andrew    184:     }
1.3     ! andrew    185:     my $todo = Text::Todo->new($config);
        !           186:
        !           187:     my @list = _number_list( $todo->listfile($file) );
        !           188:     my $shown = _show_sorted_list( $term, @list );
        !           189:
        !           190:     return _show_list_footer( $shown, scalar @list, $file );
        !           191: }
        !           192:
        !           193: sub listpri {
        !           194:     my ( $config, $pri ) = @_;
        !           195:
        !           196:     my $todo = Text::Todo->new($config);
        !           197:
        !           198:     my @list = _number_list( $todo->listfile('todo_file') );
        !           199:     my @pri_list;
        !           200:     if ($pri) {
        !           201:         $pri = uc $pri;
        !           202:         if ( $pri !~ /^[A-Z]$/xms ) {
        !           203:             die "usage: todo.pl listpri PRIORITY\n",
        !           204:                 "note: PRIORITY must a single letter from A to Z.\n";
        !           205:         }
        !           206:         @pri_list = grep {
        !           207:             defined $_->{entry}->priority
        !           208:                 && $_->{entry}->priority eq $pri
        !           209:         } @list;
        !           210:     }
        !           211:     else {
        !           212:         @pri_list = grep { $_->{entry}->priority } @list;
        !           213:     }
        !           214:
        !           215:     my $shown = _show_sorted_list( undef, @pri_list );
        !           216:
        !           217:     return _show_list_footer( $shown, scalar @list, $config->{todo_file} );
        !           218: }
        !           219:
        !           220: sub listproj {
        !           221:     my ($config) = @_;
        !           222:     my $todo = Text::Todo->new($config);
        !           223:     return print map {"\+$_\n"} $todo->listproj;
        !           224: }
        !           225:
        !           226: sub move    { return &unsupported }
        !           227: sub prepend { return &unsupported }
        !           228: sub pri     { return &unsupported }
        !           229: sub replace { return &unsupported }
        !           230: sub report  { return &unsupported }
        !           231:
        !           232: sub _number_list {
        !           233:     my (@list) = @_;
        !           234:
        !           235:     my $line = 1;
        !           236:     return map { { line => $line++, entry => $_, } } @list;
        !           237: }
        !           238:
        !           239: sub _show_sorted_list {
        !           240:     my ( $term, @list ) = @_;
        !           241:     $term = defined $term ? quotemeta($term) : '';
        !           242:
        !           243:     my $shown = 0;
        !           244:     foreach my $e (
        !           245:         sort { lc $a->{entry}->text cmp lc $b->{entry}->text }
        !           246:         grep { $_->{entry}->text =~ /$term/xms } @list
        !           247:         )
        !           248:     {
        !           249:         printf "%02d %s\n", $e->{line}, $e->{entry}->text;
        !           250:         $shown++;
        !           251:     }
        !           252:
        !           253:     return $shown;
        !           254: }
        !           255:
        !           256: sub _show_list_footer {
        !           257:     my ( $shown, $total, $file ) = @_;
        !           258:
        !           259:     $shown ||= 0;
        !           260:     $total ||= 0;
        !           261:
        !           262:     print "-- \n";
        !           263:     print "TODO: $shown of $total tasks shown from $file\n";
        !           264:
        !           265:     return 1;
1.2       andrew    266: }
                    267:
                    268: sub unsupported { die "Unsupported action\n" }
                    269:
                    270: sub usage {
                    271:     my ($long) = @_;
                    272:
                    273:     print <<'EOL';
                    274:   * command list taken from todo.sh for compatibility
                    275:   Usage: todo.pl [-fhpantvV] [-d todo_config] action
                    276: EOL
                    277:
                    278:     if ($long) {
                    279:         print <<'EOL';
1.3     ! andrew    280:
1.2       andrew    281:   Actions:
                    282:     add|a "THING I NEED TO DO +project @context"
                    283:     addto DEST "TEXT TO ADD"
                    284:     append|app NUMBER "TEXT TO APPEND"
                    285:     archive
                    286:     command [ACTIONS]
                    287:     del|rm NUMBER [TERM]
                    288:     dp|depri NUMBER
                    289:     do NUMBER
                    290:     help
                    291:     list|ls [TERM...]
                    292:     listall|lsa [TERM...]
                    293:     listcon|lsc
                    294:     listfile|lf SRC [TERM...]
                    295:     listpri|lsp [PRIORITY]
                    296:     listproj|lsprj
                    297:     move|mv NUMBER DEST [SRC]
                    298:     prepend|prep NUMBER "TEXT TO PREPEND"
                    299:     pri|p NUMBER PRIORITY
                    300:     replace NUMBER "UPDATED TODO"
                    301:     report
                    302: EOL
                    303:     }
                    304:     else {
                    305:         print <<'EOL';
                    306: Try 'todo.pl -h' for more information.
                    307: EOL
                    308:     }
                    309:
                    310:     exit;
                    311: }
                    312:
                    313: sub read_config {
                    314:     my ($file) = @_;
                    315:
                    316:     my %config;
1.3     ! andrew    317:     open my $fh, '< ', $file or die "Unable to open [$file]: $!";
1.2       andrew    318: LINE: while (<$fh>) {
                    319:         s/\r?\n$//xms;
                    320:         s/\s*\#.*$//xms;
                    321:         next LINE unless $_;
                    322:
                    323:         if (s/^\s*export\s+//xms) {
                    324:             my ( $key, $value ) = /^([^=]+)\s*=\s*"?(.*?)"?\s*$/xms;
                    325:             if ($key) {
                    326:                 foreach my $k ( keys %config ) {
                    327:                     $value =~ s/\$\Q$k\E/$config{$k}/gxms;
                    328:                     $value =~ s/\${\Q$k\E}/$config{$k}/gxms;
                    329:                 }
                    330:                 foreach my $k ( keys %ENV ) {
                    331:                     $value =~ s/\$\Q$k\E/$ENV{$k}/gxms;
                    332:                     $value =~ s/\${\Q$k\E}/$ENV{$k}/gxms;
                    333:                 }
                    334:                 $value =~ s/\$\w+//gxms;
                    335:                 $value =~ s/\${\w+}//gxms;
                    336:
                    337:                 $config{$key} = $value;
                    338:             }
                    339:         }
                    340:     }
                    341:     close $fh;
1.1       andrew    342:
1.2       andrew    343:     my %lc_config;
                    344:     foreach my $k ( keys %config ) {
                    345:         $lc_config{ lc($k) } = $config{$k};
                    346:     }
1.1       andrew    347:
1.2       andrew    348:     return \%lc_config;
1.1       andrew    349: }

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