=================================================================== RCS file: /cvs/todotxt/Text-Todo/lib/Text/Todo/Entry.pm,v retrieving revision 1.19 retrieving revision 1.30 diff -u -r1.19 -r1.30 --- todotxt/Text-Todo/lib/Text/Todo/Entry.pm 2010/01/11 19:52:06 1.19 +++ todotxt/Text-Todo/lib/Text/Todo/Entry.pm 2010/02/16 01:13:12 1.30 @@ -1,24 +1,26 @@ package Text::Todo::Entry; -# $AFresh1: Entry.pm,v 1.18 2010/01/11 01:30:24 andrew Exp $ +# $AFresh1: Entry.pm,v 1.29 2010/02/14 06:08:07 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.2.0'); { - my %text_of; - my %tags_of; - my %priority_of; - my %completion_status_of; - my %known_tags_of; + my @attr_refs = \( + my %text_of, + 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* @@ -32,6 +34,8 @@ my $self = bless anon_scalar(), $class; my $ident = ident($self); + $text_of{$ident} = q{}; + if ( !ref $options ) { $options = { text => $options }; } @@ -39,36 +43,17 @@ croak 'Invalid parameter passed!'; } - $known_tags_of{$ident} = { + my %tags = ( context => q{@}, project => q{+}, - }; + ); if ( exists $options->{tags} && ref $options->{tags} eq 'HASH' ) { - foreach my $k ( keys %{ $options->{tags} } ) { - $known_tags_of{$ident}{$k} = $options->{tags}->{$k}; - } + %tags = ( %tags, %{ $options->{tags} } ); } - for my $tag ( keys %{ $known_tags_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 ); - }; - } + for my $tag ( keys %tags ) { + $self->learn_tag( $tag, $tags{$tag} ); } $self->replace( $options->{text} ); @@ -76,19 +61,26 @@ return $self; } - sub replace { - 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 %{ $known_tags_of{$ident} } ) { - my $symbol = quotemeta $known_tags_of{$ident}{$tag}; - $tags_of{$ident}{$tag} = { map { $_ => q{} } - $text =~ / (?:^|\s) $symbol (\S*)/gxms }; + 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; @@ -121,28 +113,62 @@ return; } + sub replace { + my ( $self, $text ) = @_; + my $ident = ident($self); + + $text = defined $text ? $text : q{}; + + $text_of{$ident} = $text; + + return $self->_parse_entry; + } + + 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); + }; + } + + if ( !$self->can( 'in_' . $tag ) ) { + *{ 'in_' . $tag } = sub { + my ( $self, $item ) = @_; + return $self->_is_in( $tag . 's', $item ); + }; + } + + return $self->_parse_entry; + } + sub _tags { my ( $self, $tag ) = @_; 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; } sub _is_in { 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 { - my ($self) = @_; - my $ident = ident($self); - - return $text_of{$ident}; - } - - sub depri { my ($self) = @_; return $self->pri(q{}) } - sub pri { my ( $self, $new_pri ) = @_; my $ident = ident($self); @@ -156,13 +182,6 @@ return $self->prepend(); } - sub priority { - my ( $self, $new_pri ) = @_; - my $ident = ident($self); - - return $priority_of{$ident}; - } - sub prepend { my ( $self, $addition ) = @_; @@ -172,7 +191,7 @@ $new =~ s/$priority_completion_regex//xms; if ( $self->done ) { - if ($self->done !~ /^x/ixms) { + if ( $self->done !~ /^x/ixms ) { push @new, 'x'; } push @new, $self->done; @@ -214,11 +233,20 @@ sub done { my ($self) = @_; - my $ident = ident($self); - - return $completion_status_of{$ident}; + 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__ @@ -233,7 +261,7 @@ 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.19 2010/01/11 19:52:06 andrew Exp $ + $Id: Entry.pm,v 1.30 2010/02/16 01:13:12 andrew Exp $ =head1 SYNOPSIS @@ -305,7 +333,7 @@ Each tag type generates two accessor functions {tag}s and in_{tag}. -Current tags are context (@) and project (+). +Default tags are context (@) and project (+). When creating a new object you can pass in new tags to recognize. @@ -316,7 +344,7 @@ my @due_dates = $entry->due_dates; -then @due_dates eq ( '2011-01-01' ); +then @due_dates is ( '2011-01-01' ); and you could also: @@ -340,6 +368,27 @@ } =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