=================================================================== RCS file: /cvs/todotxt/Text-Todo/lib/Text/Todo/Entry.pm,v retrieving revision 1.3 retrieving revision 1.29 diff -u -r1.3 -r1.29 --- todotxt/Text-Todo/lib/Text/Todo/Entry.pm 2009/07/10 23:52:08 1.3 +++ todotxt/Text-Todo/lib/Text/Todo/Entry.pm 2010/02/14 06:08:07 1.29 @@ -1,254 +1,488 @@ package Text::Todo::Entry; -# $RedRiver: Entry.pm,v 1.2 2009/07/10 22:28:28 andrew Exp $ +# $AFresh1: Entry.pm,v 1.28 2010/02/14 00:50:56 andrew Exp $ use warnings; use strict; use Carp; 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 %priority_of; + my @attr_refs = \( + my %text_of, - my %tags = ( - context => q{@}, - project => q{+}, + my %tags_of, + my %priority_of, + my %completion_status_of, + my %known_tags_of, ); + # XXX Should the completion (x) be case sensitive? + my $priority_completion_regex = qr{ + ^ \s* + (?i:(x \s* [\d-]* ) \s*)? + (?i:\( ([A-Z]) \) \s*)? + }xms; + sub new { - my ( $class, $text ) = @_; + my ( $class, $options ) = @_; my $self = bless anon_scalar(), $class; 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' ) { + %tags = ( %tags, %{ $options->{tags} } ); + } + + for my $tag ( keys %tags ) { + $self->learn_tag( $tag, $tags{$tag} ); + } + + $self->replace( $options->{text} ); + return $self; } - sub _update_entry { - my ( $self, $text ) = @_; + sub _parse_entry { + my ($self) = @_; my $ident = ident($self); - $text = defined $text ? $text : q{}; + delete $tags_of{$ident}; + delete $completion_status_of{$ident}; + delete $priority_of{$ident}; - $text_of{$ident} = $text; + my $text = $self->text || q{}; + my $known_tags = $self->known_tags || {}; - foreach my $tag ( keys %tags ) { - my $symbol = quotemeta $tags{$tag}; + 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 =~ / $symbol (\S+)/gxms }; + = { map { $_ => q{} } $text =~ / (?:^|\s) $sigal (\S*)/gxms }; } - ( $priority_of{$ident} ) = $text =~ /\( ([A-Z]) \)/ixms; + my ( $completed, $priority ) + = $text =~ / $priority_completion_regex /xms; + + $completion_status_of{$ident} = _clean_completed($completed); + $priority_of{$ident} = $priority; + return 1; } - sub _tags { - my ( $self, $tag ) = @_; - my $ident = ident($self); + sub _clean_completed { + my ($completed) = @_; - my @tags = sort keys %{ $tags_of{$ident}{$tag} }; - return wantarray ? @tags : \@tags; - } + $completed ||= q{}; + $completed =~ s/^\s+|\s+$//gxms; - sub _is_in { - my ( $self, $type, $item ) = @_; - my $ident = ident($self); + if ( !$completed ) { + return; + } - return defined first { $_ eq $item } $self->$type; + if ( $completed =~ s/(x)\s*//ixms ) { + my $status = $1; + if ($completed) { + return $completed; + } + else { + return $status; + } + } + + return; } - sub text { - my ($self) = @_; + sub replace { + my ( $self, $text ) = @_; my $ident = ident($self); - return $text_of{$ident}; + $text = defined $text ? $text : q{}; + + $text_of{$ident} = $text; + + return $self->_parse_entry; } - sub priority { - my ($self) = @_; - my $ident = ident($self); + sub learn_tag { + my ( $self, $tag, $sigal ) = @_; + $known_tags_of{ ident $self}{$tag} = $sigal; - return $priority_of{$ident}; + ## 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); + }; + } + + if ( !$self->can( 'in_' . $tag ) ) { + *{ 'in_' . $tag } = sub { + my ( $self, $item ) = @_; + return $self->_is_in( $tag . 's', $item ); + }; + } + + return $self->_parse_entry; } - sub contexts { my ($self) = @_; return $self->_tags('context') } - sub projects { my ($self) = @_; return $self->_tags('project') } + sub _tags { + my ( $self, $tag ) = @_; + my $ident = ident($self); - sub in_context { - my ( $self, $context ) = @_; - return $self->_is_in( 'contexts', $context ); + my @tags; + if ( defined $tags_of{$ident}{$tag} ) { + @tags = sort keys %{ $tags_of{$ident}{$tag} }; + } + return wantarray ? @tags : \@tags; } - sub in_project { - my ( $self, $project ) = @_; - return $self->_is_in( 'projects', $project ); + sub _is_in { + my ( $self, $tags, $item ) = @_; + return if !defined $item; + foreach ( $self->$tags ) { + return 1 if $_ eq $item; + } + return 0; } - sub change { - my ( $self, $text ) = @_; - return $self->_update_entry($text); + sub pri { + my ( $self, $new_pri ) = @_; + my $ident = ident($self); + + if ( $new_pri !~ /^[a-zA-Z]?$/xms ) { + croak "Invalid priority [$new_pri]"; + } + + $priority_of{$ident} = $new_pri; + + return $self->prepend(); } sub prepend { my ( $self, $addition ) = @_; my $new = $self->text; + my @new; - if ( my $priority = $self->priority ) { - $new =~ s/^( \s* \( $priority \))/$1 $addition/xms; + $new =~ s/$priority_completion_regex//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 { my ( $self, $addition ) = @_; - return $self->change( join q{ }, $self->text, $addition ); + return $self->replace( join q{ }, $self->text, $addition ); } -} + ## no critic 'homonym' + sub do { # This is what it is called in todo.sh + ## use critic + my ($self) = @_; + my $ident = ident($self); + if ( $self->done ) { + return 1; + } + + $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 __END__ =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 -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: Entry.pm,v 1.29 2010/02/14 06:08:07 andrew Exp $ + =head1 SYNOPSIS use Text::Todo::Entry; -=for author to fill in: - Brief code example(s) here showing commonest usage(s). - This section will be as far as many users bother reading - so make it as educational and exeplary as possible. - - + my $entry = Text::Todo::Entry->new('text of entry'); + + $entry->append('+project'); + + if ($entry->in_project('project') && ! $entry->priority) { + print $entry->text, "\n"; + } + + =head1 DESCRIPTION -=for author to fill in: - Write a full description of the module and its features here. - Use subsections (=head2, =head3) as appropriate. +This module creates entries in a Text::Todo list. +It allows you to retrieve information about them and modify them. +For more information see L + =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 +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 +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 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:' } + }); + my @due_dates = $entry->due_dates; -=head1 DIAGNOSTICS +then @due_dates is ( '2011-01-01' ); -=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. +and you could also: + if ($entry->in_due_date('2011-01-01')) { + # do something + } + + =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 +=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 -=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. -=head1 DEPENDENCIES +=head1 DEPENDENCIES -=for author to fill in: - A list of all the other modules that this module relies upon, - including any restrictions on versions, and an indication whether - the module is part of the standard Perl distribution, part of the - module's distribution, or must be installed separately. ] +Class::Std::Utils +List::Util +version -None. - =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. =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. + +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 C, or through the web interface at