version 1.1, 2010/01/16 16:01:07 |
version 1.4, 2010/01/18 00:30:42 |
|
|
package Text::Todo::REST::API; |
package Text::Todo::REST::API; |
|
|
# $RedRiver$ |
# $AFresh1: API.pm,v 1.3 2010/01/17 23:48:06 andrew Exp $ |
|
|
use warnings; |
use warnings; |
use strict; |
use strict; |
use Carp; |
use Carp; |
|
|
|
use Data::Dumper; |
|
use Text::Todo; |
|
|
|
use Class::Std; |
|
use Digest::MD5 qw/ md5_hex /; |
|
use File::Spec; |
|
|
use version; our $VERSION = qv('0.0.1'); |
use version; our $VERSION = qv('0.0.1'); |
|
|
# Other recommended modules (uncomment to use): |
&RegisterActionHandler( |
# use IO::Prompt; |
'GET', |
# use Perl6::Export; |
[ list => 'get_list' ], |
# use Perl6::Slurp; |
[ entry => 'get_entry' ], |
# use Perl6::Say; |
[ tags => 'get_tags' ], |
|
[ files => 'get_files' ], |
|
); |
|
|
|
{ |
|
my (%todo_of, %basedir_of, %subdir_of, |
|
%suffix_of, %file_regex_of, %user_of, |
|
%list_of, %action_of, %args_of, |
|
%action_handlers, %format_handlers, |
|
) : ATTRS; |
|
|
# Module implementation here |
sub BUILD { |
|
my ( $self, $ident, $options ) = @_; |
|
|
|
my $format = $options->{default_format}; |
|
if ( $options->{format} ) { |
|
$format = $options->{format}; |
|
} |
|
elsif ($options->{path_info} |
|
&& $options->{path_info} =~ s/\.(\w+)$//xms ) |
|
{ |
|
$format = $1; |
|
} |
|
|
1; # Magic true value required at end of module |
if ( ref $self eq __PACKAGE__ && $format ) { |
|
if ( $format_handlers{$format} ) { |
|
bless $self, $format_handlers{$format}; |
|
} |
|
else { |
|
croak("Unable to find handler for [$format]\n"); |
|
} |
|
} |
|
|
|
$basedir_of{$ident} = $options->{basedir}; |
|
$subdir_of{$ident} = $options->{subdir}; |
|
$suffix_of{$ident} = $options->{suffix} || '.txt'; |
|
|
|
$file_regex_of{$ident} = $options->{file_regex} || qr{ |
|
.* |
|
todo |
|
.* |
|
\Q$suffix_of{$ident}\E |
|
$ |
|
}ixms; |
|
|
|
if ( !$basedir_of{$ident} ) { |
|
return $self->fail('Required option [basedir]'); |
|
} |
|
|
|
$options->{path_info} ||= q{}; |
|
$options->{path_info} =~ s{^/}{}xms; |
|
( $user_of{$ident}, $list_of{$ident}, |
|
$action_of{$ident}, @{ $args_of{$ident} }, |
|
) = split '/', $options->{path_info}; |
|
|
|
if ( $list_of{$ident} ) { |
|
$action_of{$ident} ||= 'list'; |
|
} |
|
elsif ( $user_of{$ident} ) { |
|
$action_of{$ident} = 'files'; |
|
} |
|
|
|
my @todo_dir = $basedir_of{$ident}; |
|
|
|
my $todo_dir; |
|
if ( $user_of{$ident} ) { |
|
push @todo_dir, $user_of{$ident}; |
|
if ( $subdir_of{$ident} ) { |
|
push @todo_dir, $subdir_of{$ident}; |
|
} |
|
|
|
$todo_dir = File::Spec->catdir(@todo_dir); |
|
} |
|
|
|
my $todo_file; |
|
if ( $list_of{$ident} ) { |
|
$todo_file = $list_of{$ident} . $suffix_of{$ident}; |
|
} |
|
|
|
$todo_of{$ident} = Text::Todo->new( |
|
{ todo_dir => $todo_dir, |
|
todo_file => $todo_file, |
|
} |
|
) or $self->fail('Unable to create Text::Todo object'); |
|
|
|
$todo_of{$ident}->load('todo_file') |
|
or $self->fail('Unable to create Text::Todo object'); |
|
|
|
return; |
|
} |
|
|
|
sub RegisterFormatHandler { |
|
my ( $handler, @types ) = @_; |
|
|
|
foreach my $type (@types) { |
|
$format_handlers{$type} = $handler; |
|
} |
|
|
|
return 1; |
|
} |
|
|
|
sub RegisterActionHandler { |
|
my ( $handler, @types ) = @_; |
|
|
|
foreach my $type (@types) { |
|
$action_handlers{$handler}{ $type->[0] } = $type->[1]; |
|
} |
|
|
|
return 1; |
|
} |
|
|
|
sub content_type { return }; |
|
|
|
sub Dump { |
|
my ($self) = @_; |
|
return $self->fail( 'Unable to Dump [' . $self->_action . ']' ); |
|
} |
|
|
|
sub Load { |
|
my ($self) = @_; |
|
return $self->fail( 'Unable to Load [' . $self->_action . ']' ); |
|
} |
|
|
|
sub _handle_action { |
|
my ( $self, $method, $params ) = @_; |
|
|
|
if ( exists $action_handlers{$method}{ $self->_action } ) { |
|
my $a = $action_handlers{$method}{ $self->_action }; |
|
return $self->$a( $self->_args, $params ); |
|
} |
|
|
|
return $self->fail( |
|
'Unable to handle ' . $method . ' [' . $self->_action . ']' ); |
|
} |
|
|
|
sub GET { |
|
my ( $self, @args ) = @_; |
|
return $self->_handle_action( 'GET', @args ); |
|
} |
|
|
|
sub get_entry { |
|
my ( $self, $key ) = @_; |
|
|
|
if ( !$key ) { |
|
return $self->fail("get_entry requires arguments"); |
|
} |
|
elsif ( ref $key eq 'ARRAY' ) { |
|
my @entries; |
|
foreach ( @{$key} ) { |
|
push @entries, $self->get_entry($_); |
|
} |
|
return @entries; |
|
} |
|
|
|
my @list = $self->get_list; |
|
|
|
my $entry; |
|
if ( $key =~ /^[[:xdigit:]]{32}$/xms ) { |
|
my $search = lc $key; |
|
|
|
ENTRY: foreach my $e (@list) { |
|
if ( $search eq $e->{md5} ) { |
|
$entry = $e; |
|
last ENTRY; |
|
} |
|
} |
|
} |
|
elsif ( $key =~ /^\d+$/xms ) { |
|
$entry = $list[ $key - 1 ]; |
|
} |
|
|
|
if ( !$entry ) { |
|
return $self->fail("Unable to find entry!"); |
|
} |
|
|
|
return $entry; |
|
} |
|
|
|
sub get_list { |
|
my ($self) = @_; |
|
|
|
my $line = 1; |
|
return map ( { |
|
line => $line++, |
|
md5 => md5_hex( $_->text ), |
|
text => $_->text, |
|
}, |
|
$self->_todo->list ); |
|
} |
|
|
|
sub get_files { |
|
my ($self) = @_; |
|
my $dir = $self->_todo->file('todo_dir'); |
|
|
|
if ( !$dir ) { |
|
return $self->fail('Unable to find todo_dir'); |
|
} |
|
|
|
my $file_regex = $self->_file_regex; |
|
|
|
opendir my $dh, $dir or croak "Couldn't opendir: $!"; |
|
my @files = grep {m/$file_regex/xms} readdir $dh; |
|
closedir $dh; |
|
|
|
return @files; |
|
} |
|
|
|
sub get_tags { |
|
my ( $self, $tag ) = @_; |
|
my $ident = ident($self); |
|
|
|
return $todo_of{$ident}->listtag($tag); |
|
} |
|
|
|
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 _basedir { my ($self) = @_; return $basedir_of{ ident $self}; } |
|
sub _subdir { my ($self) = @_; return $subdir_of{ ident $self}; } |
|
sub _suffix { my ($self) = @_; return $suffix_of{ ident $self}; } |
|
sub _file_regex { my ($self) = @_; return $file_regex_of{ ident $self}; } |
|
sub _user { my ($self) = @_; return $user_of{ ident $self}; } |
|
sub _list { my ($self) = @_; return $list_of{ ident $self}; } |
|
sub _action { my ($self) = @_; return $action_of{ ident $self}; } |
|
sub _args { my ($self) = @_; return $args_of{ ident $self}; } |
|
|
|
} |
|
1; # Magic true value required at end of module |
__END__ |
__END__ |
|
|
=head1 NAME |
=head1 NAME |