Jifty::Plugin::REST::Dispatcher - Dispatcher for REST plugin

    format: JSON, JS, YAML, XML, Perl, or HTML
    extension: json, js, yml, xml, pl, or html
    content_type: text/x-yaml; charset=UTF-8, etc.
    freezer: \&Jifty::YAML::Dump, etc.

use warnings;
use strict;

package Jifty::Plugin::REST::Dispatcher;




use CGI qw( start_html end_html ol ul li a dl dt dd );
use Carp;
use Jifty::Dispatcher -base;
use Jifty::YAML ();
use Jifty::JSON ();
use Data::Dumper ();
use XML::Simple;

before qr{^ (/=/ .*) \. (js|json|yml|yaml|perl|pl|xml|html) $}x => run {
    Jifty->web->request->env->{HTTP_ACCEPT} = $2;
    dispatch $1;
};

before POST qr{^ (/=/ .*) ! (DELETE|PUT|GET|POST|OPTIONS|HEAD|TRACE|CONNECT) $}x => run {
    Jifty->web->request->method($2);
    Jifty->web->request->env->{REST_REWROTE_METHOD} = 1;
    dispatch $1;
};

on GET    '/=/model/*/*/*/*'    => \&show_item_field;
on GET    '/=/model/*/*/*'      => \&show_item;
on GET    '/=/model/*/*'        => \&list_model_items;
on GET    '/=/model/*'          => \&list_model_columns;
on GET    '/=/model'            => \&list_models;

on POST   '/=/model/*'          => \&create_item;
on PUT    '/=/model/*/*/*'      => \&replace_item;
on DELETE '/=/model/*/*/*'      => \&delete_item;

on GET    '/=/search/*/**'      => \&search_items;

on GET    '/=/action/*'         => \&list_action_params;
on GET    '/=/action'           => \&list_actions;
on POST   '/=/action/*'         => \&run_action;

on GET    '/='                  => \&show_help;
on GET    '/=/help'             => \&show_help;
on GET    '/=/help/*'           => \&show_help_specific;

on GET    '/=/version'          => \&show_version;

sub show_help {
    Jifty->web->response->content_type('text/plain; charset=utf-8');

    Jifty->web->response->body(qq{
Accessing resources:

on GET    /=/model                                   list models
on GET    /=/model/<model>                           list model columns
on GET    /=/model/<model>/<column>                  list model items
on GET    /=/model/<model>/<column>/<key>            show item
on GET    /=/model/<model>/<column>/<key>/<field>    show item field

on POST   /=/model/<model>                           create item
on PUT    /=/model/<model>/<column>/<key>            update item
on DELETE /=/model/<model>/<column>/<key>            delete item

on GET    /=/search/<model>/<c1>/<v1>/<c2>/<v2>/...  search items
on GET    /=/search/<model>/<c1>/<v1>/.../<field>    show matching items' field

on GET    /=/action                                  list actions
on GET    /=/action/<action>                         list action params
on POST   /=/action/<action>                         run action

on GET    /=/help                                    this help page
on GET    /=/help/search                             help for /=/search

on GET    /=/version                                 version information

Resources are available in a variety of formats:

        JSON, JS, YAML, XML, Perl, and HTML

and may be requested in such formats by sending an appropriate HTTP Accept: header
or appending one of the extensions to any resource:

        .json, .js, .yaml, .xml, .pl

HTML is output only if the Accept: header or an extension does not request a
specific format.
});
    last_rule;
}

sub show_help_specific {
    my $topic = $1;
    my $method = "show_help_specific_$topic";
    __PACKAGE__->can($method) or abort(404);

    Jifty->web->response->content_type('text/plain; charset=utf-8');
    Jifty->web->response->body(__PACKAGE__->$method);
    last_rule;
}

