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

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

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