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