sub show_help_specific_search {
    return << 'SEARCH';
This interface supports searching arbitrary columns and values. For example, if
you're looking at a Task with due date 1999-12-25 and complete, you can use:

    /=/search/Task/due/1999-12-25/complete/1

If you're looking for just the summaries of these tasks, you can use:

    /=/search/Task/due/1999-12-25/complete/1/summary

Any column in the model is eligible for searching. If you specify multiple
values for the same column, they'll be ORed together. For example, if you're
looking for Tasks with due dates 1999-12-25 OR 2000-12-25, you can use:

    /=/search/Task/due/1999-12-25/due/2000-12-25/


There are also some pseudo-columns. They are prefixed by __ to avoid collisions
with actual column names.

Not:

    .../__not/<column>/<value>

This lets you search for records whose value for the column is NOT equal
to the specified value.

Ordering:

    .../__order_by/<column>
    .../__order_by_asc/<column>
    .../__order_by_desc/<column>

These let you change the output order of the results. Multiple '__order_by's
will be respected.

Pagination:

    .../__page/<number>
    .../__per_page/<number>

These let you control how many results you'll get.
SEARCH
}

sub show_version {
    outs(['version'], {
        Jifty => $Jifty::VERSION,
        REST  => $Jifty::Plugin::REST::VERSION,
    });
}

sub list {
    my $prefix = shift;
    outs($prefix, \@_)
}

sub output_format {
    my $prefix = shift;
    my $accept = (Jifty->web->request->env->{HTTP_ACCEPT} || '');

    my (@prefix, $url);
    if ($prefix) {
        @prefix = map {s/::/./g; $_} @$prefix;
        $url    = Jifty->web->url(path => join '/', '=',@prefix);
    }

    if ($accept =~ /ya?ml/i) {
        return {
            format       => 'YAML',
            extension    => 'yml',
            content_type => 'text/x-yaml; charset=UTF-8',
            freezer      => \&Jifty::YAML::Dump,
        };
    }
    elsif ($accept =~ /json/i) {
        return {
            format       => 'JSON',
            extension    => 'json',
            content_type => 'application/json; charset=UTF-8',
            freezer      => \&Jifty::JSON::encode_json,
        };
    }
    elsif ($accept =~ /j(?:ava)?s|ecmascript/i) {
        return {
            format       => 'JS',
            extension    => 'js',
            content_type => 'application/javascript; charset=UTF-8',
            freezer      => sub { 'var $_ = ' . Jifty::JSON::encode_json( @_ ) },
        };
    }
    elsif ($accept =~ qr{^(?:application/x-)?(?:perl|pl)$}i) {
        return {
            format       => 'Perl',
            extension    => 'pl',
            content_type => 'application/x-perl; charset=UTF-8',
            freezer      => \&Data::Dumper::Dumper,
        };
    }
    elsif ($accept =~  qr|^(text/)?xml$|i) {
        return {
            format       => 'XML',
            extension    => 'xml',
            content_type => 'text/xml; charset=UTF-8',
            freezer      => \&render_as_xml,
        };
    }
    # if we ever have a non-html fallback case, we should be checking for an
    # $accept of HTML here
    else {
        my $freezer;

        # Special case showing particular actions to show an HTML form
        if (    defined $prefix
            and $prefix->[0] eq 'action'
            and scalar @$prefix == 2 )
        {
            $freezer = sub { show_action_form($prefix->[1]) };
        }
        else {
            $freezer = sub { render_as_html($prefix, $url, @_) };
        }

        return {
            format       => 'HTML',
            extension    => 'html',
            content_type => 'text/html; charset=UTF-8',
            freezer      => $freezer,
        };
    }
}

sub outs {
    my $prefix = shift;
    my $format = output_format($prefix);
    warn "==> using $format->{format}" if $main::DEBUG;

    Jifty->web->response->content_type($format->{content_type});
    Jifty->handler->buffer->out_method->($format->{freezer}->(@_));
    last_rule;
}

our $xml_config = { SuppressEmpty   => undef,
                    NoAttr          => 1,
                    RootName        => 'data' };

sub render_as_xml {
    my $content = shift;

    if (ref($content) eq 'ARRAY') {
        return XMLout({value => $content}, %$xml_config);
    }
    elsif (ref($content) eq 'HASH') {
        return XMLout($content, %$xml_config);
    } else {
        return XMLout({value => $content}, %$xml_config)
    }
}

