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

1.1       andrew      1: package Text::Todo::Entry;
                      2:
1.15    ! andrew      3: # $RedRiver: Entry.pm,v 1.14 2010/01/10 01:41:40 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.13      andrew     20:     my %known_tags_of;
1.3       andrew     21:
1.8       andrew     22:     # XXX Should the completion (x) be case sensitive?
1.14      andrew     23:     my $priority_completion_regex = qr{
1.8       andrew     24:         ^ \s*
1.15    ! andrew     25:         (?i:   (x)        \s*)?
        !            26:         (?i:\( ([A-Z]) \) \s*)?
1.14      andrew     27:     }xms;
1.8       andrew     28:
1.1       andrew     29:     sub new {
1.13      andrew     30:         my ( $class, $options ) = @_;
1.1       andrew     31:
                     32:         my $self = bless anon_scalar(), $class;
                     33:         my $ident = ident($self);
                     34:
1.13      andrew     35:         if ( !ref $options ) {
                     36:             $options = { text => $options };
                     37:         }
                     38:         elsif ( ref $options ne 'HASH' ) {
                     39:             croak 'Invalid parameter passed!';
                     40:         }
                     41:
                     42:         $known_tags_of{$ident} = {
                     43:             context => q{@},
                     44:             project => q{+},
                     45:         };
                     46:
                     47:         if ( exists $options->{tags} && ref $options->{tags} eq 'HASH' ) {
                     48:             foreach my $k ( keys %{ $options->{tags} } ) {
                     49:                 $known_tags_of{$ident}{$k} = $options->{tags}->{$k};
                     50:             }
                     51:         }
                     52:
                     53:         for my $tag ( keys %{ $known_tags_of{$ident} } ) {
                     54:             ## no critic strict
                     55:             no strict
                     56:                 'refs';    # Violates use strict, but allows code generation
                     57:             ## use critic
                     58:
                     59:             if ( !$self->can( $tag . 's' ) ) {
                     60:                 *{ $tag . 's' } = sub {
                     61:                     my ($self) = @_;
                     62:                     return $self->_tags($tag);
                     63:                 };
                     64:             }
                     65:
                     66:             if ( !$self->can( 'in_' . $tag ) ) {
                     67:                 *{ 'in_' . $tag } = sub {
                     68:                     my ( $self, $item ) = @_;
                     69:                     return $self->_is_in( $tag . 's', $item );
                     70:                 };
                     71:             }
                     72:         }
                     73:
1.14      andrew     74:         $self->replace( $options->{text} );
1.1       andrew     75:
                     76:         return $self;
                     77:     }
                     78:
1.14      andrew     79:     sub replace {
1.1       andrew     80:         my ( $self, $text ) = @_;
                     81:         my $ident = ident($self);
                     82:
                     83:         $text = defined $text ? $text : q{};
                     84:
                     85:         $text_of{$ident} = $text;
                     86:
1.13      andrew     87:         foreach my $tag ( keys %{ $known_tags_of{$ident} } ) {
                     88:             my $symbol = quotemeta $known_tags_of{$ident}{$tag};
1.6       andrew     89:             $tags_of{$ident}{$tag} = { map { $_ => q{} }
                     90:                     $text =~ / (?:^|\s) $symbol  (\S+)/gxms };
1.3       andrew     91:         }
1.8       andrew     92:         ( $completion_status_of{$ident}, $priority_of{$ident} )
                     93:             = $text =~ / $priority_completion_regex /xms;
1.1       andrew     94:
                     95:         return 1;
                     96:     }
                     97:
1.3       andrew     98:     sub _tags {
                     99:         my ( $self, $tag ) = @_;
1.1       andrew    100:         my $ident = ident($self);
                    101:
1.3       andrew    102:         my @tags = sort keys %{ $tags_of{$ident}{$tag} };
                    103:         return wantarray ? @tags : \@tags;
1.1       andrew    104:     }
                    105:
1.3       andrew    106:     sub _is_in {
1.5       andrew    107:         my ( $self, $tags, $item ) = @_;
                    108:         return defined first { $_ eq $item } $self->$tags;
1.1       andrew    109:     }
                    110:
1.3       andrew    111:     sub text {
1.1       andrew    112:         my ($self) = @_;
                    113:         my $ident = ident($self);
                    114:
1.3       andrew    115:         return $text_of{$ident};
1.1       andrew    116:     }
                    117:
1.14      andrew    118:     sub depri { my ($self) = @_; return $self->pri(q{}) }
1.11      andrew    119:
                    120:     sub pri {
1.8       andrew    121:         my ( $self, $new_pri ) = @_;
                    122:         my $ident = ident($self);
                    123:
                    124:         if ( $new_pri !~ /^[a-zA-Z]?$/xms ) {
                    125:             croak "Invalid priority [$new_pri]";
                    126:         }
                    127:
                    128:         $priority_of{$ident} = $new_pri;
                    129:
                    130:         return $self->prepend();
                    131:     }
                    132:
