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