File Coverage

blib/lib/Text/Todo/Entry.pm
Criterion Covered Total %
statement 129 133 96.9
branch 32 42 76.1
condition 9 12 75.0
subroutine 25 25 100.0
pod 12 12 100.0
total 207 224 92.4


line stmt bran cond sub pod time code
1             package Text::Todo::Entry;
2              
3             # $AFresh1: Entry.pm,v 1.29 2010/02/14 06:08:07 andrew Exp $
4              
5 5     5   29825 use warnings;
  5         6  
  5         136  
6 5     5   17 use strict;
  5         6  
  5         110  
7 5     5   16 use Carp;
  5         6  
  5         273  
8              
9 5     5   892 use Class::Std::Utils;
  5         4585  
  5         22  
10              
11 5     5   139 use version; our $VERSION = qv('0.2.1');
  5         5  
  5         30  
12              
13             {
14              
15             my @attr_refs = \(
16             my %text_of,
17              
18             my %tags_of,
19             my %priority_of,
20             my %completion_status_of,
21             my %known_tags_of,
22             );
23              
24             # XXX Should the completion (x) be case sensitive?
25             my $priority_completion_regex = qr{
26             ^ \s*
27             (?i:(x \s* [\d-]* ) \s*)?
28             (?i:\( ([A-Z]) \) \s*)?
29             }xms;
30              
31             sub new {
32 45     45 1 606 my ( $class, $options ) = @_;
33              
34 45         98 my $self = bless anon_scalar(), $class;
35 45         190 my $ident = ident($self);
36              
37 45         89 $text_of{$ident} = q{};
38              
39 45 100       90 if ( !ref $options ) {
    50          
40 36         72 $options = { text => $options };
41             }
42             elsif ( ref $options ne 'HASH' ) {
43 0         0 croak 'Invalid parameter passed!';
44             }
45              
46 45         86 my %tags = (
47             context => q{@},
48             project => q{+},
49             );
50              
51 45 100 66     132 if ( exists $options->{tags} && ref $options->{tags} eq 'HASH' ) {
52 9         16 %tags = ( %tags, %{ $options->{tags} } );
  9         34  
53             }
54              
55 45         92 for my $tag ( keys %tags ) {
56 91         156 $self->learn_tag( $tag, $tags{$tag} );
57             }
58              
59 45         97 $self->replace( $options->{text} );
60              
61 45         254 return $self;
62             }
63              
64             sub _parse_entry {
65 155     155   494 my ($self) = @_;
66 155         207 my $ident = ident($self);
67              
68 155         256 delete $tags_of{$ident};
69 155         133 delete $completion_status_of{$ident};
70 155         136 delete $priority_of{$ident};
71              
72 155   100     187 my $text = $self->text || q{};
73 155   50     198 my $known_tags = $self->known_tags || {};
74              
75 155         127 foreach my $tag ( keys %{$known_tags} ) {
  155         289  
76 278 50       465 next if !defined $known_tags->{$tag};
77 278 50       838 next if !length $known_tags->{$tag};
78              
79 278         279 my $sigal = quotemeta $known_tags->{$tag};
80 96         374 $tags_of{$ident}{$tag}
81 278         4104 = { map { $_ => q{} } $text =~ / (?:^|\s) $sigal (\S*)/gxms };
82             }
83              
84 155         857 my ( $completed, $priority )
85             = $text =~ / $priority_completion_regex /xms;
86              
87 155         237 $completion_status_of{$ident} = _clean_completed($completed);
88 155         166 $priority_of{$ident} = $priority;
89              
90 155         306 return 1;
91             }
92              
93             sub _clean_completed {
94 155     155   135 my ($completed) = @_;
95              
96 155   100     411 $completed ||= q{};
97 155         180 $completed =~ s/^\s+|\s+$//gxms;
98              
99 155 100       220 if ( !$completed ) {
100 139         220 return;
101             }
102              
103 16 50       59 if ( $completed =~ s/(x)\s*//ixms ) {
104 16         32 my $status = $1;
105 16 100       29 if ($completed) {
106 5         10 return $completed;
107             }
108             else {
109 11         26 return $status;
110             }
111             }
112              
113 0         0 return;
114             }
115              
116             sub replace {
117 54     54 1 58 my ( $self, $text ) = @_;
118 54         83 my $ident = ident($self);
119              
120 54 100       89 $text = defined $text ? $text : q{};
121              
122 54         71 $text_of{$ident} = $text;
123              
124 54         69 return $self->_parse_entry;
125             }
126              
127             sub learn_tag {
128 101     101 1 102 my ( $self, $tag, $sigal ) = @_;
129 101         229 $known_tags_of{ ident $self}{$tag} = $sigal;
130              
131             ## no critic strict
132 5     5   3148 no strict 'refs'; # Violates use strict, but allows code generation
  5         6  
  5         3514  
133             ## use critic
134              
135 101 100       373 if ( !$self->can( $tag . 's' ) ) {
136 11         31 *{ $tag . 's' } = sub {
137 105     105   1741 my ($self) = @_;
138 105         168 return $self->_tags($tag);
139 11         39 };
140             }
141              
142 101 100       287 if ( !$self->can( 'in_' . $tag ) ) {
143 11         21 *{ 'in_' . $tag } = sub {
144 26     26   1055 my ( $self, $item ) = @_;
145 26         72 return $self->_is_in( $tag . 's', $item );
146 11         32 };
147             }
148              
149 101         158 return $self->_parse_entry;
150             }
151              
152             sub _tags {
153 105     105   116 my ( $self, $tag ) = @_;
154 105         203 my $ident = ident($self);
155              
156 105         82 my @tags;
157 105 50       384 if ( defined $tags_of{$ident}{$tag} ) {
158 105         89 @tags = sort keys %{ $tags_of{$ident}{$tag} };
  105         390  
159             }
160 105 50       517 return wantarray ? @tags : \@tags;
161             }
162              
163             sub _is_in {
164 26     26   31 my ( $self, $tags, $item ) = @_;
165 26 50       56 return if !defined $item;
166 26         48 foreach ( $self->$tags ) {
167 30 100       104 return 1 if $_ eq $item;
168             }
169 14         47 return 0;
170             }
171              
172             sub pri {
173 2     2 1 3 my ( $self, $new_pri ) = @_;
174 2         5 my $ident = ident($self);
175              
176 2 50       9 if ( $new_pri !~ /^[a-zA-Z]?$/xms ) {
177 0         0 croak "Invalid priority [$new_pri]";
178             }
179              
180 2         4 $priority_of{$ident} = $new_pri;
181              
182 2         4 return $self->prepend();
183             }
184              
185             sub prepend {
186 4     4 1 6 my ( $self, $addition ) = @_;
187              
188 4         6 my $new = $self->text;
189 4         6 my @new;
190              
191 4         26 $new =~ s/$priority_completion_regex//xms;
192              
193 4 100       8 if ( $self->done ) {
194 1 50       3 if ( $self->done !~ /^x/ixms ) {
195 1         7 push @new, 'x';
196             }
197 1         1 push @new, $self->done;
198             }
199              
200 4 100       5 if ( $self->priority ) {
201 2         4 push @new, '(' . $self->priority . ')';
202             }
203              
204 4 100 66     14 if ( defined $addition && length $addition ) {
205 1         1 push @new, $addition;
206             }
207              
208 4         12 return $self->replace( join q{ }, @new, $new );
209             }
210              
211             sub append {
212 3     3 1 4 my ( $self, $addition ) = @_;
213 3         6 return $self->replace( join q{ }, $self->text, $addition );
214             }
215              
216             ## no critic 'homonym'
217             sub do { # This is what it is called in todo.sh
218             ## use critic
219 1     1 1 2 my ($self) = @_;
220 1         4 my $ident = ident($self);
221              
222 1 50       2 if ( $self->done ) {
223 0         0 return 1;
224             }
225              
226 1         33 $completion_status_of{$ident} = sprintf "%04d-%02d-%02d",
227             ( (localtime)[5] + 1900 ),
228             ( (localtime)[4] + 1 ),
229             ( (localtime)[3] );
230              
231 1         3 return $self->prepend();
232             }
233              
234             sub done {
235 38     38 1 49 my ($self) = @_;
236 38         198 return $completion_status_of{ ident($self) };
237             }
238 374     374 1 611 sub known_tags { my ($self) = @_; return $known_tags_of{ ident($self) }; }
  374         773  
239 45     45 1 58 sub priority { my ($self) = @_; return $priority_of{ ident($self) }; }
  45         243  
240 245     245 1 13954 sub text { my ($self) = @_; return $text_of{ ident($self) }; }
  245         1004  
241 1     1 1 2 sub depri { my ($self) = @_; return $self->pri(q{}) }
  1         3  
242              
243             sub DESTROY {
244 45     45   1111 my ($self) = @_;
245 45         86 my $ident = ident $self;
246 45         62 foreach my $attr_ref (@attr_refs) {
247 225         568 delete $attr_ref->{$ident};
248             }
249             }
250             }
251             1; # Magic true value required at end of module
252             __END__