1.1       andrew    133:     sub priority {
1.8       andrew    134:         my ( $self, $new_pri ) = @_;
1.1       andrew    135:         my $ident = ident($self);
                    136:
                    137:         return $priority_of{$ident};
                    138:     }
                    139:
                    140:     sub prepend {
                    141:         my ( $self, $addition ) = @_;
                    142:
                    143:         my $new = $self->text;
1.8       andrew    144:         my @new;
                    145:
                    146:         $new =~ s/$priority_completion_regex//xms;
1.1       andrew    147:
1.10      andrew    148:         if ( $self->done ) {
1.9       andrew    149:             push @new, $self->done;
1.1       andrew    150:         }
1.8       andrew    151:
                    152:         if ( $self->priority ) {
                    153:             push @new, '(' . $self->priority . ')';
                    154:         }
                    155:
                    156:         if ( defined $addition && length $addition ) {
                    157:             push @new, $addition;
1.1       andrew    158:         }
                    159:
1.14      andrew    160:         return $self->replace( join q{ }, @new, $new );
1.1       andrew    161:     }
                    162:
                    163:     sub append {
                    164:         my ( $self, $addition ) = @_;
1.14      andrew    165:         return $self->replace( join q{ }, $self->text, $addition );
1.1       andrew    166:     }
                    167:
