Annotation of todotxt/Text-Todo/lib/Text/Todo/Entry.pm, Revision 1.9
1.1 andrew 1: package Text::Todo::Entry;
2:
1.9 ! andrew 3: # $RedRiver: Entry.pm,v 1.8 2010/01/08 04:50:41 andrew Exp $
1.1 andrew 4:
5: use warnings;
6: use strict;
7: use Carp;
8:
9: use Class::Std::Utils;
10: use List::Util qw/ first /;
11:
12: use version; our $VERSION = qv('0.0.1');
13:
14: {
15: my %text_of;
16:
1.3 andrew 17: my %tags_of;
1.1 andrew 18: my %priority_of;
1.7 andrew 19: my %completion_status_of;
1.1 andrew 20:
1.3 andrew 21: my %tags = (
22: context => q{@},
23: project => q{+},
24: );
25:
1.8 andrew 26: # XXX Should the completion (x) be case sensitive?
27: my $priority_completion_regex = qr/
28: ^ \s*
29: (?i: (x) \s+)?
30: (?i:\( ([A-Z]) \) \s+)?
31: /xms;
32:
1.4 andrew 33: for my $tag ( keys %tags ) {
34: ## no critic strict
35: no strict 'refs'; # Violates use strict, but allows code generation
36: ## use critic
37:
38: *{ $tag . 's' } = sub {
39: my ($self) = @_;
40: return $self->_tags($tag);
41: };
42:
43: *{ 'in_' . $tag } = sub {
44: my ( $self, $item ) = @_;
45: return $self->_is_in( $tag . 's', $item );
46: };
47: }
48:
1.8 andrew 49: # Aliases
50: sub change { _update_entry(@_) }
51: sub depri { _set_priority( @_, '' ) }
52: sub pri { priority(@_) }
53: sub replace { _update_entry(@_) }
54:
1.1 andrew 55: sub new {
56: my ( $class, $text ) = @_;
57:
58: my $self = bless anon_scalar(), $class;
59: my $ident = ident($self);
60:
61: $self->_update_entry($text);
62:
63: return $self;
64: }
65:
66: sub _update_entry {
67: my ( $self, $text ) = @_;
68: my $ident = ident($self);
69:
70: $text = defined $text ? $text : q{};
71:
72: $text_of{$ident} = $text;
73:
1.3 andrew 74: foreach my $tag ( keys %tags ) {
75: my $symbol = quotemeta $tags{$tag};
1.6 andrew 76: $tags_of{$ident}{$tag} = { map { $_ => q{} }
77: $text =~ / (?:^|\s) $symbol (\S+)/gxms };
1.3 andrew 78: }
1.8 andrew 79: ( $completion_status_of{$ident}, $priority_of{$ident} )
80: = $text =~ / $priority_completion_regex /xms;
1.1 andrew 81:
82: return 1;
83: }
84:
1.3 andrew 85: sub _tags {
86: my ( $self, $tag ) = @_;
1.1 andrew 87: my $ident = ident($self);
88:
1.3 andrew 89: my @tags = sort keys %{ $tags_of{$ident}{$tag} };
90: return wantarray ? @tags : \@tags;
1.1 andrew 91: }
92:
1.3 andrew 93: sub _is_in {
1.5 andrew 94: my ( $self, $tags, $item ) = @_;
95: return defined first { $_ eq $item } $self->$tags;
1.1 andrew 96: }
97:
1.3 andrew 98: sub text {
1.1 andrew 99: my ($self) = @_;
100: my $ident = ident($self);
101:
1.3 andrew 102: return $text_of{$ident};
1.1 andrew 103: }
104:
1.8 andrew 105: sub _set_priority {
106: my ( $self, $new_pri ) = @_;
107: my $ident = ident($self);
108:
109: if ( $new_pri !~ /^[a-zA-Z]?$/xms ) {
110: croak "Invalid priority [$new_pri]";
111: }
112:
113: $priority_of{$ident} = $new_pri;
114:
115: return $self->prepend();
116: }
117:
1.1 andrew 118: sub priority {
1.8 andrew 119: my ( $self, $new_pri ) = @_;
1.1 andrew 120: my $ident = ident($self);
121:
1.8 andrew 122: if ($new_pri) {
123: return $self->_set_priority($new_pri);
124: }
125:
1.1 andrew 126: return $priority_of{$ident};
127: }
128:
129: sub prepend {
130: my ( $self, $addition ) = @_;
131:
132: my $new = $self->text;
1.8 andrew 133: my @new;
134:
135: $new =~ s/$priority_completion_regex//xms;
1.1 andrew 136:
1.9 ! andrew 137: if ( $self->done) {
! 138: push @new, $self->done;
1.1 andrew 139: }
1.8 andrew 140:
141: if ( $self->priority ) {
142: push @new, '(' . $self->priority . ')';
143: }
144:
145: if ( defined $addition && length $addition ) {
146: push @new, $addition;
1.1 andrew 147: }
148:
1.8 andrew 149: return $self->_update_entry( join q{ }, @new, $new );
1.1 andrew 150: }
151:
152: sub append {
153: my ( $self, $addition ) = @_;
1.8 andrew 154: return $self->_update_entry( join q{ }, $self->text, $addition );
1.1 andrew 155: }
156:
1.9 ! andrew 157: sub do {
1.7 andrew 158: my ($self) = @_;
1.8 andrew 159: my $ident = ident($self);
1.7 andrew 160:
1.9 ! andrew 161: if ( $self->done) {
1.7 andrew 162: return 1;
163: }
164:
1.8 andrew 165: $completion_status_of{$ident} = 'x';
166:
167: return $self->prepend();
1.7 andrew 168: }
169:
1.9 ! andrew 170: sub done {
! 171: my ($self) = @_;
! 172: my $ident = ident($self);
! 173:
! 174: return $completion_status_of{$ident};
! 175: }
! 176:
1.1 andrew 177: }
178: 1; # Magic true value required at end of module
179: __END__
180:
181: =head1 NAME
182:
183: Text::Todo::Entry - [One line description of module's purpose here]
184:
185:
186: =head1 VERSION
187:
188: This document describes Text::Todo::Entry version 0.0.1
189:
190:
191: =head1 SYNOPSIS
192:
193: use Text::Todo::Entry;
194:
195: =for author to fill in:
196: Brief code example(s) here showing commonest usage(s).
197: This section will be as far as many users bother reading
198: so make it as educational and exeplary as possible.
199:
200:
201: =head1 DESCRIPTION
202:
203: =for author to fill in:
204: Write a full description of the module and its features here.
205: Use subsections (=head2, =head3) as appropriate.
206:
207:
208: =head1 INTERFACE
209:
210: =for author to fill in:
211: Write a separate section listing the public components of the modules
212: interface. These normally consist of either subroutines that may be
213: exported, or methods that may be called on objects belonging to the
214: classes provided by the module.
215:
216: =head2 new
217:
218: =head2 text
219:
220: =head2 priority
221:
222: =head2 contexts
223:
224: =head2 in_context
225:
226: =head2 projects
227:
228: =head2 in_project
229:
230: =head2 change
231:
232: =head2 prepend
233:
234: =head2 append
1.7 andrew 235:
1.9 ! andrew 236: =head2 do
1.7 andrew 237:
1.9 ! andrew 238: =head2 done
1.1 andrew 239:
240:
241: =head1 DIAGNOSTICS
242:
243: =for author to fill in:
244: List every single error and warning message that the module can
245: generate (even the ones that will "never happen"), with a full
246: explanation of each problem, one or more likely causes, and any
247: suggested remedies.
248:
249: =over
250:
251: =item C<< Error message here, perhaps with %s placeholders >>
252:
253: [Description of error here]
254:
255: =item C<< Another error message here >>
256:
257: [Description of error here]
258:
259: [Et cetera, et cetera]
260:
261: =back
262:
263:
264: =head1 CONFIGURATION AND ENVIRONMENT
265:
266: =for author to fill in:
267: A full explanation of any configuration system(s) used by the
268: module, including the names and locations of any configuration
269: files, and the meaning of any environment variables or properties
270: that can be set. These descriptions must also include details of any
271: configuration language used.
272:
273: Text::Todo::Entry requires no configuration files or environment variables.
274:
275:
276: =head1 DEPENDENCIES
277:
278: =for author to fill in:
279: A list of all the other modules that this module relies upon,
280: including any restrictions on versions, and an indication whether
281: the module is part of the standard Perl distribution, part of the
282: module's distribution, or must be installed separately. ]
283:
284: None.
285:
286:
287: =head1 INCOMPATIBILITIES
288:
289: =for author to fill in:
290: A list of any modules that this module cannot be used in conjunction
291: with. This may be due to name conflicts in the interface, or
292: competition for system or program resources, or due to internal
293: limitations of Perl (for example, many modules that use source code
294: filters are mutually incompatible).
295:
296: None reported.
297:
298:
299: =head1 BUGS AND LIMITATIONS
300:
301: =for author to fill in:
302: A list of known problems with the module, together with some
303: indication Whether they are likely to be fixed in an upcoming
304: release. Also a list of restrictions on the features the module
305: does provide: data types that cannot be handled, performance issues
306: and the circumstances in which they may arise, practical
307: limitations on the size of data sets, special cases that are not
308: (yet) handled, etc.
309:
310: No bugs have been reported.
311:
312: Please report any bugs or feature requests to
313: C<bug-text-todo@rt.cpan.org>, or through the web interface at
314: L<http://rt.cpan.org>.
315:
316:
317: =head1 AUTHOR
318:
319: Andrew Fresh C<< <andrew@cpan.org> >>
320:
321:
322: =head1 LICENSE AND COPYRIGHT
323:
324: Copyright (c) 2009, Andrew Fresh C<< <andrew@cpan.org> >>. All rights reserved.
325:
326: This module is free software; you can redistribute it and/or
327: modify it under the same terms as Perl itself. See L<perlartistic>.
328:
329:
330: =head1 DISCLAIMER OF WARRANTY
331:
332: BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
333: FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
334: OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
335: PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
336: EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
337: WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
338: ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
339: YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
340: NECESSARY SERVICING, REPAIR, OR CORRECTION.
341:
342: IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
343: WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
344: REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
345: LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
346: OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
347: THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
348: RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
349: FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
350: SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
351: SUCH DAMAGES.
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>