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

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

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