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

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

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