1.14      andrew    168:     ## no critic 'homonym'
                    169:     sub do {    # This is what it is called in todo.sh
                    170:         ## use critic
1.7       andrew    171:         my ($self) = @_;
1.8       andrew    172:         my $ident = ident($self);
1.7       andrew    173:
1.10      andrew    174:         if ( $self->done ) {
1.7       andrew    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.9       andrew    183:     sub done {
                    184:         my ($self) = @_;
                    185:         my $ident = ident($self);
                    186:
                    187:         return $completion_status_of{$ident};
                    188:     }
                    189:
1.1       andrew    190: }
                    191: 1;    # Magic true value required at end of module
                    192: __END__
                    193:
                    194: =head1 NAME
                    195:
1.12      andrew    196: Text::Todo::Entry - An object for manipulating an entry on a Text::Todo list
1.1       andrew    197:
                    198:
                    199: =head1 VERSION
                    200:
1.12      andrew    201: Since the $VERSION can't be automatically included,
                    202: here is the RCS Id instead, you'll have to look up $VERSION.
                    203:
1.15    ! andrew    204:     $Id: Entry.pm,v 1.14 2010/01/10 01:41:40 andrew Exp $
1.1       andrew    205:
                    206:
                    207: =head1 SYNOPSIS
                    208:
                    209:     use Text::Todo::Entry;
                    210:
1.12      andrew    211:     my $entry = Text::Todo::Entry->new('text of entry');
                    212:
                    213:     $entry->append('+project');
                    214:
                    215:     if ($entry->in_project('project') && ! $entry->priority) {
                    216:         print $entry->text, "\n";
                    217:     }
                    218:
                    219:
1.1       andrew    220: =head1 DESCRIPTION
                    221:
1.12      andrew    222: This module creates entries in a Text::Todo list.
                    223: It allows you to retrieve information about them and modify them.
                    224:
                    225: For more information see L<http://todotxt.com>
1.1       andrew    226:
                    227:
                    228: =head1 INTERFACE
                    229:
1.12      andrew    230: =head2 new
                    231:
                    232: Creates an entry that can be manipulated.
1.1       andrew    233:
1.13      andrew    234:     my $entry = Text::Todo::Entry->new([
                    235:     'text of entry' | {
                    236:         [ text => 'text of entry' ,]
                    237:         [ tags => { additional_arg => 'identfier' }, ]
                    238:     } ]);
1.12      andrew    239:
                    240: If you don't pass any text, creates a blank entry.
1.1       andrew    241:
1.13      andrew    242: See tags below for a description of additional tags.
                    243:
1.1       andrew    244: =head2 text
                    245:
1.12      andrew    246: Returns the text of the entry.
                    247:
                    248:     print $entry->text, "\n";
                    249:
                    250: =head2 pri
                    251:
                    252: Sets the priority of an entry. If the priority is set to an empty string,
                    253: clears the priority.
                    254:
                    255:     $entry->pri('B');
                    256:
                    257: Acceptible entries are an empty string, A-Z or a-z. Anything else will cause
                    258: an error.
                    259:
                    260: =head2 depri
                    261:
                    262: A convenience function that unsets priority by calling pri('').
                    263:
                    264:     $entry->depri;
                    265:
1.1       andrew    266: =head2 priority
                    267:
1.12      andrew    268: Returns the priority of an entry which may be an empty string if it is
1.1       andrew    269:
1.12      andrew    270:     my $priority = $entry->priority;
1.1       andrew    271:
1.12      andrew    272: =head2 tags
1.1       andrew    273:
1.12      andrew    274: Each tag type generates two accessor functions {tag}s and in_{tag}.
1.1       andrew    275:
1.12      andrew    276: Current tags are context (@) and project (+).
1.13      andrew    277:
                    278: When creating a new object you can pass in new tags to recognize.
                    279:
                    280:     my $entry = Text::Todo::Entry->new({
                    281:         text => 'do something DUE:2011-01-01',
                    282:         tags => { due_date => 'DUE:' }
                    283:     });
                    284:
                    285:     my @due_dates = $entry->due_dates;
                    286:
                    287: then @due_dates eq ( '2011-01-01' );
                    288:
                    289: and you could also:
                    290:
                    291:     if ($entry->in_due_date('2011-01-01')) {
                    292:         # do something
                    293:     }
                    294:
1.12      andrew    295:
                    296: =over
1.1       andrew    297:
1.12      andrew    298: =item {tag}s
1.1       andrew    299:
1.12      andrew    300:     @tags = $entry->{tag}s;
1.7       andrew    301:
1.12      andrew    302: =item in_{tag}
1.7       andrew    303:
1.12      andrew    304: returns true if $entry is in the tag, false if not.
1.1       andrew    305:
1.12      andrew    306:     if ($entry->in_{tag}('tag')) {
                    307:         # do something
                    308:     }
1.10      andrew    309:
1.12      andrew    310: =back
1.1       andrew    311:
1.12      andrew    312: =head3 context
1.1       andrew    313:
1.12      andrew    314: These are matched as a word beginning with @.
1.1       andrew    315:
                    316: =over
                    317:
1.12      andrew    318: =item contexts
1.1       andrew    319:
1.12      andrew    320: =item in_context
1.1       andrew    321:
1.12      andrew    322: =back
                    323:
                    324: =head3 project
                    325:
                    326: This is matched as a word beginning with +.
                    327:
                    328: =over
1.1       andrew    329:
1.12      andrew    330: =item projects
1.1       andrew    331:
1.12      andrew    332: =item in_project
1.1       andrew    333:
                    334: =back
                    335:
1.12      andrew    336: =head2 replace
                    337:
                    338: Replaces the text of an entry with completely new text.  Useful if there has
                    339: been manual modification of the entry or just a new direction.
                    340:
                    341:     $entry->replace('replacment text');
                    342:
                    343: =head2 prepend
                    344:
                    345: Attaches text (with a trailing space) to the beginning of an entry.  Puts it
                    346: after the done() "x" and the priority() letter.
                    347:
                    348:     $entry->prepend('NEED HELP');
                    349:
                    350: =head2 append
                    351:
                    352: Adds text to the end of an entry.
                    353: Useful for adding tags, or just additional information.
                    354:
                    355:     $entry->append('@specific_store');
                    356:
                    357: =head2 do
                    358:
                    359: Marks an entry as completed.
                    360:
                    361:     $entry->do;
                    362:
                    363: Does this by prepending an 'x' to the beginning of the entry.
                    364:
                    365: =head2 done
                    366:
                    367: Returns true if an entry is marked complete and false if not.
                    368:
                    369:     if (!$entry->done) {
                    370:         # remind me to do it
                    371:     }
                    372:
                    373:
                    374: =head1 DIAGNOSTICS
1.1       andrew    375:
                    376: =head1 CONFIGURATION AND ENVIRONMENT
                    377:
                    378: Text::Todo::Entry requires no configuration files or environment variables.
                    379:
                    380:
1.12      andrew    381: =head1 DEPENDENCIES
1.1       andrew    382:
1.12      andrew    383: Class::Std::Utils
                    384: List::Util
                    385: version
1.1       andrew    386:
                    387:
                    388: =head1 INCOMPATIBILITIES
                    389:
                    390: None reported.
                    391:
                    392:
                    393: =head1 BUGS AND LIMITATIONS
                    394:
1.12      andrew    395: No bugs have been reported.
                    396:
                    397: Known limitations:
1.1       andrew    398:
1.12      andrew    399: Sometimes leading whitespace may get screwed up when making changes.  It
                    400: doesn't seem to be particularly a problem, but if you use whitespace to indent
                    401: entries for some reason it could be.
1.1       andrew    402:
                    403: Please report any bugs or feature requests to
                    404: C<bug-text-todo@rt.cpan.org>, or through the web interface at
                    405: L<http://rt.cpan.org>.
                    406:
                    407:
                    408: =head1 AUTHOR
                    409:
                    410: Andrew Fresh  C<< <andrew@cpan.org> >>
                    411:
                    412:
                    413: =head1 LICENSE AND COPYRIGHT
                    414:
                    415: Copyright (c) 2009, Andrew Fresh C<< <andrew@cpan.org> >>. All rights reserved.
                    416:
                    417: This module is free software; you can redistribute it and/or
                    418: modify it under the same terms as Perl itself. See L<perlartistic>.
                    419:
                    420:
                    421: =head1 DISCLAIMER OF WARRANTY
                    422:
                    423: BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
                    424: FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
                    425: OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
                    426: PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
                    427: EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
                    428: WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
                    429: ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
                    430: YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
                    431: NECESSARY SERVICING, REPAIR, OR CORRECTION.
                    432:
                    433: IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
                    434: WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
                    435: REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
                    436: LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
                    437: OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
                    438: THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
                    439: RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
                    440: FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
                    441: SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
                    442: SUCH DAMAGES.

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>