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   31968 use warnings;
  5         8  
  5         145  
6 5     5   18 use strict;
  5         6  
  5         118  
7 5     5   16 use Carp;
  5         6  
  5         298  
8              
9 5     5   944 use Class::Std::Utils;
  5         4759  
  5         24  
10              
11 5     5   148 use version; our $VERSION = qv('0.2.1');
  5         7  
  5         42  
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 755 my ( $class, $options ) = @_;
33              
34 45         93 my $self = bless anon_scalar(), $class;
35 45         191 my $ident = ident($self);
36              
37 45         86 $text_of{$ident} = q{};
38              
39 45 100       89 if ( !ref $options ) {
    50          
40 36         66 $options = { text => $options };
41             }
42             elsif ( ref $options ne 'HASH' ) {
43 0         0 croak 'Invalid parameter passed!';
44             }
45              
46 45         94 my %tags = (
47             context => q{@},
48             project => q{+},
49             );
50              
51 45 100 66     136 if ( exists $options->{tags} && ref $options->{tags} eq 'HASH' ) {
52 9         16 %tags = ( %tags, %{ $options->{tags} } );
  9         70  
53             }
54              
55 45         88 for my $tag ( keys %tags ) {
56 91         146 $self->learn_tag( $tag, $tags{$tag} );
57             }
58              
59 45         93 $self->replace( $options->{text} );
60              
61 45         255 return $self;
62             }
63              
64             sub _parse_entry {
65 155     155   233 my ($self) = @_;
66 155         199 my $ident = ident($self);
67              
68 155         286 delete $tags_of{$ident};
69 155         132 delete $completion_status_of{$ident};
70 155         137 delete $priority_of{$ident};
71              
72 155   100     208 my $text = $self->text || q{};
73 155   50     241 my $known_tags = $self->known_tags || {};
74              
75 155         200 foreach my $tag ( keys %{$known_tags} ) {
  155         302  
76 278 50       916 next if !defined $known_tags->{$tag};
77 278 50       528 next if !length $known_tags->{$tag};
78              
79 278         320 my $sigal = quotemeta $known_tags->{$tag};
80 96         414 $tags_of{$ident}{$tag}
81 278         4339 = { map { $_ => q{} } $text =~ / (?:^|\s) $sigal (\S*)/gxms };
82             }
83              
84 155         946 my ( $completed, $priority )
85             = $text =~ / $priority_completion_regex /xms;
86              
87 155         242 $completion_status_of{$ident} = _clean_completed($completed);
88 155         174 $priority_of{$ident} = $priority;
89              
90 155         329 return 1;
91             }
92              
93             sub _clean_completed {
94 155     155   128 my ($completed) = @_;
95              
96 155   100     434 $completed ||= q{};
97 155         184 $completed =~ s/^\s+|\s+$//gxms;
98              
99 155 100       215 if ( !$completed ) {
100 139         239 return;
101             }
102              
103 16 50       63 if ( $completed =~ s/(x)\s*//ixms ) {
104 16         33 my $status = $1;
105 16 100       31 if ($completed) {
106 5         12 return $completed;
107             }
108             else {
109 11         28 return $status;
110             }
111             }
112              
113 0         0 return;
114             }
115              
116             sub replace {
117 54     54 1 66 my ( $self, $text ) = @_;
118 54         122 my $ident = ident($self);
119              
120 54 100       89 $text = defined $text ? $text : q{};
121              
122 54         67 $text_of{$ident} = $text;
123              
124 54         75 return $self->_parse_entry;
125             }
126              
127             sub learn_tag {
128 101     101 1 110 my ( $self, $tag, $sigal ) = @_;
129 101         243 $known_tags_of{ ident $self}{$tag} = $sigal;
130              
131             ## no critic strict
132 5     5   3111 no strict 'refs'; # Violates use strict, but allows code generation
  5         8  
  5         3522  
133             ## use critic
134              
135 101 100       395 if ( !$self->can( $tag . 's' ) ) {
136 11         37 *{ $tag . 's' } = sub {
137 105     105   1781 my ($self) = @_;
138 105         182 return $self->_tags($tag);
139 11         53 };
140             }
141              
142 101 100       301 if ( !$self->can( 'in_' . $tag ) ) {
143 11         26 *{ 'in_' . $tag } = sub {
144 26     26   1158 my ( $self, $item ) = @_;
145 26         75 return $self->_is_in( $tag . 's', $item );
146 11         36 };
147             }
148              
149 101         647 return $self->_parse_entry;
150             }
151              
152             sub _tags {
153 105     105   123 my ( $self, $tag ) = @_;
154 105         234 my $ident = ident($self);
155              
156 105         84 my @tags;
157 105 50       281 if ( defined $tags_of{$ident}{$tag} ) {
158 105         86 @tags = sort keys %{ $tags_of{$ident}{$tag} };
  105         419  
159             }
160 105 50       500 return wantarray ? @tags : \@tags;
161             }
162              
163             sub _is_in {
164 26     26   29 my ( $self, $tags, $item ) = @_;
165 26 50       57 return if !defined $item;
166 26         52 foreach ( $self->$tags ) {
167 30 100       115 return 1 if $_ eq $item;
168             }
169 14         56 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       10 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 5 my ( $self, $addition ) = @_;
187              
188 4         8 my $new = $self->text;
189 4         4 my @new;
190              
191 4         36 $new =~ s/$priority_completion_regex//xms;
192              
193 4 100       10 if ( $self->done ) {
194 1 50       2 if ( $self->done !~ /^x/ixms ) {
195 1         8 push @new, 'x';
196             }
197 1         2 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         2 push @new, $addition;
206             }
207              
208 4         13 return $self->replace( join q{ }, @new, $new );
209             }
210              
211             sub append {
212 3     3 1 5 my ( $self, $addition ) = @_;
213 3         5 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         3 my $ident = ident($self);
221              
222 1 50       4 if ( $self->done ) {
223 0         0 return 1;
224             }
225              
226 1         70 $completion_status_of{$ident} = sprintf "%04d-%02d-%02d",
227             ( (localtime)[5] + 1900 ),
228             ( (localtime)[4] + 1 ),
229             ( (localtime)[3] );
230              
231 1         4 return $self->prepend();
232             }
233              
234             sub done {
235 38     38 1 46 my ($self) = @_;
236 38         185 return $completion_status_of{ ident($self) };
237             }
238 374     374 1 689 sub known_tags { my ($self) = @_; return $known_tags_of{ ident($self) }; }
  374         800  
239 45     45 1 71 sub priority { my ($self) = @_; return $priority_of{ ident($self) }; }
  45         288  
240 245     245 1 12245 sub text { my ($self) = @_; return $text_of{ ident($self) }; }
  245         1004  
241 1     1 1 67 sub depri { my ($self) = @_; return $self->pri(q{}) }
  1         5  
242              
243             sub DESTROY {
244 45     45   1052 my ($self) = @_;
245 45         63 my $ident = ident $self;
246 45         51 foreach my $attr_ref (@attr_refs) {
247 225         535 delete $attr_ref->{$ident};
248             }
249             }
250             }
251             1; # Magic true value required at end of module
252             __END__