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

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

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