=================================================================== RCS file: /cvs/todotxt/Text-Todo/lib/Text/Todo/Entry.pm,v retrieving revision 1.23 retrieving revision 1.28 diff -u -r1.23 -r1.28 --- todotxt/Text-Todo/lib/Text/Todo/Entry.pm 2010/01/18 03:04:48 1.23 +++ todotxt/Text-Todo/lib/Text/Todo/Entry.pm 2010/02/14 00:50:56 1.28 @@ -1,15 +1,14 @@ package Text::Todo::Entry; -# $AFresh1: Entry.pm,v 1.22 2010/01/18 02:46:48 andrew Exp $ +# $AFresh1: Entry.pm,v 1.27 2010/02/13 23:06:34 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'); { @@ -35,6 +34,8 @@ my $self = bless anon_scalar(), $class; my $ident = ident($self); + $text_of{$ident} = q{}; + if ( !ref $options ) { $options = { text => $options }; } @@ -42,36 +43,19 @@ 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{$k} = $options->{tags}->{$k}; } } - 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} ); @@ -79,19 +63,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; @@ -124,28 +115,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); @@ -159,13 +184,6 @@ return $self->prepend(); } - sub priority { - my ( $self, $new_pri ) = @_; - my $ident = ident($self); - - return $priority_of{$ident}; - } - sub prepend { my ( $self, $addition ) = @_; @@ -217,10 +235,12 @@ 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) = @_; @@ -243,7 +263,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.23 2010/01/18 03:04:48 andrew Exp $ + $Id: Entry.pm,v 1.28 2010/02/14 00:50:56 andrew Exp $ =head1 SYNOPSIS @@ -315,7 +335,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. @@ -326,7 +346,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: @@ -350,6 +370,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