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

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

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