Return to todo.pl CVS log

Up to [local] / todotxt / Text-Todo / bin

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

1.1       andrew      1: #!/usr/bin/perl
1.2     ! andrew      2: # $RedRiver: todo.pl,v 1.1 2010/01/09 05:25:44 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';
        !            25:
        !            26: my %actions = (
        !            27:     add      => \&unsupported,
        !            28:     addto    => \&unsupported,
        !            29:     append   => \&unsupported,
        !            30:     archive  => \&unsupported,
        !            31:     command  => \&unsupported,
        !            32:     del      => \&unsupported,
        !            33:     depri    => \&unsupported,
        !            34:     do       => \&unsupported,
        !            35:     help     => \&unsupported,
        !            36:     list     => \&list,
        !            37:     listall  => \&unsupported,
        !            38:     listcon  => \&unsupported,
        !            39:     listfile => \&unsupported,
        !            40:     listpri  => \&unsupported,
        !            41:     listproj => \&unsupported,
        !            42:     move     => \&unsupported,
        !            43:     prepend  => \&unsupported,
        !            44:     pri      => \&unsupported,
        !            45:     replace  => \&unsupported,
        !            46:     report   => \&unsupported,
        !            47: );
        !            48:
        !            49: my %aliases = (
        !            50:     a     => 'add',
        !            51:     app   => 'append',
        !            52:     rm    => 'del',
        !            53:     dp    => 'depri',
        !            54:     ls    => 'list',
        !            55:     lsa   => 'listall',
        !            56:     lsc   => 'listcon',
        !            57:     lf    => 'listfile',
        !            58:     lsp   => 'listri',
        !            59:     lsprj => 'listproj',
        !            60:     mv    => 'move',
        !            61:     prep  => 'prepend',
        !            62:     p     => 'pri',
        !            63: );
        !            64:
        !            65: my %opts;
        !            66: getopts( '@+d:fhpPntvV', \%opts );
        !            67:
        !            68: my $action = shift @ARGV;
        !            69: if ( $action && $action eq 'command' ) {
        !            70:
        !            71:     # We don't support action scripts so . . .
        !            72:     $action = shift @ARGV;
        !            73: }
        !            74: if ( $action && exists $aliases{$action} ) {
        !            75:     $action = $aliases{$action};
        !            76: }
        !            77:
        !            78: if ( $opts{h} || !$action ) {
        !            79:     usage( $opts{h} );
        !            80: }
        !            81:
        !            82: my @unsupported = grep { defined $opts{$_} } qw( @ + f h p P n t v V );
        !            83: if (@unsupported) {
        !            84:     die 'Unsupported options: ' . ( join q{, }, @unsupported ) . "\n";
        !            85: }
        !            86:
        !            87: if ( $opts{d} ) {
        !            88:     $config_file = $opts{d};
        !            89: }
        !            90:
        !            91: if ( exists $actions{$action} ) {
        !            92:     my $config = read_config($config_file);
        !            93:     my $action = $actions{$action}->( $config, @ARGV );
        !            94: }
        !            95: else {
        !            96:     usage();
        !            97: }
        !            98:
        !            99: sub list {
        !           100:     my ($config) = @_;
        !           101:     my $todo = Text::Todo->new($config);
        !           102:     $todo->load( $config->{todo_file} ) || die "Couldn't load todo_file\n";
        !           103:
        !           104:     foreach my $entry ( sort { lc $a->text cmp lc $b->text } $todo->list ) {
        !           105:         print $entry->text, "\n" or warn "Couldn't print: \n";
        !           106:     }
        !           107: }
        !           108:
        !           109: sub unsupported { die "Unsupported action\n" }
        !           110:
        !           111: sub usage {
        !           112:     my ($long) = @_;
        !           113:
        !           114:     print <<'EOL';
        !           115:   * command list taken from todo.sh for compatibility
        !           116:   Usage: todo.pl [-fhpantvV] [-d todo_config] action
        !           117:
        !           118: EOL
        !           119:
        !           120:     if ($long) {
        !           121:         print <<'EOL';
        !           122:   Actions:
        !           123:     add|a "THING I NEED TO DO +project @context"
        !           124:     addto DEST "TEXT TO ADD"
        !           125:     append|app NUMBER "TEXT TO APPEND"
        !           126:     archive
        !           127:     command [ACTIONS]
        !           128:     del|rm NUMBER [TERM]
        !           129:     dp|depri NUMBER
        !           130:     do NUMBER
        !           131:     help
        !           132:     list|ls [TERM...]
        !           133:     listall|lsa [TERM...]
        !           134:     listcon|lsc
        !           135:     listfile|lf SRC [TERM...]
        !           136:     listpri|lsp [PRIORITY]
        !           137:     listproj|lsprj
        !           138:     move|mv NUMBER DEST [SRC]
        !           139:     prepend|prep NUMBER "TEXT TO PREPEND"
        !           140:     pri|p NUMBER PRIORITY
        !           141:     replace NUMBER "UPDATED TODO"
        !           142:     report
        !           143: EOL
        !           144:     }
        !           145:     else {
        !           146:         print <<'EOL';
        !           147: Try 'todo.pl -h' for more information.
        !           148: EOL
        !           149:     }
        !           150:
        !           151:     exit;
        !           152: }
        !           153:
        !           154: sub read_config {
        !           155:     my ($file) = @_;
        !           156:
        !           157:     my %config;
        !           158:     open my $fh, '<', $file or die "Unable to open [$file]: $!";
        !           159: LINE: while (<$fh>) {
        !           160:         s/\r?\n$//xms;
        !           161:         s/\s*\#.*$//xms;
        !           162:         next LINE unless $_;
        !           163:
        !           164:         if (s/^\s*export\s+//xms) {
        !           165:             my ( $key, $value ) = /^([^=]+)\s*=\s*"?(.*?)"?\s*$/xms;
        !           166:             if ($key) {
        !           167:                 foreach my $k ( keys %config ) {
        !           168:                     $value =~ s/\$\Q$k\E/$config{$k}/gxms;
        !           169:                     $value =~ s/\${\Q$k\E}/$config{$k}/gxms;
        !           170:                 }
        !           171:                 foreach my $k ( keys %ENV ) {
        !           172:                     $value =~ s/\$\Q$k\E/$ENV{$k}/gxms;
        !           173:                     $value =~ s/\${\Q$k\E}/$ENV{$k}/gxms;
        !           174:                 }
        !           175:                 $value =~ s/\$\w+//gxms;
        !           176:                 $value =~ s/\${\w+}//gxms;
        !           177:
        !           178:                 $config{$key} = $value;
        !           179:             }
        !           180:         }
        !           181:     }
        !           182:     close $fh;
1.1       andrew    183:
1.2     ! andrew    184:     my %lc_config;
        !           185:     foreach my $k ( keys %config ) {
        !           186:         $lc_config{ lc($k) } = $config{$k};
        !           187:     }
1.1       andrew    188:
1.2     ! andrew    189:     return \%lc_config;
1.1       andrew    190: }