[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.3 and 1.22

version 1.3, 2010/01/10 22:59:16 version 1.22, 2010/02/16 01:13:12
Line 1 
Line 1 
 #!/usr/bin/perl  #!/usr/bin/perl
 # $RedRiver: todo.pl,v 1.2 2010/01/10 07:13:54 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 85 
Line 83 
     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) {
     warn 'Unsupported options: ' . ( join q{, }, @unsupported ) . "\n";      warn 'Unsupported options: ' . ( join q{, }, @unsupported ) . "\n";
 }  }
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();
 }  }
   
 sub add {  sub add {
     my ( $config, $entry ) = @_;      my ( $config, @entry ) = @_;
     if ( !$entry ) {      if ( !@entry ) {
         die "usage: todo.pl add 'item'\n";          die "usage: todo.pl add 'item'\n";
     }      }
   
       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 121 
Line 121 
 }  }
   
 sub addto {  sub addto {
     my ( $config, $file, $entry ) = @_;      my ( $config, $file, @entry ) = @_;
     if ( !( $file && $entry ) ) {      if ( !( $file && @entry ) ) {
         die "usage: todo.pl addto DEST 'TODO ITEM'\n";          die "usage: todo.pl addto DEST 'TODO ITEM'\n";
     }      }
   
       my $entry = join q{ }, @entry;
   
     my $todo = Text::Todo->new($config);      my $todo = Text::Todo->new($config);
   
     $file = $todo->file($file);      $file = $todo->file($file);
Line 140 
Line 142 
     die "Unable to add [$entry]\n";      die "Unable to add [$entry]\n";
 }  }
   
 sub append    { return &unsupported }  sub append {
 sub archive   { return &unsupported }      my ( $config, $line, @text ) = @_;
 sub command   { return &unsupported }      if ( !( $line && @text && $line =~ /^\d+$/xms ) ) {
 sub del       { return &unsupported }          die 'usage: todo.pl append ITEM# "TEXT TO APPEND"' . "\n";
 sub depri     { return &unsupported }      }
 sub mark_done { return &unsupported }  
 sub help      { return &unsupported }  
   
       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 ( $config, $term ) = @_;
     my $todo = Text::Todo->new($config);      my $todo = Text::Todo->new($config);
Line 199 
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 223 
Line 317 
     return print map {"\+$_\n"} $todo->listproj;      return print map {"\+$_\n"} $todo->listproj;
 }  }
   
 sub move    { return &unsupported }  ## no critic 'sigal'
 sub prepend { return &unsupported }  sub move { return &unsupported }
 sub pri     { 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 replace { return &unsupported }
 sub report  { return &unsupported }  sub report  { return &unsupported }
   ## use critic
   
 sub _number_list {  sub _number_list {
     my (@list) = @_;      my (@list) = @_;
Line 238 
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;
     foreach my $e (      my @sorted = map { sprintf '%02d %s', $_->{line}, $_->{entry}->text }
         sort { lc $a->{entry}->text cmp lc $b->{entry}->text }          sort { lc $a->{entry}->text cmp lc $b->{entry}->text } @list;
         grep { $_->{entry}->text =~ /$term/xms } @list  
         )      foreach my $line ( grep {/$term/xms} @sorted ) {
     {          print "$line\n";
         printf "%02d %s\n", $e->{line}, $e->{entry}->text;  
         $shown++;          $shown++;
     }      }
   
Line 314 
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.3  
changed lines
  Added in v.1.22
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>