[BACK]Return to todo.pl CVS log [TXT][DIR] Up to [local] / todotxt / Text-Todo / bin

Diff for /todotxt/Text-Todo/bin/todo.pl between version 1.12 and 1.22

version 1.12, 2010/01/11 01:41:21 version 1.22, 2010/02/16 01:13:12
Line 1 
Line 1 
 #!/usr/bin/perl  #!/usr/bin/perl
 # $RedRiver: todo.pl,v 1.9 2010/01/11 00:17:38 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.  # todo.pl *** a perl version of todo.sh. Uses Text::Todo.
 #  #
Line 13 
Line 13 
 use strict;  use strict;
 use warnings;  use warnings;
   
 use Data::Dumper;  
   
 use Getopt::Std;  use Getopt::Std;
 use Text::Todo;  use Text::Todo;
   
 use version; our $VERSION = qv('0.0.1');  use version; our $VERSION = qv('0.1.2');
   
 # option defaults  # option defaults
 my $config_file = $ENV{HOME} . '/todo.cfg';  my $config_file = $ENV{HOME} . '/todo.cfg';
Line 69 
Line 67 
 );  );
   
 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' ) {
Line 96 
Line 94 
   
 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();
Line 111 
Line 109 
     my $entry = join q{ }, @entry;      my $entry = join q{ }, @entry;
   
     my $todo = Text::Todo->new($config);      my $todo = Text::Todo->new($config);
     if ( $todo->add($entry) ) {      if ( $todo->add($entry) && $todo->save ) {
         my @list  = $todo->list;          my @list  = $todo->list;
         my $lines = scalar @list;          my $lines = scalar @list;
   
Line 174 
Line 172 
     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 ) = @_;
Line 184 
Line 184 
     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} ) {
Line 218 
Line 218 
 }  }
   
 # 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";
Line 230 
Line 230 
     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;
Line 238 
Line 238 
     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 ) = @_;
Line 291 
Line 293 
     my @pri_list;      my @pri_list;
     if ($pri) {      if ($pri) {
         $pri = uc $pri;          $pri = uc $pri;
         if ( $pri !~ /^[A-Z]$/xms ) {          if ( $pri !~ /^[[:upper:]]$/xms ) {
             die "usage: todo.pl listpri PRIORITY\n",              die "usage: todo.pl listpri PRIORITY\n",
                 "note: PRIORITY must a single letter from A to Z.\n";                  "note: PRIORITY must a single letter from A to Z.\n";
         }          }
Line 315 
Line 317 
     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 ) = @_;
Line 338 
Line 342 
     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 !~ /^[[:upper:]]$/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);
Line 355 
Line 359 
     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) = @_;
Line 367 
Line 373 
   
 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++;
     }      }
   
Line 442 
Line 448 
     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.
Legend:
Removed from v.1.12  
changed lines
  Added in v.1.22
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>