[BACK]Return to Entry.pm CVS log [TXT][DIR] Up to [local] / todotxt / Text-Todo / lib / Text / Todo

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>