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