[BACK]Return to Entry.pm CVS log [TXT][DIR] Up to [local] / todotxt / Text-Todo / lib / Text / Todo

Diff for /todotxt/Text-Todo/lib/Text/Todo/Entry.pm between version 1.7 and 1.28

version 1.7, 2009/07/13 19:05:50 version 1.28, 2010/02/14 00:50:56
Line 1 
Line 1 
 package Text::Todo::Entry;  package Text::Todo::Entry;
   
 # $RedRiver: Entry.pm,v 1.6 2009/07/13 17:50:37 andrew Exp $  # $AFresh1: Entry.pm,v 1.27 2010/02/13 23:06:34 andrew Exp $
   
 use warnings;  use warnings;
 use strict;  use strict;
 use Carp;  use Carp;
   
 use Class::Std::Utils;  use Class::Std::Utils;
 use List::Util qw/ first /;  
   
 use version; our $VERSION = qv('0.0.1');  use version; our $VERSION = qv('0.1.1');
   
 {  {
     my %text_of;  
   
     my %tags_of;      my @attr_refs = \(
     my %priority_of;          my %text_of,
     my %completion_status_of;  
   
     my %tags = (          my %tags_of,
         context => q{@},          my %priority_of,
         project => q{+},          my %completion_status_of,
           my %known_tags_of,
     );      );
   
     for my $tag ( keys %tags ) {      # XXX Should the completion (x) be case sensitive?
         ## no critic strict      my $priority_completion_regex = qr{
         no strict 'refs';    # Violates use strict, but allows code generation          ^ \s*
         ## use critic          (?i:(x \s* [\d-]* ) \s*)?
           (?i:\( ([A-Z]) \)   \s*)?
       }xms;
   
         *{ $tag . 's' } = sub {  
             my ($self) = @_;  
             return $self->_tags($tag);  
         };  
   
         *{ 'in_' . $tag } = sub {  
             my ( $self, $item ) = @_;  
             return $self->_is_in( $tag . 's', $item );  
         };  
     }  
   
     sub new {      sub new {
         my ( $class, $text ) = @_;          my ( $class, $options ) = @_;
   
         my $self = bless anon_scalar(), $class;          my $self = bless anon_scalar(), $class;
         my $ident = ident($self);          my $ident = ident($self);
   
         $self->_update_entry($text);          $text_of{$ident} = q{};
   
           if ( !ref $options ) {
               $options = { text => $options };
           }
           elsif ( ref $options ne 'HASH' ) {
               croak 'Invalid parameter passed!';
           }
   
           my %tags = (
               context => q{@},
               project => q{+},
           );
   
           if ( exists $options->{tags} && ref $options->{tags} eq 'HASH' ) {
               foreach my $k ( keys %{ $options->{tags} } ) {
                   $tags{$k} = $options->{tags}->{$k};
               }
           }
   
           for my $tag ( keys %tags ) {
               $self->learn_tag( $tag, $tags{$tag} );
           }
   
           $self->replace( $options->{text} );
   
         return $self;          return $self;
     }      }
   
     sub _update_entry {      sub _parse_entry {
           my ($self) = @_;
           my $ident = ident($self);
   
           delete $tags_of{$ident};
           delete $completion_status_of{$ident};
           delete $priority_of{$ident};
   
           my $text       = $self->text       || q{};
           my $known_tags = $self->known_tags || {};
   
           foreach my $tag ( keys %{$known_tags} ) {
               next if !defined $known_tags->{$tag};
               next if !length $known_tags->{$tag};
   
               my $sigal = quotemeta $known_tags->{$tag};
               $tags_of{$ident}{$tag}
                   = { map { $_ => q{} } $text =~ / (?:^|\s) $sigal (\S*)/gxms };
           }
   
           my ( $completed, $priority )
               = $text =~ / $priority_completion_regex /xms;
   
           $completion_status_of{$ident} = _clean_completed($completed);
           $priority_of{$ident}          = $priority;
   
           return 1;
       }
   
       sub _clean_completed {
           my ($completed) = @_;
   
           $completed ||= q{};
           $completed =~ s/^\s+|\s+$//gxms;
   
           if ( !$completed ) {
               return;
           }
   
           if ( $completed =~ s/(x)\s*//ixms ) {
               my $status = $1;
               if ($completed) {
                   return $completed;
               }
               else {
                   return $status;
               }
           }
   
           return;
       }
   
       sub replace {
         my ( $self, $text ) = @_;          my ( $self, $text ) = @_;
         my $ident = ident($self);          my $ident = ident($self);
   
Line 58 
Line 123 
   
         $text_of{$ident} = $text;          $text_of{$ident} = $text;
   
         foreach my $tag ( keys %tags ) {          return $self->_parse_entry;
             my $symbol = quotemeta $tags{$tag};      }
             $tags_of{$ident}{$tag} = { map { $_ => q{} }  
                     $text =~ / (?:^|\s) $symbol  (\S+)/gxms };      sub learn_tag {
           my ( $self, $tag, $sigal ) = @_;
           $known_tags_of{ ident $self}{$tag} = $sigal;
   
           ## no critic strict
           no strict 'refs';    # Violates use strict, but allows code generation
           ## use critic
   
           if ( !$self->can( $tag . 's' ) ) {
               *{ $tag . 's' } = sub {
                   my ($self) = @_;
                   return $self->_tags($tag);
               };
         }          }
         ( $completion_status_of{$ident} ) = $text =~ /^ \s*(x) /ixms;  
         ( $priority_of{$ident} )  
             = $text =~ /^ (?:\s*x)? \s* \( ([A-Z]) \)/ixms;  
   
         return 1;          if ( !$self->can( 'in_' . $tag ) ) {
               *{ 'in_' . $tag } = sub {
                   my ( $self, $item ) = @_;
                   return $self->_is_in( $tag . 's', $item );
               };
           }
   
           return $self->_parse_entry;
     }      }
   
     sub _tags {      sub _tags {
         my ( $self, $tag ) = @_;          my ( $self, $tag ) = @_;
         my $ident = ident($self);          my $ident = ident($self);
   
         my @tags = sort keys %{ $tags_of{$ident}{$tag} };          my @tags;
           if ( defined $tags_of{$ident}{$tag} ) {
               @tags = sort keys %{ $tags_of{$ident}{$tag} };
           }
         return wantarray ? @tags : \@tags;          return wantarray ? @tags : \@tags;
     }      }
   
     sub _is_in {      sub _is_in {
         my ( $self, $tags, $item ) = @_;          my ( $self, $tags, $item ) = @_;
         return defined first { $_ eq $item } $self->$tags;          return if !defined $item;
           foreach ( $self->$tags ) {
               return 1 if $_ eq $item;
           }
           return 0;
     }      }
   
     sub text {      sub pri {
         my ($self) = @_;          my ( $self, $new_pri ) = @_;
         my $ident = ident($self);          my $ident = ident($self);
   
         return $text_of{$ident};          if ( $new_pri !~ /^[a-zA-Z]?$/xms ) {
     }              croak "Invalid priority [$new_pri]";
           }
   
     sub priority {          $priority_of{$ident} = $new_pri;
         my ($self) = @_;  
         my $ident = ident($self);  
   
         return $priority_of{$ident};          return $self->prepend();
     }      }
   
     sub completed {  
         my ($self) = @_;  
         my $ident = ident($self);  
   
         return $completion_status_of{$ident};  
     }  
   
     sub change {  
         my ( $self, $text ) = @_;  
         return $self->_update_entry($text);  
     }  
   
     sub prepend {      sub prepend {
         my ( $self, $addition ) = @_;          my ( $self, $addition ) = @_;
   
         my $new = $self->text;          my $new = $self->text;
           my @new;
   
         if ( my $priority = $self->priority ) {          $new =~ s/$priority_completion_regex//xms;
             $new =~ s/^( \s* \( $priority \))/$1 $addition/xms;  
           if ( $self->done ) {
               if ( $self->done !~ /^x/ixms ) {
                   push @new, 'x';
               }
               push @new, $self->done;
         }          }
         else {  
             $new = join q{ }, $addition, $new;          if ( $self->priority ) {
               push @new, '(' . $self->priority . ')';
         }          }
   
         return $self->change($new);          if ( defined $addition && length $addition ) {
               push @new, $addition;
           }
   
           return $self->replace( join q{ }, @new, $new );
     }      }
   
     sub append {      sub append {
         my ( $self, $addition ) = @_;          my ( $self, $addition ) = @_;
         return $self->change( join q{ }, $self->text, $addition );          return $self->replace( join q{ }, $self->text, $addition );
     }      }
   
     sub complete {      ## no critic 'homonym'
       sub do {    # This is what it is called in todo.sh
           ## use critic
         my ($self) = @_;          my ($self) = @_;
           my $ident = ident($self);
   
         if ( $self->completed ) {          if ( $self->done ) {
             return 1;              return 1;
         }          }
   
         return $self->change( join q{ }, 'x', $self->text );          $completion_status_of{$ident} = sprintf "%04d-%02d-%02d",
               ( (localtime)[5] + 1900 ),
               ( (localtime)[4] + 1 ),
               ( (localtime)[3] );
   
           return $self->prepend();
     }      }
   
       sub done {
           my ($self) = @_;
           return $completion_status_of{ ident($self) };
       }
       sub known_tags { my ($self) = @_; return $known_tags_of{ ident($self) }; }
       sub priority   { my ($self) = @_; return $priority_of{ ident($self) }; }
       sub text       { my ($self) = @_; return $text_of{ ident($self) }; }
       sub depri      { my ($self) = @_; return $self->pri(q{}) }
   
       sub DESTROY {
           my ($self) = @_;
           my $ident = ident $self;
           foreach my $attr_ref (@attr_refs) {
               delete $attr_ref->{$ident};
           }
       }
 }  }
 1;    # Magic true value required at end of module  1;    # Magic true value required at end of module
 __END__  __END__
   
 =head1 NAME  =head1 NAME
   
 Text::Todo::Entry - [One line description of module's purpose here]  Text::Todo::Entry - An object for manipulating an entry on a Text::Todo list
   
   
 =head1 VERSION  =head1 VERSION
   
 This document describes Text::Todo::Entry version 0.0.1  Since the $VERSION can't be automatically included,
   here is the RCS Id instead, you'll have to look up $VERSION.
   
       $Id$
   
   
 =head1 SYNOPSIS  =head1 SYNOPSIS
   
     use Text::Todo::Entry;      use Text::Todo::Entry;
   
 =for author to fill in:      my $entry = Text::Todo::Entry->new('text of entry');
     Brief code example(s) here showing commonest usage(s).  
     This section will be as far as many users bother reading      $entry->append('+project');
     so make it as educational and exeplary as possible.  
       if ($entry->in_project('project') && ! $entry->priority) {
           print $entry->text, "\n";
       }
   
   
 =head1 DESCRIPTION  =head1 DESCRIPTION
   
 =for author to fill in:  This module creates entries in a Text::Todo list.
     Write a full description of the module and its features here.  It allows you to retrieve information about them and modify them.
     Use subsections (=head2, =head3) as appropriate.  
   
   For more information see L<http://todotxt.com>
   
   
 =head1 INTERFACE  =head1 INTERFACE
   
 =for author to fill in:  
     Write a separate section listing the public components of the modules  
     interface. These normally consist of either subroutines that may be  
     exported, or methods that may be called on objects belonging to the  
     classes provided by the module.  
   
 =head2 new  =head2 new
   
   Creates an entry that can be manipulated.
   
       my $entry = Text::Todo::Entry->new([
       'text of entry' | {
           [ text => 'text of entry' ,]
           [ tags => { additional_arg => 'identfier' }, ]
       } ]);
   
   If you don't pass any text, creates a blank entry.
   
   See tags below for a description of additional tags.
   
 =head2 text  =head2 text
   
   Returns the text of the entry.
   
       print $entry->text, "\n";
   
   =head2 pri
   
   Sets the priority of an entry. If the priority is set to an empty string,
   clears the priority.
   
       $entry->pri('B');
   
   Acceptible entries are an empty string, A-Z or a-z. Anything else will cause
   an error.
   
   =head2 depri
   
   A convenience function that unsets priority by calling pri('').
   
       $entry->depri;
   
 =head2 priority  =head2 priority
   
 =head2 contexts  Returns the priority of an entry which may be an empty string if it is
   
 =head2 in_context      my $priority = $entry->priority;
   
 =head2 projects  =head2 tags
   
 =head2 in_project  Each tag type generates two accessor functions {tag}s and in_{tag}.
   
 =head2 change  Default tags are context (@) and project (+).
   
 =head2 prepend  When creating a new object you can pass in new tags to recognize.
   
 =head2 append      my $entry = Text::Todo::Entry->new({
           text => 'do something DUE:2011-01-01',
           tags => { due_date => 'DUE:' }
       });
   
 =head2 complete      my @due_dates = $entry->due_dates;
   
 =head2 completed  then @due_dates is ( '2011-01-01' );
   
   and you could also:
   
 =head1 DIAGNOSTICS      if ($entry->in_due_date('2011-01-01')) {
           # do something
       }
   
 =for author to fill in:  
     List every single error and warning message that the module can  
     generate (even the ones that will "never happen"), with a full  
     explanation of each problem, one or more likely causes, and any  
     suggested remedies.  
   
 =over  =over
   
 =item C<< Error message here, perhaps with %s placeholders >>  =item {tag}s
   
 [Description of error here]      @tags = $entry->{tag}s;
   
 =item C<< Another error message here >>  =item in_{tag}
   
 [Description of error here]  returns true if $entry is in the tag, false if not.
   
 [Et cetera, et cetera]      if ($entry->in_{tag}('tag')) {
           # do something
       }
   
 =back  =back
   
   =head2 learn_tag($tag, $sigal)
   
       $entry->learn_tag('due_date', 'DUE:');
   
   Teaches the entry about an additional tag, same as passing a tags argument to
   new(). See tags()
   
   You can simulate forgetting a tag by setting the sigal to undef or an empty
   string.
   
   =head2 known_tags
   
       $known_tags = $entry->known_tags;
   
   $known_tags by default would be:
   
       { context => '@',
         project => '+',
       }
   
   
   =head3 context
   
   These are matched as a word beginning with @.
   
   =over
   
   =item contexts
   
   =item in_context
   
   =back
   
   =head3 project
   
   This is matched as a word beginning with +.
   
   =over
   
   =item projects
   
   =item in_project
   
   =back
   
   =head2 replace
   
   Replaces the text of an entry with completely new text.  Useful if there has
   been manual modification of the entry or just a new direction.
   
       $entry->replace('replacment text');
   
   =head2 prepend
   
   Attaches text (with a trailing space) to the beginning of an entry.  Puts it
   after the done() "x" and the priority() letter.
   
       $entry->prepend('NEED HELP');
   
   =head2 append
   
   Adds text to the end of an entry.
   Useful for adding tags, or just additional information.
   
       $entry->append('@specific_store');
   
   =head2 do
   
   Marks an entry as completed.
   
       $entry->do;
   
   Does this by prepending "x `date '%Y-%m-%d'`" to the beginning of the entry.
   
   =head2 done
   
   Returns true if an entry is marked complete and false if not.
   
       if (!my $status = $entry->done) {
           # remind me to do it
       }
   
   If the entry starts as 'x date', for example 'x 2010-01-01', $status is now
   '2010-01-01'.
   If the entry just starts with 'x', then $status will be 'x'.
   
   =head1 DIAGNOSTICS
   
 =head1 CONFIGURATION AND ENVIRONMENT  =head1 CONFIGURATION AND ENVIRONMENT
   
 =for author to fill in:  
     A full explanation of any configuration system(s) used by the  
     module, including the names and locations of any configuration  
     files, and the meaning of any environment variables or properties  
     that can be set. These descriptions must also include details of any  
     configuration language used.  
   
 Text::Todo::Entry requires no configuration files or environment variables.  Text::Todo::Entry requires no configuration files or environment variables.
   
   
 =head1 DEPENDENCIES  =head1 DEPENDENCIES
   
 =for author to fill in:  Class::Std::Utils
     A list of all the other modules that this module relies upon,  List::Util
     including any restrictions on versions, and an indication whether  version
     the module is part of the standard Perl distribution, part of the  
     module's distribution, or must be installed separately. ]  
   
 None.  
   
   
 =head1 INCOMPATIBILITIES  =head1 INCOMPATIBILITIES
   
 =for author to fill in:  
     A list of any modules that this module cannot be used in conjunction  
     with. This may be due to name conflicts in the interface, or  
     competition for system or program resources, or due to internal  
     limitations of Perl (for example, many modules that use source code  
     filters are mutually incompatible).  
   
 None reported.  None reported.
   
   
 =head1 BUGS AND LIMITATIONS  =head1 BUGS AND LIMITATIONS
   
 =for author to fill in:  
     A list of known problems with the module, together with some  
     indication Whether they are likely to be fixed in an upcoming  
     release. Also a list of restrictions on the features the module  
     does provide: data types that cannot be handled, performance issues  
     and the circumstances in which they may arise, practical  
     limitations on the size of data sets, special cases that are not  
     (yet) handled, etc.  
   
 No bugs have been reported.  No bugs have been reported.
   
   Known limitations:
   
   Sometimes leading whitespace may get screwed up when making changes.  It
   doesn't seem to be particularly a problem, but if you use whitespace to indent
   entries for some reason it could be.
   
 Please report any bugs or feature requests to  Please report any bugs or feature requests to
 C<bug-text-todo@rt.cpan.org>, or through the web interface at  C<bug-text-todo@rt.cpan.org>, or through the web interface at
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.28
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>