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

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

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