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