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

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

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