[BACK]Return to API.pm CVS log [TXT][DIR] Up to [local] / todotxt / Text-Todo-REST-API / lib / Text / Todo / REST

Annotation of todotxt/Text-Todo-REST-API/lib/Text/Todo/REST/API.pm, Revision 1.12

1.1       andrew      1: package Text::Todo::REST::API;
                      2:
1.12    ! andrew      3: # $AFresh1: API.pm,v 1.11 2010/01/24 04:38:21 andrew Exp $
1.1       andrew      4:
                      5: use warnings;
                      6: use strict;
                      7: use Carp;
                      8:
1.2       andrew      9: use Text::Todo;
1.10      andrew     10: use Text::Todo::REST::API::Response;
1.1       andrew     11:
1.5       andrew     12: use Class::Std::Utils;
1.8       andrew     13: use Digest::MD5 qw/ md5_hex /;
                     14:
1.2       andrew     15: use version; our $VERSION = qv('0.0.1');
1.1       andrew     16:
1.2       andrew     17: {
1.5       andrew     18:     my @attr_refs = \(
                     19:         my %todo_of,
1.6       andrew     20:
1.5       andrew     21:         my %suffix_of,
                     22:         my %file_regex_of,
1.6       andrew     23:
1.8       andrew     24:         my %format_of,
1.6       andrew     25:
1.5       andrew     26:         my %action_handlers,
                     27:     );
1.2       andrew     28:
1.5       andrew     29:     sub new {
                     30:         my ( $class, $options ) = @_;
                     31:
1.8       andrew     32:         my $self = bless anon_scalar(), $class;
                     33:         my $ident = ident($self);
                     34:
                     35:         $format_of{$ident} = $options->{default_format};
1.2       andrew     36:         if ( $options->{format} ) {
1.8       andrew     37:             $format_of{$ident} = $options->{format};
1.2       andrew     38:         }
                     39:
1.8       andrew     40:         $suffix_of{$ident} = $options->{suffix} || '.txt';
1.2       andrew     41:
                     42:         $file_regex_of{$ident} = $options->{file_regex} || qr{
                     43:             .*
                     44:             todo
                     45:             .*
                     46:             \Q$suffix_of{$ident}\E
                     47:             $
                     48:         }ixms;
                     49:
1.8       andrew     50:         eval {
                     51:             $todo_of{$ident} = Text::Todo->new(
                     52:                 {   todo_dir  => $options->{todo_dir},
                     53:                     todo_file => $options->{todo_file},
                     54:                 }
                     55:             );
                     56:         };
1.7       andrew     57:         if ($@) {
1.8       andrew     58:             $self->fail( 'Unable to create Text::Todo object' . $@ );
1.2       andrew     59:         }
                     60:
1.5       andrew     61:         return $self;
1.2       andrew     62:     }
                     63:
1.9       andrew     64:     sub _parse_options {
                     65:         my ( $self, $method, @args ) = @_;
                     66:
                     67:         my %options = (
                     68:             method => lc $method,
                     69:             list   => '',
                     70:             action => 'files',
                     71:             args   => [],
                     72:         );
                     73:
                     74:         if (@args) {
                     75:             if ( !ref $args[0] ) {
                     76:                 $options{path} = shift @args;
                     77:             }
                     78:
                     79:             if ( ref $args[0] eq 'HASH' ) {
                     80:                 my $opts = shift @args;
                     81:                 foreach my $o ( keys %{$opts} ) {
                     82:                     $options{$o} = $opts->{$o};
                     83:                 }
                     84:             }
                     85:         }
1.2       andrew     86:
1.9       andrew     87:         if ( exists $options{path} ) {
                     88:             my %opts = $self->_split_path( $options{path} );
                     89:             delete $options{path};
                     90:
                     91:             foreach my $o ( keys %opts ) {
                     92:                 if ( defined $opts{$o} ) {
                     93:                     $options{$o} = $opts{$o};
                     94:                 }
                     95:             }
1.2       andrew     96:         }
                     97:
1.10      andrew     98:         if ( $options{action} eq 'entry' && @{ $options{args} } ) {
1.9       andrew     99:             $options{entry} = shift @{ $options{args} };
1.10      andrew    100:             if ( @{ $options{args} } ) {
1.12    ! andrew    101:                 $options{action} .= q{_} . lc shift @{ $options{args} };
1.9       andrew    102:             }
                    103:         }
1.4       andrew    104:
1.9       andrew    105:         push @{ $options{args} }, @args;
1.2       andrew    106:
1.10      andrew    107:         $options{list}
                    108:             = defined $options{list} ? $options{list} : 'todo_file';
1.8       andrew    109:
1.9       andrew    110:         if ( $options{format} ) {
                    111:             $format_of{ ident $self } = $options{format};
                    112:             delete $options{format};
                    113:         }
1.8       andrew    114:
1.9       andrew    115:         my @method;
                    116:         foreach my $o qw( method action ) {
                    117:             if ( $options{$o} ) {
                    118:                 push @method, $options{$o};
1.8       andrew    119:             }
                    120:         }
1.9       andrew    121:         $method = join q{_}, @method;
1.8       andrew    122:
1.9       andrew    123:         return $method, %options;
1.2       andrew    124:     }
                    125:
1.9       andrew    126:     sub _handle_action {
1.8       andrew    127:         my ( $self, @args ) = @_;
1.9       andrew    128:
1.10      andrew    129:         my ( $method, %options ) = $self->_parse_options(@args);
1.9       andrew    130:
                    131:         my $todo = $self->_todo;
                    132:         $todo->load( $options{list} );
                    133:
1.10      andrew    134:         foreach my $class ($self) {
                    135:             if ( $class->can($method) ) {
1.11      andrew    136:                 return Text::Todo::REST::API::Response->new(
                    137:                     {   type   => $options{action},
                    138:                         format => $self->_format,
                    139:                         data   => $class->$method( $todo, \%options ),
                    140:                     }
                    141:                 );
1.9       andrew    142:             }
                    143:         }
                    144:
                    145:         return $self->fail( 'Unable to handle [' . $method . ']' );
1.2       andrew    146:     }
                    147:
1.9       andrew    148:     sub _split_path {
                    149:         my ( $self, $path ) = @_;
                    150:
                    151:         my %options = (
                    152:             list   => undef,
                    153:             action => undef,
                    154:             args   => [],
                    155:         );
                    156:
                    157:         $path = defined $path ? $path : q{};
                    158:         $path =~ s{^/}{}xms;
                    159:
                    160:         if ( $path =~ s/\.(\w+)$//xms ) {
                    161:             $options{format} = $1;
                    162:         }
                    163:
                    164:         ( $options{list}, $options{action}, @{ $options{args} } ) = split '/',
                    165:             $path;
                    166:
                    167:         if ( $options{list} ) {
                    168:             $options{action} ||= 'list';
                    169:
                    170:             my $suffix = $self->_suffix;
                    171:
1.10      andrew    172:             if ( ( lc $options{list} ) eq 'files' ) {
1.9       andrew    173:                 $options{action} = lc $options{list};
1.10      andrew    174:                 $options{list}   = q{};
1.9       andrew    175:             }
1.10      andrew    176:             elsif ( $self->_todo->file( $options{list} ) ) {
                    177:                 $options{list} = $self->_todo->file( $options{list} );
1.9       andrew    178:             }
                    179:         }
1.2       andrew    180:
1.9       andrew    181:         if ( @{ $options{args} } && ( lc $options{args}[0] ) eq 'entry' ) {
                    182:             $options{action} = lc shift @{ $options{args} };
1.2       andrew    183:         }
                    184:
1.9       andrew    185:         return %options;
1.3       andrew    186:     }
                    187:
                    188:     sub GET {
                    189:         my ( $self, @args ) = @_;
                    190:         return $self->_handle_action( 'GET', @args );
1.2       andrew    191:     }
                    192:
1.12    ! andrew    193:     sub get_entry_done {
        !           194:         my ( $self, $todo, $key ) = @_;
        !           195:         my $entry = $self->get_entry( $todo, $key );
        !           196:
        !           197:         return $todo->list->[ $entry->{line} - 1 ]->done;
        !           198:     }
        !           199:
1.2       andrew    200:     sub get_entry {
1.9       andrew    201:         my ( $self, $todo, $key ) = @_;
1.2       andrew    202:
                    203:         if ( !$key ) {
                    204:             return $self->fail("get_entry requires arguments");
                    205:         }
                    206:         elsif ( ref $key eq 'ARRAY' ) {
1.12    ! andrew    207:             return self->get_entry( $_->[0] );
1.2       andrew    208:         }
1.9       andrew    209:         elsif ( ref $key eq 'HASH' ) {
1.10      andrew    210:             if ( exists $key->{entry} ) {
                    211:                 $key = $key->{entry};
1.9       andrew    212:             }
                    213:             else {
                    214:                 return $self->fail('get_entry requires key [entry]');
                    215:             }
                    216:         }
1.2       andrew    217:
1.11      andrew    218:         my $list = $self->get_list($todo);
1.2       andrew    219:
                    220:         if ( $key =~ /^[[:xdigit:]]{32}$/xms ) {
                    221:             my $search = lc $key;
                    222:
1.12    ! andrew    223:             foreach my $e ( @{$list} ) {
1.2       andrew    224:                 if ( $search eq $e->{md5} ) {
1.12    ! andrew    225:                     return $e;
1.2       andrew    226:                 }
                    227:             }
                    228:         }
                    229:         elsif ( $key =~ /^\d+$/xms ) {
1.12    ! andrew    230:             return $list->[ $key - 1 ];
1.2       andrew    231:         }
                    232:
1.12    ! andrew    233:         return $self->fail("Unable to find entry!");
1.2       andrew    234:     }
                    235:
                    236:     sub get_list {
1.10      andrew    237:         my ( $self, $todo ) = @_;
1.2       andrew    238:
                    239:         my $line = 1;
1.11      andrew    240:         my @list = map ( {
1.2       andrew    241:                 line => $line++,
                    242:                 md5  => md5_hex( $_->text ),
                    243:                 text => $_->text,
                    244:             },
1.9       andrew    245:             $todo->list );
1.11      andrew    246:         return \@list;
1.2       andrew    247:     }
                    248:
                    249:     sub get_files {
1.10      andrew    250:         my ( $self, $todo ) = @_;
1.9       andrew    251:         my $dir = $todo->file('todo_dir');
1.2       andrew    252:
                    253:         if ( !$dir ) {
                    254:             return $self->fail('Unable to find todo_dir');
                    255:         }
                    256:
                    257:         my $file_regex = $self->_file_regex;
                    258:
                    259:         opendir my $dh, $dir or croak "Couldn't opendir: $!";
                    260:         my @files = grep {m/$file_regex/xms} readdir $dh;
                    261:         closedir $dh;
                    262:
1.11      andrew    263:         return \@files;
1.2       andrew    264:     }
                    265:
                    266:     sub get_tags {
1.9       andrew    267:         my ( $self, $todo, $tag ) = @_;
1.11      andrew    268:         return [ $todo->listtag($tag) ];
1.2       andrew    269:     }
                    270:
1.5       andrew    271:     sub POST {
1.3       andrew    272:         my ( $self, @args ) = @_;
                    273:         return $self->_handle_action( 'POST', @args );
                    274:     }
                    275:
1.5       andrew    276:     sub PUT {
1.3       andrew    277:         my ( $self, @args ) = @_;
                    278:         return $self->_handle_action( 'PUT', @args );
                    279:     }
                    280:
                    281:     sub DELETE {
                    282:         my ( $self, @args ) = @_;
                    283:         return $self->_handle_action( 'DELETE', @args );
                    284:     }
1.2       andrew    285:
                    286:     sub fail {
                    287:         my ( $self, @message ) = @_;
                    288:         croak(@message);
                    289:     }
                    290:
                    291:     sub _todo       { my ($self) = @_; return $todo_of{ ident $self }; }
                    292:     sub _suffix     { my ($self) = @_; return $suffix_of{ ident $self}; }
                    293:     sub _file_regex { my ($self) = @_; return $file_regex_of{ ident $self}; }
1.8       andrew    294:     sub _format     { my ($self) = @_; return $format_of{ ident $self}; }
1.1       andrew    295:
1.5       andrew    296:     sub DESTROY {
                    297:         my ($self) = @_;
                    298:         my $ident = ident $self;
                    299:         foreach my $attr_ref (@attr_refs) {
                    300:             delete $attr_ref->{$ident};
                    301:         }
                    302:     }
1.2       andrew    303: }
                    304: 1;    # Magic true value required at end of module
