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 #
 171 # private functions -- for use in Base only
 172 #
 173
 174 sub _run_action {
 175   my $self   = shift;
 176   my $action = shift;
 177   my $sub    = "action_${action}";
 178
 179   return $self->_dispatch(@_) if $action eq 'dispatch';
 180
 181   $::form->error("Invalid action '${action}' for controller " . ref($self)) if !$self->can($sub);
 182
 183   $self->_run_hooks('before', $action);
 184   $self->$sub(@_);
 185   $self->_run_hooks('after', $action);
 186 }
 187
 188 sub _controller_name {
 189   return (split(/::/, ref($_[0])))[-1];
 190 }
 191
 192 sub _dispatch {
 193   my $self    = shift;
 194
 195   no strict 'refs';
 196   my @actions = map { s/^action_//; $_ } grep { m/^action_/ } keys %{ ref($self) . "::" };
 197   my $action  = first { $::form->{"action_${_}"} } @actions;
 198   my $sub     = "action_${action}";
 199
 200   if ($self->can($sub)) {
 201     $self->_run_hooks('before', $action);
 202     $self->$sub(@_);
 203     $self->_run_hooks('after', $action);
 204   } else {
 205     $::form->error($::locale->text('Oops. No valid action found to dispatch. Please report this case to the Lx-Office team.'));
 206   }
 207 }
 208
 209 sub _template_obj {
 210   my ($self) = @_;
 211
 212   $self->{__basepriv_template_obj} ||=
 213     Template->new({ INTERPOLATE  => 0,
 214                     EVAL_PERL    => 0,
 215                     ABSOLUTE     => 1,
 216                     CACHE_SIZE   => 0,
 217                     PLUGIN_BASE  => 'SL::Template::Plugin',
 218                     INCLUDE_PATH => '.:templates/webpages',
 219                     COMPILE_EXT  => '.tcc',
 220                     COMPILE_DIR  => $::lx_office_conf{paths}->{userspath} . '/templates-cache',
 221                   }) || croak;
 222
 223   return $self->{__basepriv_template_obj};
 224 }
 225
 226 1;
 227
 228 __END__
 229
 230 =head1 NAME
 231
 232 SL::Controller::Base - base class for all action controllers
 233
 234 =head1 SYNOPSIS
 235
 236 =head2 OVERVIEW
 237
 238 This is a base class for all action controllers. Action controllers
 239 provide subs that are callable by special URLs.
 240
 241 For each request made to the web server an instance of the controller
 242 will be created. After the request has been served that instance will
 243 handed over to garbage collection.
 244
 245 This base class is derived from L<Rose::Object>.
 246
 247 =head2 CONVENTIONS
 248
 249 The URLs have the following properties:
 250
 251 =over 2
 252
 253 =item *
 254
 255 The script part of the URL must be C<controller.pl>.
 256
 257 =item *
 258
 259 There must be a GET or POST parameter named C<action> containing the
 260 name of the controller and the sub to call separated by C</>,
 261 e.g. C<Message/list>.
 262
 263 =item *
 264
 265 The controller name is the package's name without the
 266 C<SL::Controller::> prefix. At the moment only packages in the
 267 C<SL::Controller> namespace are valid; sub-namespaces are not
 268 allowed. The package name must start with an upper-case letter.
 269
 270 =item *
 271
 272 The sub part of the C<action> parameter is the name of the sub to
 273 call. However, the sub's name is automatically prefixed with
 274 C<action_>. Therefore for the example C<Message/list> the sub
 275 C<SL::DB::Message::action_list> would be called. This in turn means
 276 that subs whose name does not start with C<action_> cannot be invoked
 277 directly via the URL.
 278
 279 =back
 280
 281 =head2 INDIRECT DISPATCHING
 282
 283 In the case that there are several submit buttons on a page it is
 284 often impractical to have a single C<action> parameter match up
 285 properly. For such a case a special dispatcher method is available. In
 286 that case the C<action> parameter of the URL must be
 287 C<Controller/dispatch>.
 288
 289 The C<SL::Controller::Base::_dispatch> method will iterate over all
 290 subs in the controller package whose names start with C<action_>. The
 291 first one for which there's a GET or POST parameter with the same name
 292 and that's trueish is called.
 293
 294 Usage from a template usually looks like this:
 295
 296   <form method="POST" action="controller.pl">
 297     ...
 298     <input type="hidden" name="action" value="Message/dispatch">
 299     <input type="submit" name="action_mark_as_read" value="Mark messages as read">
 300     <input type="submit" name="action_delete" value="Delete messages">
 301   </form>
 302
 303 The dispatching is handled by the function L</_dispatch>.
 304
 305 =head2 HOOKS
 306
 307 Hooks are functions that are called before or after the controller's
 308 action is called. The controller package defines the hooks, and those
 309 hooks themselves are run as instance methods.
 310
 311 Hooks are run in the order they're added.
 312
 313 The return value of the hooks is discarded.
 314
 315 Hooks can be defined to run for all actions, for only specific actions
 316 or for all actions except a list of actions. Each entry is the action
 317 name, not the sub's name. Therefore in order to run a hook before one
 318 of the subs C<action_edit> or C<action_save> is called the following
 319 code can be used:
 320
 321   __PACKAGE__->run_before('things_to_do_before_edit_and_save', only => [ 'edit', 'save' ]);
 322
 323 =head1 FUNCTIONS
 324
 325 =head2 PUBLIC HELPER FUNCTIONS
 326
 327 These functions are supposed to be called by sub-classed controllers.
 328
 329 =over 4
 330
 331 =item C<render $template, [ $options, ] %locals>
 332
 333 Renders the template C<$template>. Provides other variables than
 334 C<Form::parse_html_template> does.
 335
 336 C<$options>, if present, must be a hash reference. All remaining
 337 parameters are slurped into C<%locals>.
 338
 339 What is rendered and how C<$template> is interpreted is determined by
 340 the options I<type>, I<inline>, I<partial> and I<no_layout>.
 341
 342 If C<< $options->{inline} >> is trueish then C<$template> is a string
 343 containing the template code to interprete. Additionally the output
 344 will not be sent to the browser. Instead it is only returned to the
 345 caller.
 346
 347 If C<< $options->{raw} >> is trueish, the function will treat the input as
 348 already parsed, and will not filter the input through Template. Unlike
 349 C<inline>, the input is taked as a reference.
 350
 351 If C<< $options->{inline} >> is falsish then C<$template> is
 352 interpreted as the name of a template file. It is prefixed with
 353 "templates/webpages/" and postfixed with a file extension based on
 354 C<< $options->{type} >>. C<< $options->{type} >> can be either C<html>
 355 or C<js> and defaults to C<html>. An exception will be thrown if that
 356 file does not exist.
 357
 358 If C<< $options->{partial} >> or C<< $options->{inline} >> is trueish
 359 then neither the HTTP response header nor the standard HTML header is
 360 generated.
 361
 362 Otherwise at least the HTTP response header will be generated based on
 363 the template type (C<< $options->{type} >>).
 364
 365 If the template type is C<html> then the standard HTML header will be
 366 output via C<< $::form->header >> with C<< $::form->{title} >> set to
 367 C<$locals{title}> (the latter only if C<$locals{title}> is
 368 trueish). Setting C<< $options->{no_layout} >> to trueish will prevent
 369 this.
 370
 371 The template itself has access to the following variables:
 372
 373 =over 2
 374
 375 =item * C<AUTH> -- C<$::auth>
 376
 377 =item * C<FORM> -- C<$::form>
 378
 379 =item * C<LOCALE> -- C<$::locale>
 380
 381 =item * C<LXCONFIG> -- all parameters from C<config/lx_office.conf>
 382 with the same name they appear in the file (first level is the
 383 section, second the actual variable, e.g. C<system.dbcharset>,
 384 C<features.webdav> etc)
 385
 386 =item * C<LXDEBUG> -- C<$::lxdebug>
 387
 388 =item * C<MYCONFIG> -- C<%::myconfig>
 389
 390 =item * C<SELF> -- the controller instance
 391
 392 =item * All items from C<%locals>
 393
 394 =back
 395
 396 Unless C<< $options->{inline} >> is trueish the function will send the
 397 output to the browser.
 398
 399 The function will always return the output.
 400
 401 Example: Render a HTML template with a certain title and a few locals
 402
 403   $self->render('todo/list',
 404                 title      => 'List TODO items',
 405                 TODO_ITEMS => SL::DB::Manager::Todo->get_all_sorted);
 406
 407 Example: Render a string and return its content for further processing
 408 by the calling function. No header is generated due to C<inline>.
 409
 410   my $content = $self->render('[% USE JavaScript %][% JavaScript.replace_with("#someid", "js/something") %]',
 411                               { type => 'js', inline => 1 });
 412
 413 Example: Render a JavaScript template and send it to the
 414 browser. Typical use for actions called via AJAX:
 415
 416   $self->render('todo/single_item', { type => 'js' },
 417                 item => $employee->most_important_todo_item);
 418
 419 =item C<send_file $file_name, [%params]>
 420
 421 Sends the file C<$file_name> to the browser including appropriate HTTP
 422 headers for a download. C<%params> can include the following:
 423
 424 =over 2
 425
 426 =item * C<type> -- the file's content type; defaults to
 427 'application/octet_stream'
 428
 429 =item * C<name> -- the name presented to the browser; defaults to
 430 C<$file_name>
 431
 432 =back
 433
 434 =item C<url_for $url>
 435
 436 =item C<url_for $params>
 437
 438 =item C<url_for %params>
 439
 440 Creates an URL for the given parameters suitable for calling an action
 441 controller. If there's only one scalar parameter then it is returned
 442 verbatim.
 443
 444 Otherwise the parameters are given either as a single hash ref
 445 parameter or as a normal hash.
 446
 447 The controller to call is given by C<$params{controller}>. It defaults
 448 to the current controller as returned by
 449 L</_controller_name>.
 450
 451 The action to call is given by C<$params{action}>. It defaults to
 452 C<dispatch>.
 453
 454 All other key/value pairs in C<%params> are appended as GET parameters
 455 to the URL.
 456
 457 Usage from a template might look like this:
 458
 459   <a href="[% SELF.url_for(controller => 'Message', action => 'new', recipient_id => 42) %]">create new message</a>
 460
 461 =item C<redirect_to %url_params>
 462
 463 Redirects the browser to a new URL by outputting a HTTP redirect
 464 header. The URL is generated by calling L</url_for> with
 465 C<%url_params>.
 466
 467 =item C<run_before $sub, %params>
 468
 469 =item C<run_after $sub, %params>
 470
 471 Adds a hook to run before or after certain actions are run for the
 472 current package. The code to run is C<$sub> which is either the name
 473 of an instance method or a code reference. If it's the latter then the
 474 first parameter will be C<$self>.
 475
 476 C<%params> can contain two possible values that restrict the code to
 477 be run only for certain actions:
 478
 479 =over 2
 480
 481 =item C<< only => \@list >>
 482
 483 Only run the code for actions given in C<@list>. The entries are the
 484 action names, not the names of the sub (so it's C<list> instead of
 485 C<action_list>).
 486
 487 =item C<< except => \@list >>
 488
 489 Run the code for all actions but for those given in C<@list>. The
 490 entries are the action names, not the names of the sub (so it's
 491 C<list> instead of C<action_list>).
 492
 493 =back
 494
 495 If neither restriction is used then the code will be run for any
 496 action.
 497
 498 The hook's return values are discarded.
 499
 500 =item delay_flash_on_redirect
 501
 502 May be overridden by a controller. If this method returns true, redirect_to
 503 will delay all flash messages for the current request. Defaults to false for
 504 compatibility reasons.
 505
 506 =back
 507
 508 =head2 PRIVATE FUNCTIONS
 509
 510 These functions are supposed to be used from this base class only.
 511
 512 =over 4
 513
 514 =item C<_controller_name>
 515
 516 Returns the name of the curernt controller package without the
 517 C<SL::Controller::> prefix.
 518
 519 =item C<_dispatch>
 520
 521 Implements the method lookup for indirect dispatching mentioned in the
 522 section L</INDIRECT DISPATCHING>.
 523
 524 =item C<_run_action $action>
 525
 526 Executes a sub based on the value of C<$action>. C<$action> is the sub
 527 name part of the C<action> GET or POST parameter as described in
 528 L</CONVENTIONS>.
 529
 530 If C<$action> equals C<dispatch> then the sub L</_dispatch> in this
 531 base class is called for L</INDIRECT DISPATCHING>. Otherwise
 532 C<$action> is prefixed with C<action_>, and that sub is called on the
 533 current controller instance.
 534
 535 =back
 536
 537 =head1 AUTHOR
 538
 539 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 540
 541 =cut