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