1.1       andrew    305: __END__
                    306:
                    307: =head1 NAME
                    308:
                    309: Text::Todo::REST::API - [One line description of module's purpose here]
                    310:
                    311:
                    312: =head1 VERSION
                    313:
                    314: This document describes Text::Todo::REST::API version 0.0.1
                    315:
                    316:
                    317: =head1 SYNOPSIS
                    318:
                    319:     use Text::Todo::REST::API;
                    320:
                    321: =for author to fill in:
                    322:     Brief code example(s) here showing commonest usage(s).
                    323:     This section will be as far as many users bother reading
                    324:     so make it as educational and exeplary as possible.
                    325:
                    326:
                    327: =head1 DESCRIPTION
                    328:
                    329: =for author to fill in:
                    330:     Write a full description of the module and its features here.
                    331:     Use subsections (=head2, =head3) as appropriate.
                    332:
                    333:
                    334: =head1 INTERFACE
                    335:
                    336: =for author to fill in:
                    337:     Write a separate section listing the public components of the modules
                    338:     interface. These normally consist of either subroutines that may be
                    339:     exported, or methods that may be called on objects belonging to the
                    340:     classes provided by the module.
                    341:
                    342:
                    343: =head1 DIAGNOSTICS
                    344:
                    345: =for author to fill in:
                    346:     List every single error and warning message that the module can
                    347:     generate (even the ones that will "never happen"), with a full
                    348:     explanation of each problem, one or more likely causes, and any
                    349:     suggested remedies.
                    350:
                    351: =over
                    352:
                    353: =item C<< Error message here, perhaps with %s placeholders >>
                    354:
                    355: [Description of error here]
                    356:
                    357: =item C<< Another error message here >>
                    358:
                    359: [Description of error here]
                    360:
                    361: [Et cetera, et cetera]
                    362:
                    363: =back
                    364:
                    365:
                    366: =head1 CONFIGURATION AND ENVIRONMENT
                    367:
                    368: =for author to fill in:
                    369:     A full explanation of any configuration system(s) used by the
                    370:     module, including the names and locations of any configuration
                    371:     files, and the meaning of any environment variables or properties
                    372:     that can be set. These descriptions must also include details of any
                    373:     configuration language used.
                    374:
                    375: Text::Todo::REST::API requires no configuration files or environment variables.
                    376:
                    377:
                    378: =head1 DEPENDENCIES
                    379:
                    380: =for author to fill in:
                    381:     A list of all the other modules that this module relies upon,
                    382:     including any restrictions on versions, and an indication whether
                    383:     the module is part of the standard Perl distribution, part of the
                    384:     module's distribution, or must be installed separately. ]
                    385:
                    386: None.
                    387:
                    388:
                    389: =head1 INCOMPATIBILITIES
                    390:
                    391: =for author to fill in:
                    392:     A list of any modules that this module cannot be used in conjunction
                    393:     with. This may be due to name conflicts in the interface, or
                    394:     competition for system or program resources, or due to internal
                    395:     limitations of Perl (for example, many modules that use source code
                    396:     filters are mutually incompatible).
                    397:
                    398: None reported.
                    399:
                    400:
                    401: =head1 BUGS AND LIMITATIONS
                    402:
                    403: =for author to fill in:
                    404:     A list of known problems with the module, together with some
                    405:     indication Whether they are likely to be fixed in an upcoming
                    406:     release. Also a list of restrictions on the features the module
                    407:     does provide: data types that cannot be handled, performance issues
                    408:     and the circumstances in which they may arise, practical
                    409:     limitations on the size of data sets, special cases that are not
                    410:     (yet) handled, etc.
                    411:
                    412: No bugs have been reported.
                    413:
                    414: Please report any bugs or feature requests to
                    415: C<bug-text-todo-rest-api@rt.cpan.org>, or through the web interface at
                    416: L<http://rt.cpan.org>.
                    417:
                    418:
                    419: =head1 AUTHOR
                    420:
                    421: Andrew Fresh  C<< <andrew@cpan.org> >>
                    422:
                    423:
                    424: =head1 LICENSE AND COPYRIGHT
                    425:
                    426: Copyright (c) 2010, Andrew Fresh C<< <andrew@cpan.org> >>. All rights reserved.
                    427:
                    428: This module is free software; you can redistribute it and/or
                    429: modify it under the same terms as Perl itself. See L<perlartistic>.
                    430:
                    431:
                    432: =head1 DISCLAIMER OF WARRANTY
                    433:
                    434: BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
                    435: FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
                    436: OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
                    437: PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
                    438: EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
                    439: WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
                    440: ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
                    441: YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
                    442: NECESSARY SERVICING, REPAIR, OR CORRECTION.
                    443:
                    444: IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
                    445: WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
                    446: REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
                    447: LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
                    448: OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
                    449: THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
                    450: RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
                    451: FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
                    452: SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
                    453: SUCH DAMAGES.

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