===================================================================
RCS file: /cvs/todotxt/Text-Todo/bin/todo.pl,v
retrieving revision 1.4
retrieving revision 1.14
diff -u -r1.4 -r1.14
--- todotxt/Text-Todo/bin/todo.pl	2010/01/10 23:26:04	1.4
+++ todotxt/Text-Todo/bin/todo.pl	2010/01/11 19:52:06	1.14
@@ -1,5 +1,5 @@
 #!/usr/bin/perl
-# $RedRiver: todo.pl,v 1.3 2010/01/10 22:59:16 andrew Exp $
+# $AFresh1: todo.pl,v 1.13 2010/01/11 02:35:39 andrew Exp $
 ########################################################################
 # todo.pl *** a perl version of todo.sh. Uses Text::Todo.
 #
@@ -85,7 +85,7 @@
     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) {
     warn 'Unsupported options: ' . ( join q{, }, @unsupported ) . "\n";
 }
@@ -103,11 +103,13 @@
 }
 
 sub add {
-    my ( $config, $entry ) = @_;
-    if ( !$entry ) {
+    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;
@@ -121,11 +123,13 @@
 }
 
 sub addto {
-    my ( $config, $file, $entry ) = @_;
-    if ( !( $file && $entry ) ) {
+    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);
@@ -141,11 +145,13 @@
 }
 
 sub append {
-    my ( $config, $line, $text ) = @_;
-    if ( !( $line && $text && $line =~ /^\d+$/xms ) ) {
+    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 ];
 
@@ -155,11 +161,83 @@
     die "Unable to append\n";
 }
 
-sub archive   { return &unsupported }
-sub command   { return &unsupported }
-sub del       { return &unsupported }
-sub depri     { return &unsupported }
-sub mark_done { return &unsupported }
+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";
+}
+
+sub command { return &unsupported }
+
+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";
+}
+
 sub help      { return &unsupported }
 
 sub list {
@@ -237,9 +315,46 @@
     return print map {"\+$_\n"} $todo->listproj;
 }
 
-sub move    { return &unsupported }
-sub prepend { return &unsupported }
-sub pri     { return &unsupported }
+sub move { return &unsupported }
+
+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;
+    }
+    if ( $priority !~ /^[A-Z]$/xms ) {
+        die $error . "\n"
+            . "note: PRIORITY must a single letter from A to Z.\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";
+}
+
 sub replace { return &unsupported }
 sub report  { return &unsupported }
 
@@ -255,8 +370,7 @@
     $term = defined $term ? quotemeta($term) : '';
 
     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;
 
     foreach my $line ( grep {/$term/xms} @sorted ) {
@@ -328,7 +442,7 @@
     my ($file) = @_;
 
     my %config;
-    open my $fh, '< ', $file or die "Unable to open [$file]: $!";
+    open my $fh, '<', $file or die "Unable to open [$file] : $!";
 LINE: while (<$fh>) {
         s/\r?\n$//xms;
         s/\s*\#.*$//xms;
@@ -361,3 +475,123 @@
 
     return \%lc_config;
 }
+
+__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: todo.pl,v 1.14 2010/01/11 19:52:06 andrew Exp $
+
+
+=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 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 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.