sub render_as_html {
    my $prefix = shift;
    my $url = shift;
    my $content = shift;

    my $title = _("%1 - REST API", Jifty->config->framework('ApplicationName'));

    if (ref($content) eq 'ARRAY') {
        return start_html(-encoding => 'UTF-8', -declare_xml => 1, -title => $title),
              ul(map {
                ref($_) eq 'HASH' ? render_as_html($url, $prefix,$_) :
                    li(
                    ref($_) eq 'ARRAY' ? render_as_html($url, $prefix,$_) :
                      
                      ($prefix ?
                     a({-href => "$url/".Jifty::Web->escape_uri($_)}, Jifty::Web->escape($_))
                     : Jifty::Web->escape($_) ))
              } @{$content}),
              end_html();
    }
    elsif (ref($content) eq 'HASH') {
        return start_html(-encoding => 'UTF-8', -declare_xml => 1, -title => $title),
              dl(map {
                  dt($prefix ?
                     a({-href => "$url/".Jifty::Web->escape_uri($_)}, Jifty::Web->escape($_))
                     : Jifty::Web->escape($_)),
                  dd(html_dump($content->{$_})),
              } sort keys %{$content}),
              end_html();
    }
    else {
        return start_html(-encoding => 'UTF-8', -declare_xml => 1, -title => $title),
              Jifty::Web->escape($content),
              end_html();
    }
}

sub html_dump {
    my $content = shift;
    if (ref($content) eq 'ARRAY') {
        if (@$content) {
            return ul(map {
                li(html_dump($_))
            } @{$content});
        }
        else {
            return;
        }
    }
    elsif (ref($content) eq 'HASH') {
        if (keys %$content) {
            return dl(map {
                dt(Jifty::Web->escape($_)),
                dd(html_dump($content->{$_})),
            } sort keys %{$content});
        }
        else {
            return;
        }
    
    } elsif (ref($content) && $content->isa('Jifty::Collection')) {
        if ($content->count) {
            return  ol( map { li( html_dump_record($_))  } @{$content->items_array_ref});
        }
        else {
            return;
        }
        
    } elsif (ref($content) && $content->isa('Jifty::Record')) {
          return   html_dump_record($content);
    }
    else {
        Jifty::Web->escape($content);
    }
}

sub html_dump_record {
    my $item = shift;
     my %hash = $item->as_hash;

     return  dl( map {dt($_), dd($hash{$_}) } keys %hash )
}

sub action {
    _resolve(
        name          => $_[0],
        base          => 'Jifty::Action',
        possibilities => [Jifty->api->visible_actions],
# We do not do this check because we want users to see actions on GET requests,
# like when they're exploring the REST API in their browser.
#        is_allowed    => sub { Jifty->api->is_allowed(shift) },
    );
}

sub model {
    _resolve(
        name          => $_[0],
        base          => 'Jifty::Record',
        possibilities => [Jifty->class_loader->models],
        is_allowed    => sub { not shift->is_private },
    );
}

sub _resolve {
    my %args = @_;

    # we display actions as "AppName.Action.Foo", so we want to convert those
    # heathen names to be Perl-style
    $args{name} =~ s/\./::/g;

    my $re = qr/(?:^|::)\Q$args{name}\E$/i;

    my $hit;
    foreach my $class (@{ $args{possibilities} }) {
        if ($class =~ $re && $class->isa($args{base})) {
            $hit = $class;
            last;
        }
    }

    abort(404) if !defined($hit);

    abort(403) if $args{is_allowed} && !$args{is_allowed}->($hit);

    return $hit;
}

sub list_models {
    list(['model'], map { s/::/./g; $_ } grep {not $_->is_private} Jifty->class_loader->models);
}

our @column_attrs = 
qw( name
    documentation
    type
    default
    readable writable
    display_length
    max_length
    mandatory
    distinct
    sort_order
    refers_to
    by
    alias_for_column
    aliased_as
    label hints
    valid_values
);

sub valid_column {
    my ( $model, $column ) = @_;
    return scalar grep { $_->name eq $column and not $_->virtual and not $_->private } $model->new->columns;
}

sub list_model_columns {
    my ($model) = model($1);

    my %cols;
    for my $col ( $model->new->columns ) {
        next if $col->private or $col->virtual;
        $cols{ $col->name } = { };
        for ( @column_attrs ) {
            my $val = $col->$_();
            $cols{ $col->name }->{ $_ } = Scalar::Defer::force($val)
                if defined $val and length $val;
        }
        if (my $serialized = $model->column_serialized_as($col)) {
            $cols{ $col->name }->{serialized_as} = $serialized;
        }
        $cols{ $col->name }{writable} = 0 if exists $cols{$col->name}{writable} and $col->protected;
    }

    outs( [ 'model', $model ], \%cols );
}

