version 1.14, 2010/01/11 19:52:06 |
version 1.15, 2010/01/12 20:30:55 |
|
|
#!/usr/bin/perl |
#!/usr/bin/perl |
# $AFresh1: todo.pl,v 1.13 2010/01/11 02:35:39 andrew Exp $ |
# $AFresh1: todo.pl,v 1.14 2010/01/11 19:52:06 andrew Exp $ |
######################################################################## |
######################################################################## |
# todo.pl *** a perl version of todo.sh. Uses Text::Todo. |
# todo.pl *** a perl version of todo.sh. Uses Text::Todo. |
# |
# |
|
|
); |
); |
|
|
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' ) { |
|
|
die "Unable to archive $file\n"; |
die "Unable to archive $file\n"; |
} |
} |
|
|
|
## no critic 'sigal' |
sub command { return &unsupported } |
sub command { return &unsupported } |
|
## use critic |
|
|
sub del { |
sub del { |
my ( $config, $line ) = @_; |
my ( $config, $line ) = @_; |
|
|
my $todo = Text::Todo->new($config); |
my $todo = Text::Todo->new($config); |
|
|
my $entry = $todo->list->[ $line - 1 ]; |
my $entry = $todo->list->[ $line - 1 ]; |
print "Delete '" . $entry->text . "'? (y/n)\n"; |
print 'Delete \'', $entry->text . "'? (y/n)\n"; |
warn "XXX No delete confirmation currently!\n"; |
warn "XXX No delete confirmation currently!\n"; |
|
|
if ( $opts{n} ) { |
if ( $opts{n} ) { |
|
|
} |
} |
|
|
# since "do" is reserved |
# since "do" is reserved |
sub mark_done { |
sub mark_done { |
my ( $config, $line ) = @_; |
my ( $config, $line ) = @_; |
if ( !( $line && $line =~ /^\d+$/xms ) ) { |
if ( !( $line && $line =~ /^\d+$/xms ) ) { |
die 'usage: todo.pl del ITEM#' . "\n"; |
die 'usage: todo.pl del ITEM#' . "\n"; |
|
|
if ( $entry->do && $todo->save ) { |
if ( $entry->do && $todo->save ) { |
my $status = print $line, ': ', $entry->text, "\n", |
my $status = print $line, ': ', $entry->text, "\n", |
'TODO: ', $line, " marked as done.\n"; |
'TODO: ', $line, " marked as done.\n"; |
if (!$opts{a}) { |
if ( !$opts{a} ) { |
return archive($config); |
return archive($config); |
} |
} |
return $status; |
return $status; |
|
|
die "Unable to mark as done\n"; |
die "Unable to mark as done\n"; |
} |
} |
|
|
sub help { return &unsupported } |
## no critic 'sigal' |
|
sub help { return &unsupported } |
|
## use critic |
|
|
sub list { |
sub list { |
my ( $config, $term ) = @_; |
my ( $config, $term ) = @_; |
|
|
return print map {"\+$_\n"} $todo->listproj; |
return print map {"\+$_\n"} $todo->listproj; |
} |
} |
|
|
|
## no critic 'sigal' |
sub move { return &unsupported } |
sub move { return &unsupported } |
|
## use critic |
|
|
sub prepend { |
sub prepend { |
my ( $config, $line, @text ) = @_; |
my ( $config, $line, @text ) = @_; |
|
|
my ( $config, $line, $priority ) = @_; |
my ( $config, $line, $priority ) = @_; |
my $error = 'usage: todo.pl pri ITEM# PRIORITY'; |
my $error = 'usage: todo.pl pri ITEM# PRIORITY'; |
if ( !( $line && $line =~ /^\d+$/xms && $priority ) ) { |
if ( !( $line && $line =~ /^\d+$/xms && $priority ) ) { |
die $error; |
die "$error\n"; |
} |
} |
if ( $priority !~ /^[A-Z]$/xms ) { |
elsif ( $priority !~ /^[A-Z]$/xms ) { |
die $error . "\n" |
$error .= "\n" . 'note: PRIORITY must a single letter from A to Z.'; |
. "note: PRIORITY must a single letter from A to Z.\n"; |
die "$error\n"; |
} |
} |
|
|
my $todo = Text::Todo->new($config); |
my $todo = Text::Todo->new($config); |
|
|
die "Unable to prioritize entry\n"; |
die "Unable to prioritize entry\n"; |
} |
} |
|
|
|
## no critic 'sigal' |
sub replace { return &unsupported } |
sub replace { return &unsupported } |
sub report { return &unsupported } |
sub report { return &unsupported } |
|
## use critic |
|
|
sub _number_list { |
sub _number_list { |
my (@list) = @_; |
my (@list) = @_; |
|
|
|
|
sub _show_sorted_list { |
sub _show_sorted_list { |
my ( $term, @list ) = @_; |
my ( $term, @list ) = @_; |
$term = defined $term ? quotemeta($term) : ''; |
$term = defined $term ? quotemeta($term) : q{}; |
|
|
my $shown = 0; |
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; |
sort { lc $a->{entry}->text cmp lc $b->{entry}->text } @list; |
|
|
foreach my $line ( grep {/$term/xms} @sorted ) { |
foreach my $line ( grep {/$term/xms} @sorted ) { |
print $line, "\n"; |
print "$line\n"; |
$shown++; |
$shown++; |
} |
} |
|
|
|
|
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__ |
__END__ |
|
|
=head1 NAME |
=head1 NAME |
|
|
|
|
For more information see L<http://todotxt.com> |
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 |
=head1 CONFIGURATION AND ENVIRONMENT |
|
|
todo.pl should read the todo.cfg file that todo.sh uses. It is a very |
todo.pl should read the todo.cfg file that todo.sh uses. It is a very |
|
|
It does not currently support any of the environment variables that todo.sh |
It does not currently support any of the environment variables that todo.sh |
uses. |
uses. |
|
|
|
=head1 DIAGNOSTICS |
|
|
=head1 DEPENDENCIES |
=head1 DEPENDENCIES |
|
|