=================================================================== RCS file: /cvs/todotxt/Text-Todo/bin/todo.pl,v retrieving revision 1.9 retrieving revision 1.22 diff -u -r1.9 -r1.22 --- todotxt/Text-Todo/bin/todo.pl 2010/01/11 00:17:38 1.9 +++ todotxt/Text-Todo/bin/todo.pl 2010/02/16 01:13:12 1.22 @@ -1,5 +1,5 @@ #!/usr/bin/perl -# $RedRiver: todo.pl,v 1.7 2010/01/10 23:58:11 andrew Exp $ +# $AFresh1: todo.pl,v 1.21 2010/02/03 18:14:01 andrew Exp $ ######################################################################## # todo.pl *** a perl version of todo.sh. Uses Text::Todo. # @@ -13,12 +13,10 @@ use strict; use warnings; -use Data::Dumper; - use Getopt::Std; use Text::Todo; -use version; our $VERSION = qv('0.0.1'); +use version; our $VERSION = qv('0.1.2'); # option defaults my $config_file = $ENV{HOME} . '/todo.cfg'; @@ -69,7 +67,7 @@ ); my %opts; -getopts( '@+d:fhpPntvV', \%opts ); +getopts( q{+d:fhpPntvV@}, \%opts ); my $action = shift @ARGV; if ( $action && $action eq 'command' ) { @@ -96,7 +94,7 @@ if ( exists $actions{$action} ) { my $config = read_config($config_file); - my $action = $actions{$action}->( $config, @ARGV ); + my $result = $actions{$action}->( $config, @ARGV ); } else { usage(); @@ -111,7 +109,7 @@ my $entry = join q{ }, @entry; my $todo = Text::Todo->new($config); - if ( $todo->add($entry) ) { + if ( $todo->add($entry) && $todo->save ) { my @list = $todo->list; my $lines = scalar @list; @@ -174,7 +172,9 @@ die "Unable to archive $file\n"; } +## no critic 'sigal' sub command { return &unsupported } +## use critic sub del { my ( $config, $line ) = @_; @@ -183,8 +183,8 @@ } my $todo = Text::Todo->new($config); - my $entry = $todo->list->[$line - 1]; - print "Delete '" . $entry->text . "'? (y/n)\n"; + my $entry = $todo->list->[ $line - 1 ]; + print 'Delete \'', $entry->text . "'? (y/n)\n"; warn "XXX No delete confirmation currently!\n"; if ( $opts{n} ) { @@ -205,7 +205,7 @@ sub depri { my ( $config, $line ) = @_; if ( !( $line && $line =~ /^\d+$/xms ) ) { - die 'usage: todo.pl del ITEM#' . "\n"; + die 'usage: todo.pl depri ITEM#' . "\n"; } my $todo = Text::Todo->new($config); @@ -217,9 +217,31 @@ die "Unable to deprioritize entry\n"; } -sub mark_done { return &unsupported } -sub help { return &unsupported } +# since "do" is reserved +sub mark_done { + my ( $config, $line ) = @_; + if ( !( $line && $line =~ /^\d+$/xms ) ) { + die 'usage: todo.pl del ITEM#' . "\n"; + } + my $todo = Text::Todo->new($config); + my $entry = $todo->list->[ $line - 1 ]; + + if ( $entry->do && $todo->save ) { + my $status = print $line, ': ', $entry->text, "\n", + 'TODO: ', $line, " marked as done.\n"; + if ( !$opts{a} ) { + return archive($config); + } + return $status; + } + die "Unable to mark as done\n"; +} + +## no critic 'sigal' +sub help { return &unsupported } +## use critic + sub list { my ( $config, $term ) = @_; my $todo = Text::Todo->new($config); @@ -271,7 +293,7 @@ my @pri_list; if ($pri) { $pri = uc $pri; - if ( $pri !~ /^[A-Z]$/xms ) { + if ( $pri !~ /^[[:upper:]]$/xms ) { die "usage: todo.pl listpri PRIORITY\n", "note: PRIORITY must a single letter from A to Z.\n"; } @@ -295,10 +317,12 @@ return print map {"\+$_\n"} $todo->listproj; } -sub move { return &unsupported } +## no critic 'sigal' +sub move { return &unsupported } +## use critic sub prepend { - my ( $config, $line, @text) = @_; + my ( $config, $line, @text ) = @_; if ( !( $line && @text && $line =~ /^\d+$/xms ) ) { die 'usage: todo.pl prepend ITEM# "TEXT TO PREPEND"' . "\n"; } @@ -314,9 +338,31 @@ die "Unable to prepend\n"; } -sub pri { return &unsupported } +sub pri { + my ( $config, $line, $priority ) = @_; + my $error = 'usage: todo.pl pri ITEM# PRIORITY'; + if ( !( $line && $line =~ /^\d+$/xms && $priority ) ) { + die "$error\n"; + } + elsif ( $priority !~ /^[[:upper:]]$/xms ) { + $error .= "\n" . 'note: PRIORITY must a single letter from A to Z.'; + die "$error\n"; + } + + my $todo = Text::Todo->new($config); + + my $entry = $todo->list->[ $line - 1 ]; + if ( $entry->pri($priority) && $todo->save ) { + return print $line, ': ', $entry->text, "\n", + 'TODO: ', $line, ' prioritized (', $entry->priority, ").\n"; + } + die "Unable to prioritize entry\n"; +} + +## no critic 'sigal' sub replace { return &unsupported } sub report { return &unsupported } +## use critic sub _number_list { my (@list) = @_; @@ -327,15 +373,14 @@ sub _show_sorted_list { my ( $term, @list ) = @_; - $term = defined $term ? quotemeta($term) : ''; + $term = defined $term ? quotemeta($term) : q{}; my $shown = 0; - my @sorted - = map { sprintf "%02d %s", $_->{line}, $_->{entry}->text } + my @sorted = map { sprintf '%02d %s', $_->{line}, $_->{entry}->text } sort { lc $a->{entry}->text cmp lc $b->{entry}->text } @list; foreach my $line ( grep {/$term/xms} @sorted ) { - print $line, "\n"; + print "$line\n"; $shown++; } @@ -403,36 +448,176 @@ my ($file) = @_; my %config; - open my $fh, '<', $file or die "Unable to open [$file] : $!"; + open my $fh, '<', $file or die "Unable to open [$file] : $!\n"; LINE: while (<$fh>) { - s/\r?\n$//xms; - s/\s*\#.*$//xms; - next LINE unless $_; - - if (s/^\s*export\s+//xms) { - my ( $key, $value ) = /^([^=]+)\s*=\s*"?(.*?)"?\s*$/xms; - if ($key) { - foreach my $k ( keys %config ) { - $value =~ s/\$\Q$k\E/$config{$k}/gxms; - $value =~ s/\${\Q$k\E}/$config{$k}/gxms; - } - foreach my $k ( keys %ENV ) { - $value =~ s/\$\Q$k\E/$ENV{$k}/gxms; - $value =~ s/\${\Q$k\E}/$ENV{$k}/gxms; - } - $value =~ s/\$\w+//gxms; - $value =~ s/\${\w+}//gxms; - - $config{$key} = $value; - } - } + _parse_line( $_, \%config ); } - close $fh; + close $fh or die "Unable to close [$file]: $!\n"; my %lc_config; foreach my $k ( keys %config ) { - $lc_config{ lc($k) } = $config{$k}; + $lc_config{ lc $k } = $config{$k}; } return \%lc_config; } + +sub _parse_line { + my ( $line, $config ) = @_; + + $line =~ s/\r?\n$//xms; + $line =~ s/\s*\#.*$//xms; + return if !$line; + + if (s/^\s*export\s+//xms) { + my ( $key, $value ) = /^([^=]+)\s*=\s*"?(.*?)"?\s*$/xms; + if ($key) { + foreach my $k ( keys %{ $config } ) { + $value =~ s/\$\Q$k\E/$config->{$k}/gxms; + $value =~ s/\${\Q$k\E}/$config->{$k}/gxms; + } + foreach my $k ( keys %ENV ) { + $value =~ s/\$\Q$k\E/$ENV{$k}/gxms; + $value =~ s/\${\Q$k\E}/$ENV{$k}/gxms; + } + $value =~ s/\$\w+//gxms; + $value =~ s/\${\w+}//gxms; + + $config->{$key} = $value; + } + } + + return 1; +} + +__END__ + +=head1 NAME + +todo.pl - a perl replacement for todo.sh + + +=head1 VERSION + +Since the $VERSION can't be automatically included, +here is the RCS Id instead, you'll have to look up $VERSION. + + $Id: todo.pl,v 1.22 2010/02/16 01:13:12 andrew Exp $ + + +=head1 SYNOPSIS + + todo.pl list + + todo.pl -h + +=head1 DESCRIPTION + +Mostly compatible with todo.sh but not completely. +Any differences are either noted under limitations is a bug. + +Ideally todo.pl should pass all the todo.sh tests. + +This is a proof of concept to get the Text::Todo modules used. + +The modules are there to give more access to my todo.txt file from more +places. My goal is a web API for a web interface and then a WebOS version for +my Palm Pre. + +For more information see L + +=head1 USAGE + +See todo.pl -h + +=head1 OPTIONS + +See todo.pl -h + +=head1 REQUIRED ARGUMENTS + +See todo.pl -h + +=head1 CONFIGURATION AND ENVIRONMENT + +todo.pl should read the todo.cfg file that todo.sh uses. It is a very +simplistic reader and would probably be easy to break. + +It only uses TODO_DIR, TODO_FILE and DONE_DIR + +It does not currently support any of the environment variables that todo.sh +uses. + +=head1 DIAGNOSTICS + +=head1 DEPENDENCIES + +Perl Modules: + +=over + +=item Text::Todo + +=item version + +=back + + +=head1 INCOMPATIBILITIES + +Text::Todo::Entry actually checks if the entry is done before marking it +complete again. + +Text::Todo::Entry will keep the completed marker and then the priority at the +beginning of the line in that order. + + +=head1 BUGS AND LIMITATIONS + +No bugs have been reported. + +Known limitations: + +Does not support some command line arguments. + @, +, f, h, p, P, t, v or V. + +Does not yet support some actions. Specifically, command, help and report. + +Does not colorize output. + + +=head1 AUTHOR + +Andrew Fresh C<< >> + + +=head1 LICENSE AND COPYRIGHT + +Copyright (c) 2009, Andrew Fresh C<< >>. All rights reserved. + +This module is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. See L. + + +=head1 DISCLAIMER OF WARRANTY + +BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER +EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE +ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH +YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL +NECESSARY SERVICING, REPAIR, OR CORRECTION. + +IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE +LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, +OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE +THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING +RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A +FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF +SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES.