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

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

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