=================================================================== RCS file: /cvs/todotxt/Text-Todo-REST-API/lib/Text/Todo/REST/API.pm,v retrieving revision 1.2 retrieving revision 1.17 diff -u -r1.2 -r1.17 --- todotxt/Text-Todo-REST-API/lib/Text/Todo/REST/API.pm 2010/01/17 23:15:00 1.2 +++ todotxt/Text-Todo-REST-API/lib/Text/Todo/REST/API.pm 2010/01/31 03:10:39 1.17 @@ -1,61 +1,48 @@ package Text::Todo::REST::API; -# $AFresh1$ +# $AFresh1: API.pm,v 1.16 2010/01/26 06:03:11 andrew Exp $ use warnings; use strict; use Carp; -use Data::Dumper; use Text::Todo; +use Text::Todo::REST::API::Response; -use Class::Std; -use Digest::MD5 qw/ md5_hex /; -use File::Spec; +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'); -&RegisterActionHandler( - 'GET', - [ list => 'get_list' ], - [ entry => 'get_entry' ], - [ 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; + my @attr_refs = \( + my %todo_of, - sub BUILD { - my ( $self, $ident, $options ) = @_; + my %suffix_of, + my %file_regex_of, - my $format = $options->{default_format}; + my %format_of, + + my %action_handlers, + ); + + 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 = $options->{format}; + $format_of{$ident} = $options->{format}; } - elsif ($options->{path_info} - && $options->{path_info} =~ s/\.(\w+)$//xms ) - { - $format = $1; - } - if ( ref $self eq __PACKAGE__ && $format ) { - if ( $format_handlers{$format} ) { - bless $self, $format_handlers{$format}; - } - else { - croak("Unable to find handler for [$format]\n"); - } - } + $suffix_of{$ident} = $options->{suffix} || '.txt'; - $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 @@ -64,186 +51,179 @@ $ }ixms; - if ( !$basedir_of{$ident} ) { - return $self->fail('Required option [basedir]'); + 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' . $@ ); } - $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}; + return $self; + } - if ( $list_of{$ident} ) { - $action_of{$ident} ||= 'list'; - } - elsif ( $user_of{$ident} ) { - $action_of{$ident} = 'files'; - } + sub _parse_options { + my ( $self, $method, @args ) = @_; - my @todo_dir = $basedir_of{$ident}; + my %options = ( + method => lc $method, + list => '', + action => 'files', + args => [], - my $todo_dir; - if ( $user_of{$ident} ) { - push @todo_dir, $user_of{$ident}; - if ( $subdir_of{$ident} ) { - push @todo_dir, $subdir_of{$ident}; + suffix => $self->_suffix, + file_regex => $self->_file_regex, + format => $self->_format, + ); + + if (@args) { + if ( !ref $args[0] ) { + $options{path} = shift @args; } - $todo_dir = File::Spec->catdir(@todo_dir); + if ( ref $args[0] eq 'HASH' ) { + my $opts = shift @args; + foreach my $o ( keys %{$opts} ) { + $options{$o} = $opts->{$o}; + } + } } - my $todo_file; - if ( $list_of{$ident} ) { - $todo_file = $list_of{$ident} . $suffix_of{$ident}; - } + if ( exists $options{path} ) { + my %opts = $self->_split_path( $options{path} ); + delete $options{path}; - $todo_of{$ident} = Text::Todo->new( - { todo_dir => $todo_dir, - todo_file => $todo_file, + foreach my $o ( keys %opts ) { + if ( defined $opts{$o} ) { + $options{$o} = $opts{$o}; + } } - ) or $self->fail('Unable to create Text::Todo object'); + } - $todo_of{$ident}->load('todo_file') - or $self->fail('Unable to create Text::Todo object'); + if ( $options{action} eq 'entry' && @{ $options{args} } ) { + $options{action} .= q{_} . lc shift @{ $options{args} }; + } - return; - } + push @{ $options{args} }, @args; - sub RegisterFormatHandler { - my ( $handler, @types ) = @_; + my $list = $self->_todo->file( $options{list} ); - foreach my $type (@types) { - $format_handlers{$type} = $handler; + my $suffix = $self->_suffix || q{}; + if ( $list !~ / \Q$suffix\E $/ixms ) { + $list .= $suffix; } - return 1; - } + $options{list} = $list; - sub RegisterActionHandler { - my ( $handler, @types ) = @_; + if ( $options{format} ) { + $format_of{ ident $self } = $options{format}; + delete $options{format}; + } - foreach my $type (@types) { - $action_handlers{$handler}{ $type->[0] } = $type->[1]; + my @method; + foreach my $o qw( method action ) { + if ( $options{$o} ) { + push @method, $options{$o}; + } } + $method = join q{_}, @method; - return 1; + return $method, %options; } - sub Dump { - my ($self) = @_; - return $self->fail( 'Unable to Dump [' . $self->_action . ']' ); - } + sub _handle_action { + my ( $self, @args ) = @_; - sub Load { - my ($self) = @_; - return $self->fail( 'Unable to Load [' . $self->_action . ']' ); - } + my ( $method, %options ) = $self->_parse_options(@args); - sub GET { - my ( $self, $params ) = @_; + my $todo = $self->_todo; + $todo->load( $options{list} ); - if ( exists $action_handlers{GET}{ $self->_action } ) { - my $method = $action_handlers{GET}{ $self->_action }; - return $self->$method( $self->_args, $params ); + 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 GET [' . $self->_action . ']' ); + return $self->fail( 'Unable to handle [' . $method . ']' ); } - sub get_entry { - my ( $self, $key ) = @_; + sub _split_path { + my ( $self, $path ) = @_; - 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 %options = ( + action => 'files', + list => undef, + entry => undef, + args => [], + ); - my @list = $self->get_list; + $path = defined $path ? $path : q{}; + $path =~ s{^/}{}xms; - my $entry; - if ( $key =~ /^[[:xdigit:]]{32}$/xms ) { - my $search = lc $key; + if ( $path =~ s/\.(\w+)$//xms ) { + $options{format} = $1; + } - ENTRY: foreach my $e (@list) { - if ( $search eq $e->{md5} ) { - $entry = $e; - last ENTRY; - } - } + ( $options{list}, $options{entry}, @{ $options{args} } ) = split '/', + $path; + + if ( $options{list} ) { + $options{action} = 'list'; } - elsif ( $key =~ /^\d+$/xms ) { - $entry = $list[ $key - 1 ]; - } - if ( !$entry ) { - return $self->fail("Unable to find entry!"); + if ( $options{entry} ) { + $options{action} = 'entry'; } - return $entry; + return %options; } - sub get_list { - my ($self) = @_; + sub GET { + my ( $self, @args ) = @_; + return $self->_handle_action( 'GET', @args ); + } - my $line = 1; - return map ( { - line => $line++, - md5 => md5_hex( $_->text ), - text => $_->text, - }, - $self->_todo->list ); + sub POST { + my ( $self, @args ) = @_; + return $self->_handle_action( 'POST', @args ); } - 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 PUT { + my ( $self, @args ) = @_; + return $self->_handle_action( 'PUT', @args ); } - sub get_tags { - my ( $self, $tag ) = @_; - my $ident = ident($self); - - return $todo_of{$ident}->listtag($tag); + sub DELETE { + my ( $self, @args ) = @_; + return $self->_handle_action( 'DELETE', @args ); } - sub POST { croak "Unsupported [POST]" } - sub PUT { croak "Unsupported [PUT]" } - sub DELETE { croak "Unsupported [DELETE]" } - 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}; } + 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__