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