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