SL/Controller/Base.pm

   1 package SL::Controller::Base;
   2
   3 use strict;
   4
   5 use parent qw(Rose::Object);
   6
   7 use Carp;
   8 use IO::File;
   9 use List::Util qw(first);
  10 use MIME::Base64;
  11 use SL::Request qw(flatten);
  12 use SL::MoreCommon qw(uri_encode);
  13 use SL::Presenter;
  14
  15 use Rose::Object::MakeMethods::Generic
  16 (
  17   scalar                  => [ qw(action_name) ],
  18   'scalar --get_set_init' => [ qw(js p) ],
  19 );
  20
  21 #
  22 # public/helper functions
  23 #
  24
  25 sub url_for {
  26   my $self = shift;
  27
  28   return $_[0] if (scalar(@_) == 1) && !ref($_[0]);
  29
  30   my %params      = ref($_[0]) eq 'HASH' ? %{ $_[0] } : @_;
  31   my $controller  = delete($params{controller}) || $self->controller_name;
  32   my $action      = $params{action}             || 'dispatch';
  33   my $fragment    = delete $params{fragment};
  34
  35   my $script;
  36   if ($controller =~ m/\.pl$/) {
  37     # Old-style controller
  38     $script = $controller;
  39   } else {
  40     $params{action} = "${controller}/${action}";
  41     $script         = "controller.pl";
  42   }
  43
  44   my $query       = join '&', map { uri_encode($_->[0]) . '=' . uri_encode($_->[1]) } @{ flatten(\%params) };
  45
  46   return "${script}?${query}" . (defined $fragment ? "#$fragment" : '');
  47 }
  48
  49 sub redirect_to {
  50   my $self = shift;
  51   my $url  = $self->url_for(@_);
  52
  53   if ($self->delay_flash_on_redirect) {
  54     require SL::Helper::Flash;
  55     SL::Helper::Flash::delay_flash();
  56   }
  57
  58   return $self->render(SL::ClientJS->new->redirect_to($url)) if $::request->is_ajax;
  59
  60   print $::request->{cgi}->redirect($url);
  61 }
  62
  63 sub render {
  64   my $self               = shift;
  65   my $template           = shift;
  66   my ($options, %locals) = (@_ && ref($_[0])) ? @_ : ({ }, @_);
  67
  68   # Special handling/shortcut for an instance of SL::ClientJS:
  69   return $self->render(\$template->to_json, { type => 'json' }) if ref($template) eq 'SL::ClientJS';
  70
  71   # Set defaults for all available options.
  72   my %defaults = (
  73     type       => 'html',
  74     output     => 1,
  75     header     => 1,
  76     layout     => 1,
  77     process    => 1,
  78     status     => '200 ok',
  79   );
  80   $options->{$_} //= $defaults{$_} for keys %defaults;
  81   $options->{type} = lc $options->{type};
  82
  83   # Check supplied options for validity.
  84   foreach (keys %{ $options }) {
  85     croak "Unsupported option: $_" unless $defaults{$_};
  86   }
  87
  88   # Only certain types are supported.
  89   croak "Unsupported type: " . $options->{type} unless $options->{type} =~ m/^(?:html|js|json|text)$/;
  90
  91   # The "template" argument must be a string or a reference to one.
  92   $template = ${ $template }                                       if ((ref($template) || '') eq 'REF') && (ref(${ $template }) eq 'SL::Presenter::EscapedText');
  93   croak "Unsupported 'template' reference type: " . ref($template) if ref($template) && (ref($template) !~ m/^(?:SCALAR|SL::Presenter::EscapedText)$/);
  94
  95   # If all output is turned off then don't output the header either.
  96   if (!$options->{output}) {
  97     $options->{header} = 0;
  98     $options->{layout} = 0;
  99
 100   } else {
 101     # Layout only makes sense if we're outputting HTML.
 102     $options->{layout} = 0 if $options->{type} ne 'html';
 103   }
 104
 105   # Let the presenter do the rest of the work.
 106   my $output;
 107   {
 108     local $::form->{title} = $locals{title} if $locals{title};
 109     $output = $self->presenter->render(
 110       $template,
 111       { type => $options->{type}, process => $options->{process} },
 112       %locals,
 113       SELF => $self,
 114     );
 115   }
 116
 117   if ($options->{header}) {
 118     # Output the HTTP response and the layout in case of HTML output.
 119
 120     if ($options->{layout}) {
 121       $::form->{title} = $locals{title} if $locals{title};
 122       $::form->header;
 123
 124     } else {
 125       # No layout: just the standard HTTP response. Also notify
 126       # $::form that the header has already been output so that
 127       # $::form->header() won't output it again.
 128       $::form->{header} = 1;
 129       my $content_type  = $options->{type} eq 'html' ? 'text/html'
 130                         : $options->{type} eq 'js'   ? 'text/javascript'
 131                         : $options->{type} eq 'text' ? 'text/plain'
 132                         :                              'application/json';
 133
 134       print $::form->create_http_response(content_type => $content_type,
 135                                           charset      => 'UTF-8',
 136                                           (status      => $options->{status}) x !!$options->{status});
 137     }
 138   }
 139
 140   # Print the output if wanted.
 141   print $output if $options->{output};
 142
 143   return $output;
 144 }
 145
 146 sub send_file {
 147   my ($self, $file_name_or_content, %params) = @_;
 148
 149   my ($file, $size);
 150
 151   if (!ref $file_name_or_content) {
 152     $file = IO::File->new($file_name_or_content, 'r') || croak("Cannot open file '${file_name_or_content}'");
 153     $size = -s $file_name_or_content;
 154   } else {
 155     $size = length $$file_name_or_content;
 156   }
 157
 158   my $content_type    =  $params{type} || 'application/octet_stream';
 159   my $attachment_name =  $params{name} || (!ref($file_name_or_content) ? $file_name_or_content : '');
 160   $attachment_name    =~ s:.*//::g;
 161
 162   if ($::request->is_ajax || $params{ajax}) {
 163     my $octets = ref $file_name_or_content ? $file_name_or_content : \ do { local $/ = undef; <$file> };
 164     $self->js->save_file(MIME::Base64::encode_base64($$octets), $content_type, $size, $attachment_name);
 165     $self->js->render unless $params{js_no_render};
 166   } else {
 167     print $::form->create_http_response(content_type        => $content_type,
 168                                         content_disposition => 'attachment; filename="' . $attachment_name . '"',
 169                                         content_length      => $size);
 170
 171     if (!ref $file_name_or_content) {
 172       $::locale->with_raw_io(\*STDOUT, sub { print while <$file> });
 173       $file->close;
 174       unlink $file_name_or_content if $params{unlink};
 175     } else {
 176       $::locale->with_raw_io(\*STDOUT, sub { print $$file_name_or_content });
 177     }
 178   }
 179
 180   return 1;
 181 }
 182
 183 sub presenter {
 184   return SL::Presenter->get;
 185 }
 186
 187 sub init_p {
 188   return SL::Presenter->get;
 189 }
 190
 191 sub controller_name {
 192   my $class = ref($_[0]) || $_[0];
 193   $class    =~ s/^SL::Controller:://;
 194   return $class;
 195 }
 196
 197 sub init_js {
 198   SL::ClientJS->new(controller => $_[0])
 199 }
 200
 201 #
 202 # Before/after run hooks
 203 #
 204
 205 sub run_before {
 206   _add_hook('before', @_);
 207 }
 208
 209 sub run_after {
 210   _add_hook('after', @_);
 211 }
 212
 213 my %hooks;
 214
 215 sub _add_hook {
 216   my ($when, $class, $sub, %params) = @_;
 217
 218   foreach my $key (qw(only except)) {
 219     $params{$key} = { map { ( $_ => 1 ) } @{ $params{$key} } } if $params{$key};
 220   }
 221
 222   my $idx = "${when}/${class}";
 223   $hooks{$idx} ||= [ ];
 224   push @{ $hooks{$idx} }, { %params, code => $sub };
 225 }
 226
 227 sub _run_hooks {
 228   my ($self, $when, $action) = @_;
 229
 230   my $idx = "${when}/" . ref($self);
 231
 232   foreach my $hook (@{ $hooks{$idx} || [] }) {
 233     next if ($hook->{only  } && !$hook->{only  }->{$action})
 234          || ($hook->{except} &&  $hook->{except}->{$action});
 235
 236     if (ref($hook->{code}) eq 'CODE') {
 237       $hook->{code}->($self, $action);
 238     } else {
 239       my $sub = $hook->{code};
 240       $self->$sub($action);
 241     }
 242   }
 243 }
 244
 245 #
 246 #  behaviour. override these
 247 #
 248
 249 sub delay_flash_on_redirect {
 250   0;
 251 }
 252
 253 sub get_auth_level {
 254   # Ignore the 'action' parameter.
 255   return 'user';
 256 }
 257
 258 sub keep_auth_vars_in_form {
 259   return 0;
 260 }
 261
 262 #
 263 # private functions -- for use in Base only
 264 #
 265
 266 sub _run_action {
 267   my $self   = shift;
 268   my $action = shift;
 269   my $sub    = "action_${action}";
 270
 271   return $self->_dispatch(@_) if $action eq 'dispatch';
 272
 273   $::form->error("Invalid action '${action}' for controller " . ref($self)) if !$self->can($sub);
 274
 275   $self->action_name($action);
 276   $self->_run_hooks('before', $action);
 277   $self->$sub(@_);
 278   $self->_run_hooks('after', $action);
 279 }
 280
 281 sub _dispatch {
 282   my $self    = shift;
 283
 284   no strict 'refs';
 285   my @actions = map { s/^action_//; $_ } grep { m/^action_/ } keys %{ ref($self) . "::" };
 286   my $action  = first { $::form->{"action_${_}"} } @actions;
 287   my $sub     = "action_${action}";
 288
 289   if ($self->can($sub)) {
 290     $self->action_name($action);
 291     $self->_run_hooks('before', $action);
 292     $self->$sub(@_);
 293     $self->_run_hooks('after', $action);
 294   } else {
 295     $::form->error($::locale->text('Oops. No valid action found to dispatch. Please report this case to the kivitendo team.'));
 296   }
 297 }
 298
 299 1;
 300
 301 __END__
 302
 303 =head1 NAME
 304
 305 SL::Controller::Base - base class for all action controllers
 306
 307 =head1 SYNOPSIS
 308
 309 =head2 OVERVIEW
 310
 311 This is a base class for all action controllers. Action controllers
 312 provide subs that are callable by special URLs.
 313
 314 For each request made to the web server an instance of the controller
 315 will be created. After the request has been served that instance will
 316 handed over to garbage collection.
 317
 318 This base class is derived from L<Rose::Object>.
 319
 320 =head2 CONVENTIONS
 321
 322 The URLs have the following properties:
 323
 324 =over 2
 325
 326 =item *
 327
 328 The script part of the URL must be C<controller.pl>.
 329
 330 =item *
 331
 332 There must be a GET or POST parameter named C<action> containing the
 333 name of the controller and the sub to call separated by C</>,
 334 e.g. C<Message/list>.
 335
 336 =item *
 337
 338 The controller name is the package's name without the
 339 C<SL::Controller::> prefix. At the moment only packages in the
 340 C<SL::Controller> namespace are valid; sub-namespaces are not
 341 allowed. The package name must start with an upper-case letter.
 342
 343 =item *
 344
 345 The sub part of the C<action> parameter is the name of the sub to
 346 call. However, the sub's name is automatically prefixed with
 347 C<action_>. Therefore for the example C<Message/list> the sub
 348 C<SL::DB::Message::action_list> would be called. This in turn means
 349 that subs whose name does not start with C<action_> cannot be invoked
 350 directly via the URL.
 351
 352 =back
 353
 354 =head2 INDIRECT DISPATCHING
 355
 356 In the case that there are several submit buttons on a page it is
 357 often impractical to have a single C<action> parameter match up
 358 properly. For such a case a special dispatcher method is available. In
 359 that case the C<action> parameter of the URL must be
 360 C<Controller/dispatch>.
 361
 362 The C<SL::Controller::Base::_dispatch> method will iterate over all
 363 subs in the controller package whose names start with C<action_>. The
 364 first one for which there's a GET or POST parameter with the same name
 365 and that's trueish is called.
 366
 367 Usage from a template usually looks like this:
 368
 369   <form method="POST" action="controller.pl">
 370     ...
 371     <input type="hidden" name="action" value="Message/dispatch">
 372     <input type="submit" name="action_mark_as_read" value="Mark messages as read">
 373     <input type="submit" name="action_delete" value="Delete messages">
 374   </form>
 375
 376 The dispatching is handled by the function L</_dispatch>.
 377
 378 =head2 HOOKS
 379
 380 Hooks are functions that are called before or after the controller's
 381 action is called. The controller package defines the hooks, and those
 382 hooks themselves are run as instance methods.
 383
 384 Hooks are run in the order they're added.
 385
 386 The hooks receive a single parameter: the name of the action that is
 387 about to be called (for C<before> hooks) / was called (for C<after>
 388 hooks).
 389
 390 The return value of the hooks is discarded.
 391
 392 Hooks can be defined to run for all actions, for only specific actions
 393 or for all actions except a list of actions. Each entry is the action
 394 name, not the sub's name. Therefore in order to run a hook before one
 395 of the subs C<action_edit> or C<action_save> is called the following
 396 code can be used:
 397
 398   __PACKAGE__->run_before('things_to_do_before_edit_and_save', only => [ 'edit', 'save' ]);
 399
 400 =head1 FUNCTIONS
 401
 402 =head2 PUBLIC HELPER FUNCTIONS
 403
 404 These functions are supposed to be called by sub-classed controllers.
 405
 406 =over 4
 407
 408 =item C<render $template, [ $options, ] %locals>
 409
 410 Renders the template C<$template>. Provides other variables than
 411 C<Form::parse_html_template> does.
 412
 413 C<$options>, if present, must be a hash reference. All remaining
 414 parameters are slurped into C<%locals>.
 415
 416 What is rendered and how C<$template> is interpreted is determined
 417 both by C<$template>'s reference type and by the supplied options. The
 418 actual rendering is handled by L<SL::Presenter/render>.
 419
 420 If C<$template> is a normal scalar (not a reference) then it is meant
 421 to be a template file name relative to the C<templates/webpages>
 422 directory. The file name to use is determined by the C<type> option.
 423
 424 If C<$template> is a reference to a scalar then the referenced
 425 scalar's content is used as the content to process. The C<type> option
 426 is not considered in this case.
 427
 428 C<$template> can also be an instance of L<SL::Presenter::EscapedText>
 429 or a reference to such an instance. Both of these cases are handled
 430 the same way as if C<$template> were a reference to a scalar: its
 431 content is processed, and C<type> is not considered.
 432
 433 Other reference types, unknown options and unknown arguments to the
 434 C<type> option cause the function to L<croak>.
 435
 436 The following options are available (defaults: C<type> = 'html',
 437 C<process> = 1, C<output> = 1, C<header> = 1, C<layout> = 1):
 438
 439 =over 2
 440
 441 =item C<type>
 442
 443 The template type. Can be C<html> (the default), C<js> for JavaScript,
 444 C<json> for JSON and C<text> for plain text content. Affects the
 445 extension that's added to the file name given with a non-reference
 446 C<$template> argument, the content type HTTP header that is output and
 447 whether or not the layout will be output as well (see description of
 448 C<layout> below).
 449
 450 =item C<process>
 451
 452 If trueish (which is also the default) it causes the template/content
 453 to be processed by the Template toolkit. Otherwise the
 454 template/content is output as-is.
 455
 456 =item C<output>
 457
 458 If trueish (the default) then the generated output will be sent to the
 459 browser in addition to being returned. If falsish then the options
 460 C<header> and C<layout> are set to 0 as well.
 461
 462 =item C<header>
 463
 464 Determines whether or not to output the HTTP response
 465 headers. Defaults to the same value that C<output> is set to. If set
 466 to falsish then the layout is not output either.
 467
 468 =item C<layout>
 469
 470 Determines whether or not the basic HTML layout structure should be
 471 output (HTML header, common JavaScript and stylesheet inclusions, menu
 472 etc.). Defaults to 0 if C<type> is not C<html> and to the same value
 473 C<header> is set to otherwise.
 474
 475 =back
 476
 477 The template itself has access to several variables. These are listed
 478 in the documentation to L<SL::Presenter/render>.
 479
 480 The function will always return the output.
 481
 482 Example: Render a HTML template with a certain title and a few locals
 483
 484   $self->render('todo/list',
 485                 title      => 'List TODO items',
 486                 TODO_ITEMS => SL::DB::Manager::Todo->get_all_sorted);
 487
 488 Example: Render a string and return its content for further processing
 489 by the calling function. No header is generated due to C<output>.
 490
 491   my $content = $self->render(\'[% USE JavaScript %][% JavaScript.replace_with("#someid", "js/something") %]',
 492                               { output => 0 });
 493
 494 Example: Render a JavaScript template
 495 "templates/webpages/todo/single_item.js" and send it to the
 496 browser. Typical use for actions called via AJAX:
 497
 498   $self->render('todo/single_item', { type => 'js' },
 499                 item => $employee->most_important_todo_item);
 500
 501 =item C<send_file $file_name_or_content, [%params]>
 502
 503 Sends the file C<$file_name_or_content> to the browser including
 504 appropriate HTTP headers for a download. If C<$file_name_or_content>
 505 is a scalar then it is interpreted as a file name which is opened and
 506 whose content is sent. Otherwise (C<$file_name_or_content> being a
 507 reference) the referenced scalar's data itself is sent.
 508
 509 C<%params> can include the following:
 510
 511 =over 2
 512
 513 =item * C<type> -- the file's content type; defaults to
 514 'application/octet_stream'
 515
 516 =item * C<name> -- the name presented to the browser; defaults to
 517 C<$file_name>; mandatory if C<$file_name_or_content> is a reference
 518
 519 =item * C<unlink> -- if trueish and C<$file_name_or_content> refers to
 520 a file name then unlink the file after it has been sent to the browser
 521 (e.g. for temporary files)
 522
 523 =back
 524
 525 =item C<url_for $url>
 526
 527 =item C<url_for $params>
 528
 529 =item C<url_for %params>
 530
 531 Creates an URL for the given parameters suitable for calling an action
 532 controller. If there's only one scalar parameter then it is returned
 533 verbatim.
 534
 535 Otherwise the parameters are given either as a single hash ref
 536 parameter or as a normal hash.
 537
 538 The controller to call is given by C<$params{controller}>. It defaults
 539 to the current controller as returned by
 540 L</controller_name>.
 541
 542 The action to call is given by C<$params{action}>. It defaults to
 543 C<dispatch>.
 544
 545 If C<$params{fragment}> is present, it's used as the fragment of the resulting
 546 URL.
 547
 548 All other key/value pairs in C<%params> are appended as GET parameters
 549 to the URL.
 550
 551 Usage from a template might look like this:
 552
 553   <a href="[% SELF.url_for(controller => 'Message', action => 'new', recipient_id => 42) %]">create new message</a>
 554
 555 =item C<redirect_to %url_params>
 556
 557 Redirects the browser to a new URL. The URL is generated by calling
 558 L</url_for> with C<%url_params>.
 559
 560 This function implements the redirection depending on whether or not
 561 the current request is an AJAX request as determined by
 562 L<SL::Request/is_ajax>. If it is a normal request then it outputs a
 563 standard HTTP redirect header (HTTP code 302). If it is an AJAX
 564 request then it outputs an AJAX response suitable for the
 565 C<kivi.eval_json_result> function from the L<SL::ClientJS> module.
 566
 567 =item C<run_before $sub, %params>
 568
 569 =item C<run_after $sub, %params>
 570
 571 Adds a hook to run before or after certain actions are run for the
 572 current package. The code to run is C<$sub> which is either the name
 573 of an instance method or a code reference. If it's the latter then the
 574 first parameter will be C<$self>.
 575
 576 C<%params> can contain two possible values that restrict the code to
 577 be run only for certain actions:
 578
 579 =over 2
 580
 581 =item C<< only => \@list >>
 582
 583 Only run the code for actions given in C<@list>. The entries are the
 584 action names, not the names of the sub (so it's C<list> instead of
 585 C<action_list>).
 586
 587 =item C<< except => \@list >>
 588
 589 Run the code for all actions but for those given in C<@list>. The
 590 entries are the action names, not the names of the sub (so it's
 591 C<list> instead of C<action_list>).
 592
 593 =back
 594
 595 If neither restriction is used then the code will be run for any
 596 action.
 597
 598 The hook's return values are discarded.
 599
 600 =item C<delay_flash_on_redirect>
 601
 602 May be overridden by a controller. If this method returns true, redirect_to
 603 will delay all flash messages for the current request. Defaults to false for
 604 compatibility reasons.
 605
 606 =item C<get_auth_level $action>
 607
 608 May be overridden by a controller. Determines what kind of
 609 authentication is required for a particular action. Must return either
 610 C<admin> (which means that authentication as an admin is required),
 611 C<user> (authentication as a normal user suffices) with a possible
 612 future value C<none> (which would require no authentication but is not
 613 yet implemented).
 614
 615 =item C<keep_auth_vars_in_form %params>
 616
 617 May be overridden by a controller. If falsish (the default) all form
 618 variables whose name starts with C<{AUTH}> are removed before the
 619 request is routed. Only controllers that handle login requests
 620 themselves should return trueish for this function.
 621
 622 C<$params{action}> contains the action name that the request will be
 623 dispatched to.
 624
 625 =item C<controller_name>
 626
 627 Returns the name of the curernt controller package without the
 628 C<SL::Controller::> prefix. This method can be called both as a class
 629 method and an instance method.
 630
 631 =item C<action_name>
 632
 633 Returns the name of the currently executing action. If the dispatcher
 634 mechanism was used then this is not C<dispatch> but the actual method
 635 name the dispatching resolved to.
 636
 637 =item C<presenter>
 638
 639 Returns the global presenter object by calling
 640 L<SL::Presenter/get>.
 641
 642 =item C<js>
 643
 644 Returns an L<SL::ClientJS> instance for this controller.
 645
 646 =back
 647
 648 =head2 PRIVATE FUNCTIONS
 649
 650 These functions are supposed to be used from this base class only.
 651
 652 =over 4
 653
 654 =item C<_dispatch>
 655
 656 Implements the method lookup for indirect dispatching mentioned in the
 657 section L</INDIRECT DISPATCHING>.
 658
 659 =item C<_run_action $action>
 660
 661 Executes a sub based on the value of C<$action>. C<$action> is the sub
 662 name part of the C<action> GET or POST parameter as described in
 663 L</CONVENTIONS>.
 664
 665 If C<$action> equals C<dispatch> then the sub L</_dispatch> in this
 666 base class is called for L</INDIRECT DISPATCHING>. Otherwise
 667 C<$action> is prefixed with C<action_>, and that sub is called on the
 668 current controller instance.
 669
 670 =back
 671
 672 =head1 AUTHOR
 673
 674 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 675
 676 =cut