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

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

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