version 1.5, 2010/01/18 03:10:42 |
version 1.8, 2010/01/19 03:18:34 |
|
|
package Text::Todo::REST::API; |
package Text::Todo::REST::API; |
|
|
# $AFresh1: API.pm,v 1.4 2010/01/18 00:30:42 andrew Exp $ |
# $AFresh1: API.pm,v 1.7 2010/01/18 13:47:53 andrew Exp $ |
|
|
use warnings; |
use warnings; |
use strict; |
use strict; |
|
|
|
|
use Class::Std::Utils; |
use Class::Std::Utils; |
use Digest::MD5 qw/ md5_hex /; |
use Digest::MD5 qw/ md5_hex /; |
use File::Spec; |
|
|
|
|
use Module::Pluggable |
|
instantiate => 'new', |
|
search_path => __PACKAGE__ . '::Representations', |
|
sub_name => 'representations'; |
|
|
use version; our $VERSION = qv('0.0.1'); |
use version; our $VERSION = qv('0.0.1'); |
|
|
&RegisterActionHandler( |
&RegisterActionHandler( |
|
|
{ |
{ |
my @attr_refs = \( |
my @attr_refs = \( |
my %todo_of, |
my %todo_of, |
my %basedir_of, |
|
my %subdir_of, |
|
my %suffix_of, |
my %suffix_of, |
my %file_regex_of, |
my %file_regex_of, |
|
|
|
my %format_of, |
my %user_of, |
my %user_of, |
my %list_of, |
my %list_of, |
my %action_of, |
my %action_of, |
my %args_of, |
my %args_of, |
|
|
my %action_handlers, |
my %action_handlers, |
my %format_handlers, |
|
); |
); |
|
|
sub new { |
sub new { |
|
|
my $self = bless anon_scalar(), $class; |
my $self = bless anon_scalar(), $class; |
my $ident = ident($self); |
my $ident = ident($self); |
|
|
my $format = $options->{default_format}; |
$format_of{$ident} = $options->{default_format}; |
if ( $options->{format} ) { |
if ( $options->{format} ) { |
$format = $options->{format}; |
$format_of{$ident} = $options->{format}; |
} |
} |
elsif ($options->{path_info} |
elsif ($options->{path_info} |
&& $options->{path_info} =~ s/\.(\w+)$//xms ) |
&& $options->{path_info} =~ s/\.(\w+)$//xms ) |
{ |
{ |
$format = $1; |
$format_of{$ident} = $1; |
} |
} |
|
|
if ( ref $self eq __PACKAGE__ && $format ) { |
$suffix_of{$ident} = $options->{suffix} || '.txt'; |
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{ |
$file_regex_of{$ident} = $options->{file_regex} || qr{ |
.* |
.* |
todo |
todo |
|
|
$ |
$ |
}ixms; |
}ixms; |
|
|
if ( !$basedir_of{$ident} ) { |
|
return $self->fail('Required option [basedir]'); |
|
} |
|
|
|
$options->{path_info} ||= q{}; |
$options->{path_info} ||= q{}; |
$options->{path_info} =~ s{^/}{}xms; |
$options->{path_info} =~ s{^/}{}xms; |
( $user_of{$ident}, $list_of{$ident}, |
( $list_of{$ident}, $action_of{$ident}, @{ $args_of{$ident} }, ) |
$action_of{$ident}, @{ $args_of{$ident} }, |
= split '/', $options->{path_info}; |
) = split '/', $options->{path_info}; |
|
|
|
if ( $list_of{$ident} ) { |
if ( $list_of{$ident} ) { |
$action_of{$ident} ||= 'list'; |
$action_of{$ident} ||= 'list'; |
} |
} |
elsif ( $user_of{$ident} ) { |
else { |
$action_of{$ident} = 'files'; |
$action_of{$ident} = 'files'; |
} |
} |
|
|
my @todo_dir = $basedir_of{$ident}; |
eval { |
|
$todo_of{$ident} = Text::Todo->new( |
my $todo_dir; |
{ todo_dir => $options->{todo_dir}, |
if ( $user_of{$ident} ) { |
todo_file => $options->{todo_file}, |
push @todo_dir, $user_of{$ident}; |
} |
if ( $subdir_of{$ident} ) { |
); |
push @todo_dir, $subdir_of{$ident}; |
}; |
} |
if ($@) { |
|
$self->fail( 'Unable to create Text::Todo object' . $@ ); |
$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') |
$todo_of{$ident}->load('todo_file') |
or $self->fail('Unable to create Text::Todo object'); |
or $self->fail('Unable to load todo_file in Text::Todo object'); |
|
|
return $self; |
return $self; |
} |
} |
|
|
sub RegisterFormatHandler { |
sub RegisterActionHandler { |
my ( $handler, @types ) = @_; |
my ( $handler, @types ) = @_; |
|
|
foreach my $type (@types) { |
foreach my $type (@types) { |
$format_handlers{$type} = $handler; |
$action_handlers{$handler}{ $type->[0] } = $type->[1]; |
} |
} |
|
|
return 1; |
return 1; |
} |
} |
|
|
sub RegisterActionHandler { |
sub content_type {return} |
my ( $handler, @types ) = @_; |
|
|
|
foreach my $type (@types) { |
sub _handle_representation { |
$action_handlers{$handler}{ $type->[0] } = $type->[1]; |
my ( $self, $type, @args ) = @_; |
|
|
|
my $method = join q{_}, $type, $self->_action; |
|
|
|
foreach my $class ( $self->representations ) { |
|
if ( $class->can_format( $self->_format ) |
|
&& $class->can( $method ) ) |
|
{ |
|
return $class->$method($self->_format, @args); |
|
} |
} |
} |
|
|
return 1; |
return $self->fail( |
|
'Unable to ' . $type . ' [' . $self->_action . ']' ); |
} |
} |
|
|
sub content_type {return} |
|
|
|
sub Dump { |
sub Dump { |
my ($self) = @_; |
my ( $self, @args ) = @_; |
return $self->fail( 'Unable to Dump [' . $self->_action . ']' ); |
return $self->_handle_representation( 'dump', @args ); |
} |
} |
|
|
sub Load { |
|
my ($self) = @_; |
|
return $self->fail( 'Unable to Load [' . $self->_action . ']' ); |
|
} |
|
|
|
sub _handle_action { |
sub _handle_action { |
my ( $self, $method, $params ) = @_; |
my ( $self, $method, $params ) = @_; |
|
|
|
|
} |
} |
|
|
sub _todo { my ($self) = @_; return $todo_of{ ident $self }; } |
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 _suffix { my ($self) = @_; return $suffix_of{ ident $self}; } |
sub _file_regex { my ($self) = @_; return $file_regex_of{ ident $self}; } |
sub _file_regex { my ($self) = @_; return $file_regex_of{ ident $self}; } |
sub _user { my ($self) = @_; return $user_of{ ident $self}; } |
sub _user { my ($self) = @_; return $user_of{ ident $self}; } |
sub _list { my ($self) = @_; return $list_of{ ident $self}; } |
sub _list { my ($self) = @_; return $list_of{ ident $self}; } |
sub _action { my ($self) = @_; return $action_of{ ident $self}; } |
sub _action { my ($self) = @_; return $action_of{ ident $self}; } |
|
sub _format { my ($self) = @_; return $format_of{ ident $self}; } |
sub _args { my ($self) = @_; return $args_of{ ident $self}; } |
sub _args { my ($self) = @_; return $args_of{ ident $self}; } |
|
|
sub DESTROY { |
sub DESTROY { |