package CGI::Application::Plugin::REST;
use warnings;
use strict;
use Carp;
use base 'Exporter';

our @EXPORT = qw/ REST_error REST_route REST_media_type /;
# remember to keep version number in sync with the POD below
our $VERSION = '0.8';

# plug in to CGI::Application and setup our callbacks.
sub import{
    my $caller = scalar(caller);

    $caller->add_callback('init',   
        'CGI::Application::Plugin::REST::REST_init');
    $caller->add_callback('prerun', 
        'CGI::Application::Plugin::REST::REST_dispatch');
    goto &Exporter::import;
}


#  REST_init
#  Set up our variables
#
sub REST_init {
    my ($self) = @_;

    $self->{REST_dispatch_table} = {};    
    $self->{REST_my_media_type} = undef;
}

# REST_dispatch
# A cgiapp_prerun hook that maps requests to the right functions
#
sub REST_dispatch {
    my ($self, $run_mode) = @_;
    my $q = $self->query;

    # Is this a REST run_mode? Yes then wrap the whole thing up in an eval
    if (exists($self->{REST_dispatch_table}->{$run_mode})) { eval {
        my $rest_run_mode = $self->{REST_dispatch_table}->{$run_mode};
        # If so, create a dummy real run_mode for it (or supress an existing 
        # one.)  This is becuse we run fro cgiapp_prerun() which wants to
        # return to a real run_mode. 
        $self->run_modes($run_mode => sub {});

        # Is the request method (GET, POST) valid for our REST run_mode?
        my $request_method = $q->request_method;
        if (defined($request_method) 
            && exists($rest_run_mode->{$request_method})) {
            my $dispatch = $rest_run_mode->{$request_method};
            
            # Get the preferred MIME media type.  Other HTTP verbs than the 
            # ones below (and DELETE) are not covered.  Should they be?
            my $media_type = undef;
            if ($request_method eq 'GET' || $request_method eq 'HEAD') {
                my $quality = 0.000;
                foreach my $type (keys %$dispatch) {
                    my $temp_quality = $q->Accept($type);
                    if ($temp_quality > $quality) {
                        $quality = $temp_quality;
                        $media_type = $type;
                    }
                }         
            }
            elsif ($request_method eq 'POST' || $request_method eq 'PUT') {
                $media_type = $q->content_type;
            }
            
            $self->{REST_my_media_type} = $media_type;
            
            # Is the MIME media type valid for our REST run_mode?  DELETE 
            # doesn't care about the media type so skip check in that case.
            if ((defined($media_type) && exists($dispatch->{$media_type})) ||
                $request_method eq 'DELETE') {

                # Get the function to call. The rest of the array is the 
                # arguments we want to give to that function...
                my @args = @{$dispatch->{$media_type}};
                my $function = shift @args;
                # ...which we get from the CGI parameters.
                my $params;
                foreach my $arg (@args) {
                    $params->{$arg} = $q->param($arg) || '';
                }  

                # Try and run the method passing it a hashref of the arguments.
                if (my $sub = $self->can($function)) {
                    no strict 'refs';
                    $self->run_modes(
                        $run_mode => sub { return $sub->($self, $params) } );

                }
                # We couldn't find or run the specified method.
                else {
                    $self->REST_error('403', "Function doesn't exist");
                }     
            }
            # We didn't get an acceptable MIME media type.
            else {
                $self->REST_error('415', 'Unsupported media type');
            }          
        }
        # We didn't get an acceptable request method.
        else {
            $self->REST_error('405', 'Method not allowed');
        }
    }};
    # trap any errors and pass them on to the error mode.
    if ($@) {
        REST_error('500', 'Application error');
        my $error = $@;
        $self->call_hook('error', $error);
        if (my $em = $self->error_mode) {
            $self->$em( $error );
        } else {
            croak("Error executing REST run mode '$run_mode': $error");
        }
    }
}

# REST_error
# prepare an error message
#
sub REST_error {
    my ($self, $code, $msg) = @_;
    

    $self->header_add(-status => "$code $msg");

    die "$code $msg\n";
}

# REST_media_type
# Return the prefered MIME media type
#
sub REST_media_type {
    my ($self) = @_;
    return $self->{REST_my_media_type};
}

# REST_route
# Add an entry to the dispatch table
#
sub REST_route {
    my $self = shift;
    my %params = (
        RUN_MODE       => $self->start_mode,
        REQUEST_METHOD => 'GET',
        MEDIA_TYPES    => ['*/*'],
        FUNCTION       => [$self->start_mode()],
        @_,
    );

    foreach my $type (@{$params{MEDIA_TYPES}}) {
        $self->{REST_dispatch_table}->{$params{RUN_MODE}}->
            {$params{REQUEST_METHOD}}->{$type} = $params{FUNCTION};
    }
}

1;