sub list_model_items {
    # Normalize model name - fun!
    my ( $model, $column ) = ( model($1), $2 );
    my $col = $model->new->collection_class->new;
    $col->unlimit;

    # Check that the field is actually a column
    abort(404) unless valid_column($model, $column);

    # If we don't load the PK, we won't get data
    $col->columns("id", $column);
    $col->order_by( column => $column );

    list( [ 'model', $model, $column ],
        map { Jifty::Util->stringify($_->$column()) }
            @{ $col->items_array_ref || [] } );
}

sub show_item_field {
    my ( $model, $column, $key, $field ) = ( model($1), $2, $3, $4 );
    my $rec = $model->new;
    $rec->load_by_cols( $column => $key );
    $rec->id          or abort(404);
    $rec->can($field) or abort(404);

    # Check that the field is actually a column (and not some other method)
    abort(404) unless valid_column($model, $field);

    outs( [ 'model', $model, $column, $key, $field ],
          Jifty::Util->stringify($rec->$field()) );
}

sub show_item {
    my ($model, $column, $key) = (model($1), $2, $3);
    my $rec = $model->new;

    # Check that the field is actually a column
    abort(404) unless valid_column($model, $column);

    $rec->load_by_cols( $column => $key );
    $rec->id or abort(404);
    $rec->current_user_can('read') or abort(403);

    outs( ['model', $model, $column, $key], $rec->jifty_serialize_format );
}

sub search_items {
    my ($model, $fragment) = (model($1), $2);
    my @pieces = grep {length} split '/', $fragment;
    my $ret = ['search', $model, @pieces];

    # limit to the key => value pairs they gave us
    my $collection = eval { $model->collection_class->new }
        or abort(404);
    $collection->unlimit;

    my $record = $model->new
        or abort(404);

    my $added_order = 0;
    my $per_page;
    my $current_page = 1;

    my %special = (
        __per_page => sub {
            my $N = shift;

            # must be a number
            $N =~ /^\d+$/
                or abort(404);

            $per_page = $N;
        },
        __page => sub {
            my $N = shift;

            # must be a number
            $N =~ /^\d+$/
                or abort(404);

            $current_page = $N;
        },
        __order_by => sub {
            my $col = shift;
            my $order = shift || 'ASC';

            # this will wipe out the default ordering on your model the first
            # time around
            if ($added_order) {
                $collection->add_order_by(
                    column => $col,
                    order  => $order,
                );
            }
            else {
                $added_order = 1;
                $collection->order_by(
                    column => $col,
                    order  => $order,
                );
            }
        },
        __not => sub {
            my $column = shift;
            my $value  = shift @pieces;

            my $canonicalizer = "canonicalize_$column";
            $value = $record->$canonicalizer($value)
                if $record->can($canonicalizer);

            $collection->limit(
                column   => $column,
                value    => $value,
                operator => '!=',
            );
        },
    );

    # this was called __limit before it was generalized
    $special{__limit} = $special{__per_page};

    # /__order_by/name/desc is impossible to distinguish between ordering by
    # 'name', descending, and ordering by 'name', with output column 'desc'.
    # so we use __order_by_desc instead (and __order_by_asc is provided for
    # consistency)
    $special{__order_by_asc}  = $special{__order_by};
    $special{__order_by_desc} = sub { $special{__order_by}->($_[0], 'DESC') };

    while (@pieces > 1) {
        my $column = shift @pieces;
        my $value  = shift @pieces;

        if (exists $special{$column}) {
            $special{$column}->($value);
        }
        else {
            my $canonicalizer = "canonicalize_$column";
            $value = $record->$canonicalizer($value)
                if $record->can($canonicalizer);

            $collection->limit(column => $column, value => $value);
        }
    }

    # if they provided an odd number of pieces, the last is the output column
    my $field;
    if (@pieces) {
        $field = shift @pieces;
    }

    if (defined($per_page) || defined($current_page)) {
        $per_page = 15 unless defined $per_page;
        $current_page = 1 unless defined $current_page;
        $collection->set_page_info(
            current_page => $current_page,
            per_page     => $per_page,
        );
    }

    $collection->count                       or return outs($ret, []);
    $collection->pager->entries_on_this_page or return outs($ret, []);

    # output
    if (defined $field) {
        my $item = $collection->first
            or return outs($ret, []);

        # Check that the field is actually a column
        abort(404) unless valid_column($model, $field);

        my @values;

        # collect the values for $field
        do {
            push @values, $item->$field;
        } while $item = $collection->next;

        outs($ret, \@values);
    }
    else {
        outs($ret, $collection->jifty_serialize_format);
    }
}

