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