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

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

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