[BACK]Return to API.pm CVS log [TXT][DIR] Up to [local] / todotxt / Text-Todo-REST-API / lib / Text / Todo / REST

Diff for /todotxt/Text-Todo-REST-API/lib/Text/Todo/REST/API.pm between version 1.1 and 1.13

version 1.1, 2010/01/16 16:01:07 version 1.13, 2010/01/26 04:30:13
Line 1 
Line 1 
 package Text::Todo::REST::API;  package Text::Todo::REST::API;
   
 # $RedRiver$  # $AFresh1: API.pm,v 1.12 2010/01/26 03:51:49 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;
   
           $options{list}
               = defined $options{list} ? $options{list} : 'todo_file';
   
           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 $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 {
           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
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.13
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>