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