1use warnings;
2use strict;
3
4package Jifty::Plugin::REST::Dispatcher;
5
6
7
8
9use CGI qw( start_html end_html ol ul li a dl dt dd );
10use Carp;
11use Jifty::Dispatcher -base;
12use Jifty::YAML ();
13use Jifty::JSON ();
14use Data::Dumper ();
15use XML::Simple;
16use URI::Escape ();
17
18before qr{^ (/=/ .*) \. (js|json|yml|yaml|perl|pl|xml|html) $}x => run {
19    Jifty->web->request->env->{HTTP_ACCEPT} = $2;
20    dispatch $1;
21};
22
23before POST qr{^ (/=/ .*) ! (DELETE|PUT|GET|POST|OPTIONS|HEAD|TRACE|CONNECT) $}x => run {
24    Jifty->web->request->method($2);
25    Jifty->web->request->env->{REST_REWROTE_METHOD} = 1;
26    dispatch $1;
27};
28
29on GET    '/=/model/*/*/*/*'    => \&show_item_field;
30on GET    '/=/model/*/*/*'      => \&show_item;
31on GET    '/=/model/*/*'        => \&list_model_items;
32on GET    '/=/model/*'          => \&list_model_columns;
33on GET    '/=/model'            => \&list_models;
34
35on POST   '/=/model/*'          => \&create_item;
36on PUT    '/=/model/*/*/*'      => \&replace_item;
37on PUT    '/=/model/*/*/*/*'    => \&replace_item_field;
38on DELETE '/=/model/*/*/*'      => \&delete_item;
39
40on GET    '/=/search/*/**'      => \&search_items;
41
42on GET    '/=/action/*'         => \&list_action_params;
43on GET    '/=/action'           => \&list_actions;
44on POST   '/=/action/*'         => \&run_action;
45
46on GET    '/='                  => \&show_help;
47on GET    '/=/help'             => \&show_help;
48on GET    '/=/help/*'           => \&show_help_specific;
49
50on GET    '/=/version'          => \&show_version;
51
52=head1 NAME
53
54Jifty::Plugin::REST::Dispatcher - Dispatcher for REST plugin
55
56=head2 show_help
57
58Shows basic help about resources and formats available via this RESTful interface.
59
60=cut
61
62sub show_help {
63    Jifty->web->response->content_type('text/plain; charset=utf-8');
64
65    Jifty->web->response->body(qq{
66Accessing resources:
67
68on GET    /=/model                                   list models
69on GET    /=/model/<model>                           list model columns
70on GET    /=/model/<model>/<column>                  list model items
71on GET    /=/model/<model>/<column>/<key>            show item
72on GET    /=/model/<model>/<column>/<key>/<field>    show item field
73
74on POST   /=/model/<model>                           create item
75on PUT    /=/model/<model>/<column>/<key>            update item
76on DELETE /=/model/<model>/<column>/<key>            delete item
77
78on GET    /=/search/<model>/<c1>/<v1>/<c2>/<v2>/...  search items
79on GET    /=/search/<model>/<c1>/<v1>/.../<field>    show matching items' field
80
81on GET    /=/action                                  list actions
82on GET    /=/action/<action>                         list action params
83on POST   /=/action/<action>                         run action
84
85on GET    /=/help                                    this help page
86on GET    /=/help/search                             help for /=/search
87
88on GET    /=/version                                 version information
89
90Resources are available in a variety of formats:
91
92    JSON, JS, YAML, XML, Perl, and HTML
93
94and may be requested in such formats by sending an appropriate HTTP Accept: header
95or appending one of the extensions to any resource:
96
97    .json, .js, .yaml, .xml, .pl
98
99HTML is output only if the Accept: header or an extension does not request a
100specific format.
101});
102    last_rule;
103}
104
105=head2 show_help_specific
106
107Displays a help page about a specific topic. Will look for a method named
108C<show_help_specific_$1>.
109
110=cut
111
112sub show_help_specific {
113    my $topic = $1;
114    my $method = "show_help_specific_$topic";
115    __PACKAGE__->can($method) or abort(404);
116
117    Jifty->web->response->content_type('text/plain; charset=utf-8');
118    Jifty->web->response->body(__PACKAGE__->$method);
119    last_rule;
120}
121
122=head2 show_help_specific_search
123
124Explains /=/search/ a bit more in-depth.
125
126=cut
127
128sub show_help_specific_search {
129    return << 'SEARCH';
130This interface supports searching arbitrary columns and values. For example, if
131you're looking at a Task with due date 1999-12-25 and complete, you can use:
132
133    /=/search/Task/due/1999-12-25/complete/1
134
135If you're looking for just the summaries of these tasks, you can use:
136
137    /=/search/Task/due/1999-12-25/complete/1/summary
138
139Any column in the model is eligible for searching. If you specify multiple
140values for the same column, they'll be ORed together. For example, if you're
141looking for Tasks with due dates 1999-12-25 OR 2000-12-25, you can use:
142
143    /=/search/Task/due/1999-12-25/due/2000-12-25/
144
145
146There are also some pseudo-columns. They are prefixed by __ to avoid collisions
147with actual column names.
148
149Not:
150
151    .../__not/<column>/<value>
152
153This lets you search for records whose value for the column is NOT equal
154to the specified value.
155
156Ordering:
157
158    .../__order_by/<column>
159    .../__order_by_asc/<column>
160    .../__order_by_desc/<column>
161
162These let you change the output order of the results. Multiple '__order_by's
163will be respected.
164
165Pagination:
166
167    .../__page/<number>
168    .../__per_page/<number>
169
170These let you control how many results you'll get.
171SEARCH
172}
173
174=head2 show_version
175
176Displays versions of the various bits of your application.
177
178=cut
179
180sub show_version {
181    outs(['version'], {
182        Jifty => $Jifty::VERSION,
183        REST  => $Jifty::Plugin::REST::VERSION,
184    });
185}
186
187=head2 list PREFIX items
188
189Takes a URL prefix and a set of items to render. passes them on.
190
191=cut
192
193sub list {
194    my $prefix = shift;
195    outs($prefix, \@_)
196}
197
198=head2 output_format [prefix]
199
200Returns the user's desired output format. Returns a hashref of:
201
202    format: JSON, JS, YAML, XML, Perl, or HTML
203    extension: json, js, yml, xml, pl, or html
204    content_type: text/x-yaml; charset=UTF-8, etc.
205    freezer: \&Jifty::YAML::Dump, etc.
206
207
208=cut
209
210sub output_format {
211    my $prefix = shift;
212    my $accept = (Jifty->web->request->env->{HTTP_ACCEPT} || '');
213
214    my (@prefix, $url);
215    if ($prefix) {
216        @prefix = map {s/::/./g; $_} @$prefix;
217        $url    = Jifty->web->url(path => join '/', '=',@prefix);
218    }
219
220    if ($accept =~ /ya?ml/i) {
221        return {
222            format       => 'YAML',
223            extension    => 'yml',
224            content_type => 'text/x-yaml; charset=UTF-8',
225            freezer      => \&Jifty::YAML::Dump,
226        };
227    }
228    elsif ($accept =~ /json/i) {
229        return {
230            format       => 'JSON',
231            extension    => 'json',
232            content_type => 'application/json; charset=UTF-8',
233            freezer      => \&Jifty::JSON::encode_json,
234        };
235    }
236    elsif ($accept =~ /j(?:ava)?s|ecmascript/i) {
237        return {
238            format       => 'JS',
239            extension    => 'js',
240            content_type => 'application/javascript; charset=UTF-8',
241            freezer      => sub { 'var $_ = ' . Jifty::JSON::encode_json( @_ ) },
242        };
243    }
244    elsif ($accept =~ qr{^(?:application/x-)?(?:perl|pl)$}i) {
245        return {
246            format       => 'Perl',
247            extension    => 'pl',
248            content_type => 'application/x-perl; charset=UTF-8',
249            freezer      => \&Data::Dumper::Dumper,
250        };
251    }
252    elsif ($accept =~  qr|^(text/)?xml$|i) {
253        return {
254            format       => 'XML',
255            extension    => 'xml',
256            content_type => 'text/xml; charset=UTF-8',
257            freezer      => \&render_as_xml,
258        };
259    }
260    # if we ever have a non-html fallback case, we should be checking for an
261    # $accept of HTML here
262    else {
263        my $freezer;
264
265        # Special case showing particular actions to show an HTML form
266        if (    defined $prefix
267            and $prefix->[0] eq 'action'
268            and scalar @$prefix == 2 )
269        {
270            $freezer = sub { show_action_form($prefix->[1]) };
271        }
272        else {
273            $freezer = sub { render_as_html($prefix, $url, @_) };
274        }
275
276        return {
277            format       => 'HTML',
278            extension    => 'html',
279            content_type => 'text/html; charset=UTF-8',
280            freezer      => $freezer,
281        };
282    }
283}
284
285=head2 outs PREFIX DATASTRUCTURE
286
287Takes a url path prefix and a data structure.  Depending on what content types the other side of the HTTP connection can accept,
288renders the content as YAML, JSON, JavaScript, Perl, XML or HTML.
289
290=cut
291
292sub outs {
293    my $prefix = shift;
294    my $format = output_format($prefix);
295    warn "==> using $format->{format}" if $main::DEBUG;
296
297    Jifty->web->response->content_type($format->{content_type});
298    Jifty->handler->buffer->out_method->($format->{freezer}->(@_));
299    last_rule;
300}
301
302our $xml_config = { SuppressEmpty   => undef,
303                    NoAttr          => 1,
304                    RootName        => 'data' };
305
306=head2 render_as_xml DATASTRUCTURE
307
308Attempts to render DATASTRUCTURE as simple, tag-based XML.
309
310=cut
311
312sub render_as_xml {
313    my $content = shift;
314
315    if (ref($content) eq 'ARRAY') {
316        return XMLout({value => $content}, %$xml_config);
317    }
318    elsif (ref($content) eq 'HASH') {
319        return XMLout($content, %$xml_config);
320    } else {
321        return XMLout({value => $content}, %$xml_config)
322    }
323}
324
325
326=head2 render_as_html PREFIX URL DATASTRUCTURE
327
328Attempts to render DATASTRUCTURE as simple semantic HTML suitable for humans to look at.
329
330=cut
331
332sub render_as_html {
333    my $prefix = shift;
334    my $url = shift;
335    my $content = shift;
336
337    my $title = _("%1 - REST API", Jifty->config->framework('ApplicationName'));
338
339    if (ref($content) eq 'ARRAY') {
340        return start_html(-encoding => 'UTF-8', -declare_xml => 1, -title => $title),
341              ul(map {
342                ref($_) eq 'HASH' ? render_as_html($url, $prefix,$_) :
343                    li(
344                    ref($_) eq 'ARRAY' ? render_as_html($url, $prefix,$_) :
345
346                      ($prefix ?
347                     a({-href => "$url/".Jifty::Web->escape_uri($_)}, Jifty::Web->escape($_))
348                     : Jifty::Web->escape($_) ))
349              } @{$content}),
350              end_html();
351    }
352    elsif (ref($content) eq 'HASH') {
353        return start_html(-encoding => 'UTF-8', -declare_xml => 1, -title => $title),
354              dl(map {
355                  dt($prefix ?
356                     a({-href => "$url/".Jifty::Web->escape_uri($_)}, Jifty::Web->escape($_))
357                     : Jifty::Web->escape($_)),
358                  dd(html_dump($content->{$_})),
359              } sort keys %{$content}),
360              end_html();
361    }
362    else {
363        return start_html(-encoding => 'UTF-8', -declare_xml => 1, -title => $title),
364              Jifty::Web->escape($content),
365              end_html();
366    }
367}
368
369
370=head2 html_dump DATASTRUCTURE
371
372Recursively render DATASTRUCTURE as some simple HTML C<dl>s and C<ol>s.
373
374=cut
375
376
377sub html_dump {
378    my $content = shift;
379    if (ref($content) eq 'ARRAY') {
380        if (@$content) {
381            return ul(map {
382                li(html_dump($_))
383            } @{$content});
384        }
385        else {
386            return;
387        }
388    }
389    elsif (ref($content) eq 'HASH') {
390        if (keys %$content) {
391            return dl(map {
392                dt(Jifty::Web->escape($_)),
393                dd(html_dump($content->{$_})),
394            } sort keys %{$content});
395        }
396        else {
397            return;
398        }
399
400    } elsif (ref($content) && $content->isa('Jifty::Collection')) {
401        if ($content->count) {
402            return  ol( map { li( html_dump_record($_))  } @{$content->items_array_ref});
403        }
404        else {
405            return;
406        }
407
408    } elsif (ref($content) && $content->isa('Jifty::Record')) {
409          return   html_dump_record($content);
410    }
411    else {
412        Jifty::Web->escape($content);
413    }
414}
415
416=head2 html_dump_record Jifty::Record
417
418Returns a nice simple HTML definition list of the keys and values of a Jifty::Record object.
419
420=cut
421
422
423sub html_dump_record {
424    my $item = shift;
425     my %hash = $item->as_hash;
426
427     return  dl( map {dt($_), dd($hash{$_}) } keys %hash )
428}
429
430=head2 action ACTION
431
432Canonicalizes ACTION into the class-name form preferred by Jifty by cleaning up
433casing, delimiters, etc. Throws an appropriate HTTP error code if the action is
434unavailable.
435
436=cut
437
438
439sub action {
440    _resolve(
441        name          => $_[0],
442        base          => 'Jifty::Action',
443        possibilities => [Jifty->api->visible_actions],
444# We do not do this check because we want users to see actions on GET requests,
445# like when they're exploring the REST API in their browser.
446#        is_allowed    => sub { Jifty->api->is_allowed(shift) },
447    );
448}
449
450=head2 model MODEL
451
452Canonicalizes MODEL into the class-name form preferred by Jifty by cleaning up
453casing, delimiters, etc. Throws an appropriate HTTP error code if the model is
454unavailable.
455
456=cut
457
458sub model {
459    _resolve(
460        name          => $_[0],
461        base          => 'Jifty::Record',
462        possibilities => [Jifty->class_loader->models],
463        is_allowed    => sub { not shift->is_private },
464    );
465}
466
467sub _resolve {
468    my %args = @_;
469
470    # we display actions as "AppName.Action.Foo", so we want to convert those
471    # heathen names to be Perl-style
472    $args{name} =~ s/\./::/g;
473
474    my $re = qr/(?:^|::)\Q$args{name}\E$/i;
475
476    my $hit;
477    foreach my $class (@{ $args{possibilities} }) {
478        if ($class =~ $re && $class->isa($args{base})) {
479            $hit = $class;
480            last;
481        }
482    }
483
484    abort(404) if !defined($hit);
485
486    abort(403) if $args{is_allowed} && !$args{is_allowed}->($hit);
487
488    return $hit;
489}
490
491sub _unescape {
492    return map { Jifty::I18N->maybe_decode_utf8( URI::Escape::uri_unescape($_) ) } @_;
493}
494
495
496=head2 list_models
497
498Sends the user a list of models in this application, with the names transformed from Perlish::Syntax to Everything.Else.Syntax
499
500=cut
501
502sub list_models {
503    list(['model'], map { s/::/./g; $_ } grep {not $_->is_private} Jifty->class_loader->models);
504}
505
506=head2 valid_column
507
508Returns true if the column is a valid column to observe on the model
509
510=cut
511
512our @column_attrs =
513qw( name
514    documentation
515    type
516    default
517    readable writable
518    display_length
519    max_length
520    mandatory
521    distinct
522    sort_order
523    refers_to
524    by
525    alias_for_column
526    aliased_as
527    label hints
528    valid_values
529);
530
531sub valid_column {
532    my ( $model, $column ) = @_;
533    return scalar grep { $_->name eq $column and not $_->virtual and not $_->private } $model->new->columns;
534}
535
536=head2 list_model_columns
537
538Sends the user a nice list of all columns in a given model class. Exactly which model is shoved into $1 by the dispatcher. This should probably be improved.
539
540
541=cut
542
543sub list_model_columns {
544    my ($model) = model($1);
545
546    my %cols;
547    for my $col ( $model->new->columns ) {
548        next if $col->private or $col->virtual;
549        $cols{ $col->name } = { };
550        for ( @column_attrs ) {
551            my $val = $col->$_();
552            $cols{ $col->name }->{ $_ } = Scalar::Defer::force($val)
553                if defined $val and length $val;
554        }
555        if (my $serialized = $model->column_serialized_as($col)) {
556            $cols{ $col->name }->{serialized_as} = $serialized;
557        }
558        $cols{ $col->name }{writable} = 0 if exists $cols{$col->name}{writable} and $col->protected;
559    }
560
561    outs( [ 'model', $model ], \%cols );
562}
563
564=head2 list_model_items MODELCLASS COLUMNNAME
565
566Returns a list of items in MODELCLASS sorted by COLUMNNAME, with only COLUMNNAME displayed.  (This should have some limiting thrown in)
567
568=cut
569
570
571sub list_model_items {
572    # Normalize model name - fun!
573    my ( $model, $column ) = ( model($1), _unescape($2) );
574    my $col = $model->new->collection_class->new;
575    $col->unlimit;
576
577    # Check that the field is actually a column
578    abort(404) unless valid_column($model, $column);
579
580    # If we don't load the PK, we won't get data
581    $col->columns("id", $column);
582    $col->order_by( column => $column );
583
584    list( [ 'model', $model, $column ],
585        map { Jifty::Util->stringify($_->$column()) }
586            @{ $col->items_array_ref || [] } );
587}
588
589
590=head2 show_item_field $model, $column, $key, $field
591
592Loads up a model of type C<$model> which has a column C<$column> with a value C<$key>. Returns the value of C<$field> for that object.
593Returns 404 if it doesn't exist.
594
595=cut
596
597sub show_item_field {
598    my ( $model, $column, $key, $field ) = ( model($1), _unescape($2, $3, $4) );
599    my $rec = $model->new;
600    $rec->load_by_cols( $column => $key );
601    $rec->id          or abort(404);
602    $rec->can($field) or abort(404);
603
604    # Check that the field is actually a column (and not some other method)
605    abort(404) unless valid_column($model, $field);
606
607    outs( [ 'model', $model, $column, $key, $field ],
608          Jifty::Util->stringify($rec->$field()) );
609}
610
611=head2 show_item $model, $column, $key
612
613Loads up a model of type C<$model> which has a column C<$column> with a value C<$key>. Returns all columns for the object
614
615Returns 404 if it doesn't exist.
616
617=cut
618
619sub show_item {
620    my ($model, $column, $key) = (model($1), _unescape($2, $3));
621    my $rec = $model->new;
622
623    # Check that the field is actually a column
624    abort(404) unless valid_column($model, $column);
625
626    $rec->load_by_cols( $column => $key );
627    $rec->id or abort(404);
628    $rec->current_user_can('read') or abort(403);
629
630    outs( ['model', $model, $column, $key], $rec->jifty_serialize_format );
631}
632
633=head2 search_items $model, [c1, v1, c2, v2, ...] [, $field]
634
635Loads up all models of type C<$model> that match the given columns and values.
636If the column and value list has an odd count, then the last item is taken to
637be the output column. Otherwise, all items will be returned.
638
639Will throw a 404 if there were no matches, or C<$field> was invalid.
640
641Pseudo-columns:
642
643=over 4
644
645=item __per_page => N
646
647Return the collection as N records per page.
648
649=item __page => N
650
651Return page N of the collection
652
653=item __order_by => C<column>
654
655Order by the given column, ascending.
656
657=item __order_by_desc => C<column>
658
659Order by the given column, descending.
660
661=back
662
663=cut
664
665sub search_items {
666    my ($model, $fragment) = (model($1), $2);
667    my @pieces = grep {length} split '/', $fragment;
668    my $ret = ['search', $model, _unescape(@pieces)];
669
670    # limit to the key => value pairs they gave us
671    my $collection = eval { $model->collection_class->new }
672        or abort(404);
673    $collection->unlimit;
674
675    my $record = $model->new
676        or abort(404);
677
678    my $added_order = 0;
679    my $per_page;
680    my $current_page = 1;
681
682    my %special = (
683        __per_page => sub {
684            my $N = shift;
685
686            # must be a number
687            $N =~ /^\d+$/
688                or abort(404);
689
690            $per_page = $N;
691        },
692        __page => sub {
693            my $N = shift;
694
695            # must be a number
696            $N =~ /^\d+$/
697                or abort(404);
698
699            $current_page = $N;
700        },
701        __order_by => sub {
702            my $col = shift;
703            my $order = shift || 'ASC';
704
705            # this will wipe out the default ordering on your model the first
706            # time around
707            if ($added_order) {
708                $collection->add_order_by(
709                    column => $col,
710                    order  => $order,
711                );
712            }
713            else {
714                $added_order = 1;
715                $collection->order_by(
716                    column => $col,
717                    order  => $order,
718                );
719            }
720        },
721        __not => sub {
722            my $column = shift;
723            my $value  = shift @pieces;
724
725            my $canonicalizer = "canonicalize_$column";
726            $value = $record->$canonicalizer($value)
727                if $record->can($canonicalizer);
728
729            $collection->limit(
730                column   => $column,
731                value    => $value,
732                operator => '!=',
733            );
734        },
735    );
736
737    # this was called __limit before it was generalized
738    $special{__limit} = $special{__per_page};
739
740    # /__order_by/name/desc is impossible to distinguish between ordering by
741    # 'name', descending, and ordering by 'name', with output column 'desc'.
742    # so we use __order_by_desc instead (and __order_by_asc is provided for
743    # consistency)
744    $special{__order_by_asc}  = $special{__order_by};
745    $special{__order_by_desc} = sub { $special{__order_by}->($_[0], 'DESC') };
746
747    while (@pieces > 1) {
748        my $column = shift @pieces;
749        my $value  = shift @pieces;
750
751        if (exists $special{$column}) {
752            $special{$column}->($value);
753        }
754        else {
755            my $canonicalizer = "canonicalize_$column";
756            $value = $record->$canonicalizer($value)
757                if $record->can($canonicalizer);
758
759            $collection->limit(column => $column, value => $value);
760        }
761    }
762
763    # if they provided an odd number of pieces, the last is the output column
764    my $field;
765    if (@pieces) {
766        $field = shift @pieces;
767    }
768
769    if (defined($per_page) || defined($current_page)) {
770        $per_page = 15 unless defined $per_page;
771        $current_page = 1 unless defined $current_page;
772        $collection->set_page_info(
773            current_page => $current_page,
774            per_page     => $per_page,
775        );
776    }
777
778    $collection->count                       or return outs($ret, []);
779    $collection->pager->entries_on_this_page or return outs($ret, []);
780
781    # output
782    if (defined $field) {
783        my $item = $collection->first
784            or return outs($ret, []);
785
786        # Check that the field is actually a column
787        abort(404) unless valid_column($model, $field);
788
789        my @values;
790
791        # collect the values for $field
792        do {
793            push @values, $item->$field;
794        } while $item = $collection->next;
795
796        outs($ret, \@values);
797    }
798    else {
799        outs($ret, $collection->jifty_serialize_format);
800    }
801}
802
803=head2 create_item
804
805Implemented by redispatching to a CreateModel action.
806
807=cut
808
809sub create_item { _dispatch_to_action('Create') }
810
811=head2 replace_item
812
813Implemented by redispatching to a CreateModel or UpdateModel action.
814
815=cut
816
817sub replace_item { _dispatch_to_action('Update') }
818
819=head2 replace_item_field $model, $column, $key, $field
820
821Loads up a model of type C<$model> which has a column C<$column> with a value C<$key>.
822Sets the value of the field based on the request payload.
823Returns 404 if it doesn't exist.
824
825=cut
826
827sub replace_item_field {
828    my ( $model, $column, $key, $field ) = ( model($1), $2, $3, $4 );
829    my $rec = $model->new;
830    $rec->load_by_cols( $column => $key );
831    $rec->id          or abort(404);
832    $rec->current_user_can(update => $field) or abort (403);
833
834    # Check that the field is actually a column (and not some other method)
835    abort(404) unless valid_column($model, $field);
836
837    my $buffer;
838    Jifty->web->request->body->read($buffer, Jifty->web->request->content_length);
839
840
841
842    my $method = "set_".$field;
843    my ($val,$msg) = $rec->$method($buffer);
844
845    if (!$val) {
846        Jifty->web->response->status( 500 );
847    }
848
849    outs($msg);
850}
851
852=head2 delete_item
853
854Implemented by redispatching to a DeleteModel action.
855
856=cut
857
858sub delete_item { _dispatch_to_action('Delete') }
859
860sub _dispatch_to_action {
861    my $prefix = shift;
862    my ($model, $class, $column, $key) = (model($1), $1, $2, $3);
863    my $rec = $model->new;
864    $rec->load_by_cols( $column => $key )
865        if defined $column and defined $key;
866
867    if ( not $rec->id ) {
868        abort(404) if $prefix eq 'Delete' || $prefix eq 'Update';
869    }
870
871    $class =~ s/^[\w\.]+\.//;
872
873    # 403 unless the action exists
874    my $action = action($prefix . $class);
875
876    if ( defined $column and defined $key ) {
877        Jifty->web->request->argument( $column => $key );
878        Jifty->web->request->argument( 'id' => $rec->id )
879            if defined $rec->id;
880    }
881
882    Jifty->web->request->method('POST');
883    dispatch "/=/action/$action";
884}
885
886=head2 list_actions
887
888Returns a list of all actions visible to the current user. (Canonicalizes Perl::Style to Everything.Else.Style).
889
890=cut
891
892sub list_actions {
893    list(['action'], map {s/::/./g; $_} Jifty->api->visible_actions);
894}
895
896=head2 list_action_params
897
898Takes a single parameter, $action, supplied by the dispatcher.
899
900Shows the user all possible parameters to the action.
901
902=cut
903
904our @param_attrs = qw(
905    name
906    documentation
907    type
908    default_value
909    label
910    hints
911    mandatory
912    ajax_validates
913    length
914    valid_values
915);
916
917sub list_action_params {
918    my ($class) = action($1);
919    my $action = $class->new or abort(404);
920
921    my $arguments = $action->arguments;
922    my %args;
923    for my $arg ( keys %$arguments ) {
924        $args{ $arg } = { };
925        for ( @param_attrs ) {
926            # Valid values is special because sometimes it has a collection
927            # object that needs to be abstracted away
928            my $val = $_ eq 'valid_values'
929                        ? $action->valid_values($arg)
930                        : $arguments->{ $arg }{ $_ };
931            $args{ $arg }->{ $_ } = Scalar::Defer::force($val)
932                if defined $val and length $val;
933        }
934    }
935
936    outs( ['action', $class], \%args );
937}
938
939=head2 show_action_form $ACTION_CLASS
940
941Takes a single parameter, the class of an action.
942
943Shows the user an HTML form of the action's parameters to run that action.
944
945=cut
946
947sub show_action_form {
948    my ($action) = action(shift);
949    Jifty::Util->require($action) or abort(404);
950    $action = $action->new or abort(404);
951    # XXX - Encapsulation?  Someone please think of the encapsulation!
952    no warnings 'redefine';
953    local *Jifty::Action::form_field_name = sub { shift; $_[0] };
954    local *Jifty::Action::register = sub { 1 };
955    local *Jifty::Web::Form::Field::Unrendered::render = \&Jifty::Web::Form::Field::render;
956
957    Jifty->web->response->{body} .= start_html(-encoding => 'UTF-8', -declare_xml => 1, -title => ref($action));
958    Jifty->web->form->start;
959    for my $name ($action->argument_names) {
960        Jifty->web->response->{body} .= $action->form_field($name);
961    }
962    Jifty->web->form->submit( label => 'POST' );
963    Jifty->web->form->end;
964    Jifty->web->response->{body} .= end_html;
965    last_rule;
966}
967
968=head2 run_action
969
970Expects $1 to be the name of an action we want to run.
971
972Runs the action, I<with the HTTP arguments as its arguments>. That is, it's not looking for Jifty-encoded (J:F) arguments.
973If you have an action called "MyApp::Action::Ping" that takes a parameter, C<ip>, this action will look for an HTTP
974argument called C<ip>, (not J:F-myaction-ip).
975
976Returns the action's result.
977
978TODO, doc the format of the result.
979
980On an invalid action name, throws a C<404>.
981On a disallowed action name, throws a C<403>.
982On an internal error, throws a C<500>.
983
984=cut
985
986sub run_action {
987    my ($action_name) = action($1);
988    Jifty::Util->require($action_name) or abort(404);
989
990    my $args = Jifty->web->request->arguments;
991    delete $args->{''};
992
993    my $action = $action_name->new( arguments => $args ) or abort(404);
994
995    Jifty->api->is_allowed( $action_name ) or abort(403);
996
997    $action->validate;
998
999    local $@;
1000    eval { $action->run };
1001
1002    if ($@) {
1003        warn $@;
1004        abort(500);
1005    }
1006
1007    my $rec = $action->{record};
1008    if ($action->result->success && $rec and $rec->isa('Jifty::Record') and $rec->id and ($rec->load($rec->id))[0]) {
1009        my @fragments = ('model', ref($rec), 'id', $rec->id);
1010
1011        my $path = join '/', '=', map { Jifty::Web->escape_uri($_) } @fragments;
1012
1013        my $extension = output_format(\@fragments)->{extension};
1014        $path .= '.' . $extension;
1015
1016        my $url = Jifty->web->url(path => $path);
1017
1018        Jifty->web->response->status( 302 );
1019        Jifty->web->response->header('Location' => $url);
1020    }
1021
1022    outs(undef, $action->result->as_hash);
1023
1024    last_rule;
1025}
1026
10271;
1028