version 1.2, 2010/01/10 07:13:54 |
version 1.17, 2010/01/16 06:07:13 |
|
|
#!/usr/bin/perl |
#!/usr/bin/perl |
# $RedRiver: todo.pl,v 1.1 2010/01/09 05:25:44 andrew Exp $ |
# $AFresh1: todo.pl,v 1.16 2010/01/12 23:46:40 andrew Exp $ |
######################################################################## |
######################################################################## |
# todo.pl *** a perl version of todo.sh. Uses Text::Todo. |
# todo.pl *** a perl version of todo.sh. Uses Text::Todo. |
# |
# |
|
|
use strict; |
use strict; |
use warnings; |
use warnings; |
|
|
use Data::Dumper; |
|
|
|
use Getopt::Std; |
use Getopt::Std; |
use Text::Todo; |
use Text::Todo; |
|
|
|
|
|
|
# option defaults |
# option defaults |
my $config_file = $ENV{HOME} . '/todo.cfg'; |
my $config_file = $ENV{HOME} . '/todo.cfg'; |
|
CONFIG: foreach my $f ( $config_file, $ENV{HOME} . '/.todo.cfg', ) { |
|
if ( -e $f ) { |
|
$config_file = $f; |
|
last CONFIG; |
|
} |
|
} |
|
|
my %actions = ( |
my %actions = ( |
add => \&unsupported, |
add => \&add, |
addto => \&unsupported, |
addto => \&addto, |
append => \&unsupported, |
append => \&append, |
archive => \&unsupported, |
archive => \&archive, |
command => \&unsupported, |
command => \&command, |
del => \&unsupported, |
del => \&del, |
depri => \&unsupported, |
depri => \&depri, |
do => \&unsupported, |
do => \&mark_done, |
help => \&unsupported, |
help => \&help, |
list => \&list, |
list => \&list, |
listall => \&unsupported, |
listall => \&listall, |
listcon => \&unsupported, |
listcon => \&listcon, |
listfile => \&unsupported, |
listfile => \&listfile, |
listpri => \&unsupported, |
listpri => \&listpri, |
listproj => \&unsupported, |
listproj => \&listproj, |
move => \&unsupported, |
move => \&move, |
prepend => \&unsupported, |
prepend => \&prepend, |
pri => \&unsupported, |
pri => \&pri, |
replace => \&unsupported, |
replace => \&replace, |
report => \&unsupported, |
report => \&report, |
); |
); |
|
|
my %aliases = ( |
my %aliases = ( |
|
|
lsa => 'listall', |
lsa => 'listall', |
lsc => 'listcon', |
lsc => 'listcon', |
lf => 'listfile', |
lf => 'listfile', |
lsp => 'listri', |
lsp => 'listpri', |
lsprj => 'listproj', |
lsprj => 'listproj', |
mv => 'move', |
mv => 'move', |
prep => 'prepend', |
prep => 'prepend', |
|
|
); |
); |
|
|
my %opts; |
my %opts; |
getopts( '@+d:fhpPntvV', \%opts ); |
getopts( q{+d:fhpPntvV@}, \%opts ); |
|
|
my $action = shift @ARGV; |
my $action = shift @ARGV; |
if ( $action && $action eq 'command' ) { |
if ( $action && $action eq 'command' ) { |
|
|
usage( $opts{h} ); |
usage( $opts{h} ); |
} |
} |
|
|
my @unsupported = grep { defined $opts{$_} } qw( @ + f h p P n t v V ); |
my @unsupported = grep { defined $opts{$_} } qw( @ + f h p P t v V ); |
if (@unsupported) { |
if (@unsupported) { |
die 'Unsupported options: ' . ( join q{, }, @unsupported ) . "\n"; |
warn 'Unsupported options: ' . ( join q{, }, @unsupported ) . "\n"; |
} |
} |
|
|
if ( $opts{d} ) { |
if ( $opts{d} ) { |
|
|
|
|
if ( exists $actions{$action} ) { |
if ( exists $actions{$action} ) { |
my $config = read_config($config_file); |
my $config = read_config($config_file); |
my $action = $actions{$action}->( $config, @ARGV ); |
my $result = $actions{$action}->( $config, @ARGV ); |
} |
} |
else { |
else { |
usage(); |
usage(); |
} |
} |
|
|
|
sub add { |
|
my ( $config, @entry ) = @_; |
|
if ( !@entry ) { |
|
die "usage: todo.pl add 'item'\n"; |
|
} |
|
|
|
my $entry = join q{ }, @entry; |
|
|
|
my $todo = Text::Todo->new($config); |
|
if ( $todo->add($entry) ) { |
|
my @list = $todo->list; |
|
my $lines = scalar @list; |
|
|
|
print "TODO: '$entry' added on line $lines\n"; |
|
|
|
return $lines; |
|
} |
|
die "Unable to add [$entry]\n"; |
|
} |
|
|
|
sub addto { |
|
my ( $config, $file, @entry ) = @_; |
|
if ( !( $file && @entry ) ) { |
|
die "usage: todo.pl addto DEST 'TODO ITEM'\n"; |
|
} |
|
|
|
my $entry = join q{ }, @entry; |
|
|
|
my $todo = Text::Todo->new($config); |
|
|
|
$file = $todo->file($file); |
|
if ( $todo->addto( $file, $entry ) ) { |
|
my @list = $todo->listfile($file); |
|
my $lines = scalar @list; |
|
|
|
print "TODO: '$entry' added to $file on line $lines\n"; |
|
|
|
return $lines; |
|
} |
|
die "Unable to add [$entry]\n"; |
|
} |
|
|
|
sub append { |
|
my ( $config, $line, @text ) = @_; |
|
if ( !( $line && @text && $line =~ /^\d+$/xms ) ) { |
|
die 'usage: todo.pl append ITEM# "TEXT TO APPEND"' . "\n"; |
|
} |
|
|
|
my $text = join q{ }, @text; |
|
|
|
my $todo = Text::Todo->new($config); |
|
my $entry = $todo->list->[ $line - 1 ]; |
|
|
|
if ( $entry->append($text) && $todo->save ) { |
|
return printf "%02d: %s\n", $line, $entry->text; |
|
} |
|
die "Unable to append\n"; |
|
} |
|
|
|
sub archive { |
|
my ($config) = @_; |
|
my $todo = Text::Todo->new($config); |
|
|
|
my $file = $todo->file; |
|
|
|
my $archived = $todo->archive; |
|
if ( defined $archived ) { |
|
return print "TODO: $file archived.\n"; |
|
} |
|
die "Unable to archive $file\n"; |
|
} |
|
|
|
## no critic 'sigal' |
|
sub command { return &unsupported } |
|
## use critic |
|
|
|
sub del { |
|
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 ]; |
|
print 'Delete \'', $entry->text . "'? (y/n)\n"; |
|
warn "XXX No delete confirmation currently!\n"; |
|
|
|
if ( $opts{n} ) { |
|
if ( $todo->del($entry) && $todo->save ) { |
|
return print 'TODO: \'', $entry->text, "' deleted.\n"; |
|
} |
|
} |
|
else { |
|
my $text = $entry->text; |
|
if ( $entry->replace(q{}) && $todo->save ) { |
|
return print 'TODO: \'', $text, "' deleted.\n"; |
|
} |
|
} |
|
|
|
die "Unable to delete entry\n"; |
|
} |
|
|
|
sub depri { |
|
my ( $config, $line ) = @_; |
|
if ( !( $line && $line =~ /^\d+$/xms ) ) { |
|
die 'usage: todo.pl depri ITEM#' . "\n"; |
|
} |
|
my $todo = Text::Todo->new($config); |
|
|
|
my $entry = $todo->list->[ $line - 1 ]; |
|
if ( $entry->depri && $todo->save ) { |
|
return print $line, ': ', $entry->text, "\n", |
|
'TODO: ', $line, " deprioritized.\n"; |
|
} |
|
die "Unable to deprioritize entry\n"; |
|
} |
|
|
|
# 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 { |
sub list { |
|
my ( $config, $term ) = @_; |
|
my $todo = Text::Todo->new($config); |
|
|
|
my @list = _number_list( $todo->list ); |
|
my $shown = _show_sorted_list( $term, @list ); |
|
|
|
return _show_list_footer( $shown, scalar @list, $config->{todo_file} ); |
|
} |
|
|
|
sub listall { |
|
my ( $config, $term ) = @_; |
|
my $todo = Text::Todo->new($config); |
|
|
|
my @list = _number_list( |
|
$todo->listfile('todo_file'), |
|
$todo->listfile('done_file'), |
|
); |
|
my $shown = _show_sorted_list( $term, @list ); |
|
|
|
return _show_list_footer( $shown, scalar @list, $config->{'todo_dir'} ); |
|
} |
|
|
|
sub listcon { |
my ($config) = @_; |
my ($config) = @_; |
my $todo = Text::Todo->new($config); |
my $todo = Text::Todo->new($config); |
$todo->load( $config->{todo_file} ) || die "Couldn't load todo_file\n"; |
return print map {"\@$_\n"} $todo->listcon; |
|
} |
|
|
foreach my $entry ( sort { lc $a->text cmp lc $b->text } $todo->list ) { |
sub listfile { |
print $entry->text, "\n" or warn "Couldn't print: \n"; |
my ( $config, $file, $term ) = @_; |
|
if ( !$file ) { |
|
die "usage: todo.pl listfile SRC [TERM]\n"; |
} |
} |
|
my $todo = Text::Todo->new($config); |
|
|
|
my @list = _number_list( $todo->listfile($file) ); |
|
my $shown = _show_sorted_list( $term, @list ); |
|
|
|
return _show_list_footer( $shown, scalar @list, $file ); |
} |
} |
|
|
|
sub listpri { |
|
my ( $config, $pri ) = @_; |
|
|
|
my $todo = Text::Todo->new($config); |
|
|
|
my @list = _number_list( $todo->listfile('todo_file') ); |
|
my @pri_list; |
|
if ($pri) { |
|
$pri = uc $pri; |
|
if ( $pri !~ /^[[:upper:]]$/xms ) { |
|
die "usage: todo.pl listpri PRIORITY\n", |
|
"note: PRIORITY must a single letter from A to Z.\n"; |
|
} |
|
@pri_list = grep { |
|
defined $_->{entry}->priority |
|
&& $_->{entry}->priority eq $pri |
|
} @list; |
|
} |
|
else { |
|
@pri_list = grep { $_->{entry}->priority } @list; |
|
} |
|
|
|
my $shown = _show_sorted_list( undef, @pri_list ); |
|
|
|
return _show_list_footer( $shown, scalar @list, $config->{todo_file} ); |
|
} |
|
|
|
sub listproj { |
|
my ($config) = @_; |
|
my $todo = Text::Todo->new($config); |
|
return print map {"\+$_\n"} $todo->listproj; |
|
} |
|
|
|
## no critic 'sigal' |
|
sub move { return &unsupported } |
|
## use critic |
|
|
|
sub prepend { |
|
my ( $config, $line, @text ) = @_; |
|
if ( !( $line && @text && $line =~ /^\d+$/xms ) ) { |
|
die 'usage: todo.pl prepend ITEM# "TEXT TO PREPEND"' . "\n"; |
|
} |
|
|
|
my $text = join q{ }, @text; |
|
|
|
my $todo = Text::Todo->new($config); |
|
my $entry = $todo->list->[ $line - 1 ]; |
|
|
|
if ( $entry->prepend($text) && $todo->save ) { |
|
return printf "%02d: %s\n", $line, $entry->text; |
|
} |
|
die "Unable to prepend\n"; |
|
} |
|
|
|
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) = @_; |
|
|
|
my $line = 1; |
|
return map { { line => $line++, entry => $_, } } @list; |
|
} |
|
|
|
sub _show_sorted_list { |
|
my ( $term, @list ) = @_; |
|
$term = defined $term ? quotemeta($term) : q{}; |
|
|
|
my $shown = 0; |
|
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"; |
|
$shown++; |
|
} |
|
|
|
return $shown; |
|
} |
|
|
|
sub _show_list_footer { |
|
my ( $shown, $total, $file ) = @_; |
|
|
|
$shown ||= 0; |
|
$total ||= 0; |
|
|
|
print "-- \n"; |
|
print "TODO: $shown of $total tasks shown from $file\n"; |
|
|
|
return 1; |
|
} |
|
|
sub unsupported { die "Unsupported action\n" } |
sub unsupported { die "Unsupported action\n" } |
|
|
sub usage { |
sub usage { |
|
|
print <<'EOL'; |
print <<'EOL'; |
* command list taken from todo.sh for compatibility |
* command list taken from todo.sh for compatibility |
Usage: todo.pl [-fhpantvV] [-d todo_config] action |
Usage: todo.pl [-fhpantvV] [-d todo_config] action |
|
|
EOL |
EOL |
|
|
if ($long) { |
if ($long) { |
print <<'EOL'; |
print <<'EOL'; |
|
|
Actions: |
Actions: |
add|a "THING I NEED TO DO +project @context" |
add|a "THING I NEED TO DO +project @context" |
addto DEST "TEXT TO ADD" |
addto DEST "TEXT TO ADD" |
|
|
my ($file) = @_; |
my ($file) = @_; |
|
|
my %config; |
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>) { |
LINE: while (<$fh>) { |
s/\r?\n$//xms; |
_parse_line( $_, \%config ); |
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; |
|
} |
|
} |
|
} |
} |
close $fh; |
close $fh or die "Unable to close [$file]: $!\n"; |
|
|
my %lc_config; |
my %lc_config; |
foreach my $k ( keys %config ) { |
foreach my $k ( keys %config ) { |
$lc_config{ lc($k) } = $config{$k}; |
$lc_config{ lc $k } = $config{$k}; |
} |
} |
|
|
return \%lc_config; |
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$ |
|
|
|
|
|
=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<http://todotxt.com> |
|
|
|
=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<< <andrew@cpan.org> >> |
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
|
|
|
Copyright (c) 2009, Andrew Fresh C<< <andrew@cpan.org> >>. 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<perlartistic>. |
|
|
|
|
|
=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. |