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