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

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

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