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