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

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

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