version 1.1, 2010/01/09 05:25:44 |
version 1.3, 2010/01/10 22:59:16 |
|
|
#!/usr/bin/perl |
#!/usr/bin/perl |
# $RedRiver$ |
# $RedRiver: todo.pl,v 1.2 2010/01/10 07:13:54 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 warnings; |
use warnings; |
|
|
use Data::Dumper; |
use Data::Dumper; |
|
|
|
use Getopt::Std; |
use Text::Todo; |
use Text::Todo; |
|
|
use version; our $VERSION = qv('0.0.1'); |
use version; our $VERSION = qv('0.0.1'); |
|
|
my $todo = Text::Todo->new('t/todo1.txt') or die $!; |
# option defaults |
|
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; |
|
} |
|
} |
|
|
foreach my $entry ( sort { lc( $a->text ) cmp lc( $b->text ) } $todo->list ) { |
my %actions = ( |
|
add => \&add, |
|
addto => \&addto, |
|
append => \&append, |
|
archive => \&archive, |
|
command => \&command, |
|
del => \&del, |
|
depri => \&depri, |
|
do => \&mark_done, |
|
help => \&help, |
|
list => \&list, |
|
listall => \&listall, |
|
listcon => \&listcon, |
|
listfile => \&listfile, |
|
listpri => \&listpri, |
|
listproj => \&listproj, |
|
move => \&move, |
|
prepend => \&prepend, |
|
pri => \&pri, |
|
replace => \&replace, |
|
report => \&report, |
|
); |
|
|
#print Dumper $entry; |
my %aliases = ( |
print $entry->text, "\n"; |
a => 'add', |
|
app => 'append', |
|
rm => 'del', |
|
dp => 'depri', |
|
ls => 'list', |
|
lsa => 'listall', |
|
lsc => 'listcon', |
|
lf => 'listfile', |
|
lsp => 'listpri', |
|
lsprj => 'listproj', |
|
mv => 'move', |
|
prep => 'prepend', |
|
p => 'pri', |
|
); |
|
|
|
my %opts; |
|
getopts( '@+d:fhpPntvV', \%opts ); |
|
|
|
my $action = shift @ARGV; |
|
if ( $action && $action eq 'command' ) { |
|
|
|
# We don't support action scripts so . . . |
|
$action = shift @ARGV; |
|
} |
|
if ( $action && exists $aliases{$action} ) { |
|
$action = $aliases{$action}; |
|
} |
|
|
|
if ( $opts{h} || !$action ) { |
|
usage( $opts{h} ); |
|
} |
|
|
|
my @unsupported = grep { defined $opts{$_} } qw( @ + f h p P n t v V ); |
|
if (@unsupported) { |
|
warn 'Unsupported options: ' . ( join q{, }, @unsupported ) . "\n"; |
|
} |
|
|
|
if ( $opts{d} ) { |
|
$config_file = $opts{d}; |
|
} |
|
|
|
if ( exists $actions{$action} ) { |
|
my $config = read_config($config_file); |
|
my $action = $actions{$action}->( $config, @ARGV ); |
|
} |
|
else { |
|
usage(); |
|
} |
|
|
|
sub add { |
|
my ( $config, $entry ) = @_; |
|
if ( !$entry ) { |
|
die "usage: todo.pl add 'item'\n"; |
|
} |
|
|
|
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 $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 { return &unsupported } |
|
sub archive { return &unsupported } |
|
sub command { return &unsupported } |
|
sub del { return &unsupported } |
|
sub depri { return &unsupported } |
|
sub mark_done { return &unsupported } |
|
sub help { return &unsupported } |
|
|
|
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 $todo = Text::Todo->new($config); |
|
return print map {"\@$_\n"} $todo->listcon; |
|
} |
|
|
|
sub listfile { |
|
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 !~ /^[A-Z]$/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; |
|
} |
|
|
|
sub move { return &unsupported } |
|
sub prepend { return &unsupported } |
|
sub pri { return &unsupported } |
|
sub replace { return &unsupported } |
|
sub report { return &unsupported } |
|
|
|
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) : ''; |
|
|
|
my $shown = 0; |
|
foreach my $e ( |
|
sort { lc $a->{entry}->text cmp lc $b->{entry}->text } |
|
grep { $_->{entry}->text =~ /$term/xms } @list |
|
) |
|
{ |
|
printf "%02d %s\n", $e->{line}, $e->{entry}->text; |
|
$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 usage { |
|
my ($long) = @_; |
|
|
|
print <<'EOL'; |
|
* command list taken from todo.sh for compatibility |
|
Usage: todo.pl [-fhpantvV] [-d todo_config] action |
|
EOL |
|
|
|
if ($long) { |
|
print <<'EOL'; |
|
|
|
Actions: |
|
add|a "THING I NEED TO DO +project @context" |
|
addto DEST "TEXT TO ADD" |
|
append|app NUMBER "TEXT TO APPEND" |
|
archive |
|
command [ACTIONS] |
|
del|rm NUMBER [TERM] |
|
dp|depri NUMBER |
|
do NUMBER |
|
help |
|
list|ls [TERM...] |
|
listall|lsa [TERM...] |
|
listcon|lsc |
|
listfile|lf SRC [TERM...] |
|
listpri|lsp [PRIORITY] |
|
listproj|lsprj |
|
move|mv NUMBER DEST [SRC] |
|
prepend|prep NUMBER "TEXT TO PREPEND" |
|
pri|p NUMBER PRIORITY |
|
replace NUMBER "UPDATED TODO" |
|
report |
|
EOL |
|
} |
|
else { |
|
print <<'EOL'; |
|
Try 'todo.pl -h' for more information. |
|
EOL |
|
} |
|
|
|
exit; |
|
} |
|
|
|
sub read_config { |
|
my ($file) = @_; |
|
|
|
my %config; |
|
open my $fh, '< ', $file or die "Unable to open [$file]: $!"; |
|
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; |
|
} |
|
} |
|
} |
|
close $fh; |
|
|
|
my %lc_config; |
|
foreach my $k ( keys %config ) { |
|
$lc_config{ lc($k) } = $config{$k}; |
|
} |
|
|
|
return \%lc_config; |
} |
} |