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