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