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