version 1.1.1.1, 2010/01/16 16:01:07 |
version 1.16, 2010/01/26 06:03:11 |
|
|
package Text::Todo::REST::API; |
package Text::Todo::REST::API; |
|
|
# $RedRiver$ |
# $AFresh1: API.pm,v 1.15 2010/01/26 05:47:30 andrew Exp $ |
|
|
use warnings; |
use warnings; |
use strict; |
use strict; |
use Carp; |
use Carp; |
|
|
|
use Text::Todo; |
|
use Text::Todo::REST::API::Response; |
|
|
|
use Module::Pluggable |
|
instantiate => 'new', |
|
search_path => 'Text::Todo::REST::API::Actions', |
|
sub_name => 'actions'; |
|
|
|
use Class::Std::Utils; |
|
|
use version; our $VERSION = qv('0.0.1'); |
use version; our $VERSION = qv('0.0.1'); |
|
|
# Other recommended modules (uncomment to use): |
{ |
# use IO::Prompt; |
my @attr_refs = \( |
# use Perl6::Export; |
my %todo_of, |
# use Perl6::Slurp; |
|
# use Perl6::Say; |
|
|
|
|
my %suffix_of, |
|
my %file_regex_of, |
|
|
# Module implementation here |
my %format_of, |
|
|
|
my %action_handlers, |
|
); |
|
|
1; # Magic true value required at end of module |
sub new { |
|
my ( $class, $options ) = @_; |
|
|
|
my $self = bless anon_scalar(), $class; |
|
my $ident = ident($self); |
|
|
|
$format_of{$ident} = $options->{default_format}; |
|
if ( $options->{format} ) { |
|
$format_of{$ident} = $options->{format}; |
|
} |
|
|
|
$suffix_of{$ident} = $options->{suffix} || '.txt'; |
|
|
|
$file_regex_of{$ident} = $options->{file_regex} || qr{ |
|
.* |
|
todo |
|
.* |
|
\Q$suffix_of{$ident}\E |
|
$ |
|
}ixms; |
|
|
|
eval { |
|
$todo_of{$ident} = Text::Todo->new( |
|
{ todo_dir => $options->{todo_dir}, |
|
todo_file => $options->{todo_file}, |
|
} |
|
); |
|
}; |
|
if ($@) { |
|
$self->fail( 'Unable to create Text::Todo object' . $@ ); |
|
} |
|
|
|
return $self; |
|
} |
|
|
|
sub _parse_options { |
|
my ( $self, $method, @args ) = @_; |
|
|
|
my %options = ( |
|
method => lc $method, |
|
list => '', |
|
action => 'files', |
|
args => [], |
|
|
|
suffix => $self->_suffix, |
|
file_regex => $self->_file_regex, |
|
format => $self->_format, |
|
); |
|
|
|
if (@args) { |
|
if ( !ref $args[0] ) { |
|
$options{path} = shift @args; |
|
} |
|
|
|
if ( ref $args[0] eq 'HASH' ) { |
|
my $opts = shift @args; |
|
foreach my $o ( keys %{$opts} ) { |
|
$options{$o} = $opts->{$o}; |
|
} |
|
} |
|
} |
|
|
|
if ( exists $options{path} ) { |
|
my %opts = $self->_split_path( $options{path} ); |
|
delete $options{path}; |
|
|
|
foreach my $o ( keys %opts ) { |
|
if ( defined $opts{$o} ) { |
|
$options{$o} = $opts{$o}; |
|
} |
|
} |
|
} |
|
|
|
if ( $options{action} eq 'entry' && @{ $options{args} } ) { |
|
$options{entry} = shift @{ $options{args} }; |
|
if ( @{ $options{args} } ) { |
|
$options{action} .= q{_} . lc shift @{ $options{args} }; |
|
} |
|
} |
|
|
|
push @{ $options{args} }, @args; |
|
|
|
my $list = $self->_todo->file( $options{list} ); |
|
|
|
my $suffix = $self->_suffix || q{}; |
|
if ( $list !~ / \Q$suffix\E $/ixms ) { |
|
$list .= $suffix; |
|
} |
|
|
|
$options{list} = $list; |
|
|
|
if ( $options{format} ) { |
|
$format_of{ ident $self } = $options{format}; |
|
delete $options{format}; |
|
} |
|
|
|
my @method; |
|
foreach my $o qw( method action ) { |
|
if ( $options{$o} ) { |
|
push @method, $options{$o}; |
|
} |
|
} |
|
$method = join q{_}, @method; |
|
|
|
return $method, %options; |
|
} |
|
|
|
sub _handle_action { |
|
my ( $self, @args ) = @_; |
|
|
|
my ( $method, %options ) = $self->_parse_options(@args); |
|
|
|
my $todo = $self->_todo; |
|
$todo->load( $options{list} ); |
|
|
|
foreach my $class ( $self->actions ) { |
|
if ( $class->can($method) ) { |
|
return Text::Todo::REST::API::Response->new( |
|
{ type => $options{action}, |
|
format => $self->_format, |
|
data => $class->$method( $todo, \%options ), |
|
} |
|
); |
|
} |
|
} |
|
|
|
return $self->fail( 'Unable to handle [' . $method . ']' ); |
|
} |
|
|
|
sub _split_path { |
|
my ( $self, $path ) = @_; |
|
|
|
my %options = ( |
|
list => undef, |
|
action => undef, |
|
args => [], |
|
); |
|
|
|
$path = defined $path ? $path : q{}; |
|
$path =~ s{^/}{}xms; |
|
|
|
if ( $path =~ s/\.(\w+)$//xms ) { |
|
$options{format} = $1; |
|
} |
|
|
|
( $options{list}, $options{action}, @{ $options{args} } ) = split '/', |
|
$path; |
|
|
|
if ( $options{list} ) { |
|
$options{action} ||= 'list'; |
|
|
|
my $list = $options{list}; |
|
|
|
if ( ( lc $options{list} ) eq 'files' ) { |
|
$options{action} = lc $list; |
|
$list = q{}; |
|
} |
|
|
|
$options{list} = $list; |
|
} |
|
|
|
if ( @{ $options{args} } && ( lc $options{args}[0] ) eq 'entry' ) { |
|
$options{action} = lc shift @{ $options{args} }; |
|
} |
|
|
|
return %options; |
|
} |
|
|
|
sub GET { |
|
my ( $self, @args ) = @_; |
|
return $self->_handle_action( 'GET', @args ); |
|
} |
|
|
|
sub POST { |
|
my ( $self, @args ) = @_; |
|
return $self->_handle_action( 'POST', @args ); |
|
} |
|
|
|
sub PUT { |
|
my ( $self, @args ) = @_; |
|
return $self->_handle_action( 'PUT', @args ); |
|
} |
|
|
|
sub DELETE { |
|
my ( $self, @args ) = @_; |
|
return $self->_handle_action( 'DELETE', @args ); |
|
} |
|
|
|
sub fail { |
|
my ( $self, @message ) = @_; |
|
croak(@message); |
|
} |
|
|
|
sub _todo { my ($self) = @_; return $todo_of{ ident $self }; } |
|
sub _suffix { my ($self) = @_; return $suffix_of{ ident $self}; } |
|
sub _file_regex { my ($self) = @_; return $file_regex_of{ ident $self}; } |
|
sub _format { my ($self) = @_; return $format_of{ ident $self}; } |
|
|
|
sub DESTROY { |
|
my ($self) = @_; |
|
my $ident = ident $self; |
|
foreach my $attr_ref (@attr_refs) { |
|
delete $attr_ref->{$ident}; |
|
} |
|
} |
|
} |
|
1; # Magic true value required at end of module |
__END__ |
__END__ |
|
|
=head1 NAME |
=head1 NAME |