=================================================================== RCS file: /cvs/todotxt/Text-Todo-REST-API/lib/Text/Todo/REST/API.pm,v retrieving revision 1.7 retrieving revision 1.11 diff -u -r1.7 -r1.11 --- todotxt/Text-Todo-REST-API/lib/Text/Todo/REST/API.pm 2010/01/18 13:47:53 1.7 +++ todotxt/Text-Todo-REST-API/lib/Text/Todo/REST/API.pm 2010/01/24 04:38:21 1.11 @@ -1,31 +1,19 @@ package Text::Todo::REST::API; -# $AFresh1: API.pm,v 1.6 2010/01/18 03:51:40 andrew Exp $ +# $AFresh1: API.pm,v 1.10 2010/01/24 04:17:39 andrew Exp $ use warnings; use strict; use Carp; -use Data::Dumper; use Text::Todo; +use Text::Todo::REST::API::Response; use Class::Std::Utils; -use Module::Pluggable - require => 1, - search_path => __PACKAGE__ . '::Representations', - sub_name => 'representations'; use Digest::MD5 qw/ md5_hex /; use version; our $VERSION = qv('0.0.1'); -&RegisterActionHandler( - 'GET', - [ list => 'get_list' ], - [ entry => 'get_entry' ], - [ tags => 'get_tags' ], - [ files => 'get_files' ], -); - { my @attr_refs = \( my %todo_of, @@ -33,10 +21,7 @@ my %suffix_of, my %file_regex_of, - my %user_of, - my %list_of, - my %action_of, - my %args_of, + my %format_of, my %action_handlers, ); @@ -44,34 +29,15 @@ sub new { my ( $class, $options ) = @_; - my $format = $options->{default_format}; - if ( $options->{format} ) { - $format = $options->{format}; - } - elsif ($options->{path_info} - && $options->{path_info} =~ s/\.(\w+)$//xms ) - { - $format = $1; - } - my $self = bless anon_scalar(), $class; my $ident = ident($self); - if ( ref $self eq __PACKAGE__ && $format ) { - my $found_handler = 0; - REP: foreach my $rep ( $self->representations ) { - if ( $rep->_handles($format) ) { - $self = $rep->new($options); - $found_handler = 1; - last REP; - } - } - if ( !$found_handler ) { - croak("Unable to find handler for [$format]\n"); - } + $format_of{$ident} = $options->{default_format}; + if ( $options->{format} ) { + $format_of{$ident} = $options->{format}; } - $suffix_of{$ident} = $options->{suffix} || '.txt'; + $suffix_of{$ident} = $options->{suffix} || '.txt'; $file_regex_of{$ident} = $options->{file_regex} || qr{ .* @@ -81,65 +47,142 @@ $ }ixms; - $options->{path_info} ||= q{}; - $options->{path_info} =~ s{^/}{}xms; - ( $list_of{$ident}, $action_of{$ident}, @{ $args_of{$ident} }, - ) = split '/', $options->{path_info}; + 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' . $@ ); + } - if ( $list_of{$ident} ) { - $action_of{$ident} ||= 'list'; + return $self; + } + + sub _parse_options { + my ( $self, $method, @args ) = @_; + + my %options = ( + method => lc $method, + list => '', + action => 'files', + args => [], + ); + + 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}; + } + } } - else { - $action_of{$ident} = 'files'; + + 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}; + } + } } - eval { $todo_of{$ident} = Text::Todo->new( - { todo_dir => $options->{todo_dir}, - todo_file => $options->{todo_file}, + if ( $options{action} eq 'entry' && @{ $options{args} } ) { + $options{entry} = shift @{ $options{args} }; + if ( @{ $options{args} } ) { + $options{action} = lc shift @{ $options{args} }; } - ) }; - if ($@) { - $self->fail('Unable to create Text::Todo object' . $@); } - $todo_of{$ident}->load('todo_file') - or $self->fail('Unable to load todo_file in Text::Todo object'); + push @{ $options{args} }, @args; - return $self; - } + $options{list} + = defined $options{list} ? $options{list} : 'todo_file'; - 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 content_type {return} + sub _handle_action { + my ( $self, @args ) = @_; - sub Dump { - my ($self) = @_; - return $self->fail( 'Unable to Dump [' . $self->_action . ']' ); - } + my ( $method, %options ) = $self->_parse_options(@args); - sub Load { - my ($self) = @_; - return $self->fail( 'Unable to Load [' . $self->_action . ']' ); + my $todo = $self->_todo; + $todo->load( $options{list} ); + + foreach my $class ($self) { + 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 _handle_action { - my ( $self, $method, $params ) = @_; + sub _split_path { + my ( $self, $path ) = @_; - if ( exists $action_handlers{$method}{ $self->_action } ) { - my $a = $action_handlers{$method}{ $self->_action }; - return $self->$a( $self->_args, $params ); + my %options = ( + list => undef, + action => undef, + args => [], + ); + + $path = defined $path ? $path : q{}; + $path =~ s{^/}{}xms; + + if ( $path =~ s/\.(\w+)$//xms ) { + $options{format} = $1; } - return $self->fail( - 'Unable to handle ' . $method . ' [' . $self->_action . ']' ); + ( $options{list}, $options{action}, @{ $options{args} } ) = split '/', + $path; + + if ( $options{list} ) { + $options{action} ||= 'list'; + + my $suffix = $self->_suffix; + + if ( ( lc $options{list} ) eq 'files' ) { + $options{action} = lc $options{list}; + $options{list} = q{}; + } + elsif ( $self->_todo->file( $options{list} ) ) { + $options{list} = $self->_todo->file( $options{list} ); + } + } + + if ( @{ $options{args} } && ( lc $options{args}[0] ) eq 'entry' ) { + $options{action} = lc shift @{ $options{args} }; + } + + return %options; } sub GET { @@ -148,7 +191,7 @@ } sub get_entry { - my ( $self, $key ) = @_; + my ( $self, $todo, $key ) = @_; if ( !$key ) { return $self->fail("get_entry requires arguments"); @@ -160,14 +203,22 @@ } return @entries; } + elsif ( ref $key eq 'HASH' ) { + if ( exists $key->{entry} ) { + $key = $key->{entry}; + } + else { + return $self->fail('get_entry requires key [entry]'); + } + } - my @list = $self->get_list; + my $list = $self->get_list($todo); my $entry; if ( $key =~ /^[[:xdigit:]]{32}$/xms ) { my $search = lc $key; - ENTRY: foreach my $e (@list) { + ENTRY: foreach my $e ( @{$list} ) { if ( $search eq $e->{md5} ) { $entry = $e; last ENTRY; @@ -175,7 +226,7 @@ } } elsif ( $key =~ /^\d+$/xms ) { - $entry = $list[ $key - 1 ]; + $entry = $list->[ $key - 1 ]; } if ( !$entry ) { @@ -186,20 +237,21 @@ } sub get_list { - my ($self) = @_; + my ( $self, $todo ) = @_; my $line = 1; - return map ( { + my @list = map ( { line => $line++, md5 => md5_hex( $_->text ), text => $_->text, }, - $self->_todo->list ); + $todo->list ); + return \@list; } sub get_files { - my ($self) = @_; - my $dir = $self->_todo->file('todo_dir'); + my ( $self, $todo ) = @_; + my $dir = $todo->file('todo_dir'); if ( !$dir ) { return $self->fail('Unable to find todo_dir'); @@ -211,14 +263,12 @@ my @files = grep {m/$file_regex/xms} readdir $dh; closedir $dh; - return @files; + return \@files; } sub get_tags { - my ( $self, $tag ) = @_; - my $ident = ident($self); - - return $todo_of{$ident}->listtag($tag); + my ( $self, $todo, $tag ) = @_; + return [ $todo->listtag($tag) ]; } sub POST { @@ -244,10 +294,7 @@ 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 _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) = @_;