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