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