sub create_item { _dispatch_to_action('Create') }

sub replace_item { _dispatch_to_action('Update') }

sub delete_item { _dispatch_to_action('Delete') }

sub _dispatch_to_action {
    my $prefix = shift;
    my ($model, $class, $column, $key) = (model($1), $1, $2, $3);
    my $rec = $model->new;
    $rec->load_by_cols( $column => $key )
        if defined $column and defined $key;

    if ( not $rec->id ) {
        abort(404) if $prefix eq 'Delete' || $prefix eq 'Update';
    }

    $class =~ s/^[\w\.]+\.//;

    # 403 unless the action exists
    my $action = action($prefix . $class);

    if ( defined $column and defined $key ) {
        Jifty->web->request->argument( $column => $key );
        Jifty->web->request->argument( 'id' => $rec->id )
            if defined $rec->id;
    }
    
    Jifty->web->request->method('POST');
    dispatch "/=/action/$action";
}

sub list_actions {
    list(['action'], map {s/::/./g; $_} Jifty->api->visible_actions);
}

our @param_attrs = qw(
    name
    documentation
    type
    default_value
    label
    hints
    mandatory
    ajax_validates
    length
    valid_values
);

sub list_action_params {
    my ($class) = action($1);
    my $action = $class->new or abort(404);

    my $arguments = $action->arguments;
    my %args;
    for my $arg ( keys %$arguments ) {
        $args{ $arg } = { };
        for ( @param_attrs ) {
            # Valid values is special because sometimes it has a collection
            # object that needs to be abstracted away
            my $val = $_ eq 'valid_values'
                        ? $action->valid_values($arg)
                        : $arguments->{ $arg }{ $_ };
            $args{ $arg }->{ $_ } = Scalar::Defer::force($val)
                if defined $val and length $val;
        }
    }

    outs( ['action', $class], \%args );
}

sub show_action_form {
    my ($action) = action(shift);
    Jifty::Util->require($action) or abort(404);
    $action = $action->new or abort(404);
    # XXX - Encapsulation?  Someone please think of the encapsulation!
    no warnings 'redefine';
    local *Jifty::Action::form_field_name = sub { shift; $_[0] };
    local *Jifty::Action::register = sub { 1 };
    local *Jifty::Web::Form::Field::Unrendered::render = \&Jifty::Web::Form::Field::render;

    Jifty->web->response->{body} .= start_html(-encoding => 'UTF-8', -declare_xml => 1, -title => ref($action));
    Jifty->web->form->start;
    for my $name ($action->argument_names) {
        Jifty->web->response->{body} .= $action->form_field($name);
    }
    Jifty->web->form->submit( label => 'POST' );
    Jifty->web->form->end;
    Jifty->web->response->{body} .= end_html;
    last_rule;
}

sub run_action {
    my ($action_name) = action($1);
    Jifty::Util->require($action_name) or abort(404);
    
    my $args = Jifty->web->request->arguments;
    delete $args->{''};

    my $action = $action_name->new( arguments => $args ) or abort(404);

    Jifty->api->is_allowed( $action_name ) or abort(403);

    $action->validate;

    local $@;
    eval { $action->run };

    if ($@) {
        warn $@;
        abort(500);
    }

    my $rec = $action->{record};
    if ($action->result->success && $rec and $rec->isa('Jifty::Record') and $rec->id and ($rec->load($rec->id))[0]) {
        my @fragments = ('model', ref($rec), 'id', $rec->id);

        my $path = join '/', '=', map { Jifty::Web->escape_uri($_) } @fragments;

        my $extension = output_format(\@fragments)->{extension};
        $path .= '.' . $extension;

        my $url = Jifty->web->url(path => $path);

        Jifty->web->response->status( 302 );
        Jifty->web->response->header('Location' => $url);
    }

    outs(undef, $action->result->as_hash);

    last_rule;
}

1;