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