[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.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>