1 package SL::Controller::Base;
 
   5 use parent qw(Rose::Object);
 
   9 use List::Util qw(first);
 
  12 # public/helper functions
 
  18   return $_[0] if (scalar(@_) == 1) && !ref($_[0]);
 
  20   my %params      = ref($_[0]) eq 'HASH' ? %{ $_[0] } : @_;
 
  21   my $controller  = delete($params{controller}) || $self->_controller_name;
 
  22   my $action      = delete($params{action})     || 'dispatch';
 
  23   $params{action} = "${controller}/${action}";
 
  24   my $query       = join('&', map { $::form->escape($_) . '=' . $::form->escape($params{$_}) } keys %params);
 
  26   return "controller.pl?${query}";
 
  31   my $url  = $self->url_for(@_);
 
  33   print $::cgi->redirect($url);
 
  39   my ($options, %locals) = (@_ && ref($_[0])) ? @_ : ({ }, @_);
 
  41   $options->{type}       = lc($options->{type} || 'html');
 
  42   $options->{no_layout}  = 1 if $options->{type} eq 'js';
 
  45   if ($options->{inline}) {
 
  49     $source = "templates/webpages/${template}." . $options->{type};
 
  50     croak "Template file ${source} not found" unless -f $source;
 
  53   if (!$options->{partial} && !$options->{inline} && !$::form->{header}) {
 
  54     if ($options->{no_layout}) {
 
  55       $::form->{header} = 1;
 
  56       my $content_type  = $options->{type} eq 'js' ? 'text/javascript' : 'text/html';
 
  58       print $::form->create_http_response(content_type => $content_type,
 
  59                                           charset      => $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET());
 
  62       $::form->{title} = $locals{title} if $locals{title};
 
  67   my %params = ( %locals,
 
  69                  FLASH    => $::form->{FLASH},
 
  72                  LXCONFIG => \%::lx_office_conf,
 
  73                  LXDEBUG  => $::lxdebug,
 
  74                  MYCONFIG => \%::myconfig,
 
  79   my $parser = $self->_template_obj;
 
  80   $parser->process($source, \%params, \$output) || croak $parser->error;
 
  82   print $output unless $options->{inline} || $options->{no_output};
 
  88   my ($self, $file_name, %params) = @_;
 
  90   my $file            = IO::File->new($file_name, 'r') || croak("Cannot open file '${file_name}'");
 
  91   my $content_type    =  $params{type} || 'application/octet_stream';
 
  92   my $attachment_name =  $params{name} || $file_name;
 
  93   $attachment_name    =~ s:.*//::g;
 
  95   print $::form->create_http_response(content_type        => $content_type,
 
  96                                       content_disposition => 'attachment; filename="' . $attachment_name . '"',
 
  97                                       content_length      => -s $file);
 
  99   $::locale->with_raw_io(\*STDOUT, sub { print while <$file> });
 
 104 # Before/after run hooks
 
 108   _add_hook('before', @_);
 
 112   _add_hook('after', @_);
 
 118   my ($when, $class, $sub, %params) = @_;
 
 120   foreach my $key (qw(only except)) {
 
 121     $params{$key} = { map { ( $_ => 1 ) } @{ $params{$key} } } if $params{$key};
 
 124   my $idx = "${when}/${class}";
 
 125   $hooks{$idx} ||= [ ];
 
 126   push @{ $hooks{$idx} }, { %params, code => $sub };
 
 130   my ($self, $when, $action) = @_;
 
 132   my $idx = "${when}/" . ref($self);
 
 134   foreach my $hook (@{ $hooks{$idx} || [] }) {
 
 135     next if ($hook->{only  } && !$hook->{only  }->{$action})
 
 136          || ($hook->{except} &&  $hook->{except}->{$action});
 
 138     if (ref($hook->{code}) eq 'CODE') {
 
 139       $hook->{code}->($self);
 
 141       my $sub = $hook->{code};
 
 148 # private functions -- for use in Base only
 
 154   my $sub    = "action_${action}";
 
 156   return $self->_dispatch(@_) if $action eq 'dispatch';
 
 158   $::form->error("Invalid action '${action}' for controller " . ref($self)) if !$self->can($sub);
 
 160   $self->_run_hooks('before', $action);
 
 162   $self->_run_hooks('after', $action);
 
 165 sub _controller_name {
 
 166   return (split(/::/, ref($_[0])))[-1];
 
 173   my @actions = map { s/^action_//; $_ } grep { m/^action_/ } keys %{ ref($self) . "::" };
 
 174   my $action  = first { $::form->{"action_${_}"} } @actions;
 
 175   my $sub     = "action_${action}";
 
 177   $self->_run_hooks('before', $action);
 
 179   $self->_run_hooks('after', $action);
 
 185   $self->{__basepriv_template_obj} ||=
 
 186     Template->new({ INTERPOLATE  => 0,
 
 190                     PLUGIN_BASE  => 'SL::Template::Plugin',
 
 191                     INCLUDE_PATH => '.:templates/webpages',
 
 192                     COMPILE_EXT  => '.tcc',
 
 193                     COMPILE_DIR  => $::lx_office_conf{paths}->{userspath} . '/templates-cache',
 
 196   return $self->{__basepriv_template_obj};
 
 205 SL::Controller::Base - base class for all action controllers
 
 211 This is a base class for all action controllers. Action controllers
 
 212 provide subs that are callable by special URLs.
 
 214 For each request made to the web server an instance of the controller
 
 215 will be created. After the request has been served that instance will
 
 216 handed over to garbage collection.
 
 218 This base class is derived from L<Rose::Object>.
 
 222 The URLs have the following properties:
 
 228 The script part of the URL must be C<controller.pl>.
 
 232 There must be a GET or POST parameter named C<action> containing the
 
 233 name of the controller and the sub to call separated by C</>,
 
 234 e.g. C<Message/list>.
 
 238 The controller name is the package's name without the
 
 239 C<SL::Controller::> prefix. At the moment only packages in the
 
 240 C<SL::Controller> namespace are valid; sub-namespaces are not
 
 241 allowed. The package name must start with an upper-case letter.
 
 245 The sub part of the C<action> parameter is the name of the sub to
 
 246 call. However, the sub's name is automatically prefixed with
 
 247 C<action_>. Therefore for the example C<Message/list> the sub
 
 248 C<SL::DB::Message::action_list> would be called. This in turn means
 
 249 that subs whose name does not start with C<action_> cannot be invoked
 
 250 directly via the URL.
 
 254 =head2 INDIRECT DISPATCHING
 
 256 In the case that there are several submit buttons on a page it is
 
 257 often impractical to have a single C<action> parameter match up
 
 258 properly. For such a case a special dispatcher method is available. In
 
 259 that case the C<action> parameter of the URL must be
 
 260 C<Controller/dispatch>.
 
 262 The C<SL::Controller::Base::_dispatch> method will iterate over all
 
 263 subs in the controller package whose names start with C<action_>. The
 
 264 first one for which there's a GET or POST parameter with the same name
 
 265 and that's trueish is called.
 
 267 Usage from a template usually looks like this:
 
 269   <form method="POST" action="controller.pl">
 
 271     <input type="hidden" name="action" value="Message/dispatch">
 
 272     <input type="submit" name="action_mark_as_read" value="Mark messages as read">
 
 273     <input type="submit" name="action_delete" value="Delete messages">
 
 276 The dispatching is handled by the function L</_dispatch>.
 
 280 Hooks are functions that are called before or after the controller's
 
 281 action is called. The controller package defines the hooks, and those
 
 282 hooks themselves are run as instance methods.
 
 284 Hooks are run in the order they're added.
 
 286 The return value of the hooks is discarded.
 
 288 Hooks can be defined to run for all actions, for only specific actions
 
 289 or for all actions except a list of actions. Each entry is the action
 
 290 name, not the sub's name. Therefore in order to run a hook before one
 
 291 of the subs C<action_edit> or C<action_save> is called the following
 
 294   __PACKAGE__->run_before('things_to_do_before_edit_and_save', only => [ 'edit', 'save' ]);
 
 298 =head2 PUBLIC HELPER FUNCTIONS
 
 300 These functions are supposed to be called by sub-classed controllers.
 
 304 =item C<render $template, [ $options, ] %locals>
 
 306 Renders the template C<$template>. Provides other variables than
 
 307 C<Form::parse_html_template> does.
 
 309 C<$options>, if present, must be a hash reference. All remaining
 
 310 parameters are slurped into C<%locals>.
 
 312 What is rendered and how C<$template> is interpreted is determined by
 
 313 the options I<type>, I<inline>, I<partial> and I<no_layout>.
 
 315 If C<< $options->{inline} >> is trueish then C<$template> is a string
 
 316 containing the template code to interprete. Additionally the output
 
 317 will not be sent to the browser. Instead it is only returned to the
 
 320 If C<< $options->{inline} >> is falsish then C<$template> is
 
 321 interpreted as the name of a template file. It is prefixed with
 
 322 "templates/webpages/" and postfixed with a file extension based on
 
 323 C<< $options->{type} >>. C<< $options->{type} >> can be either C<html>
 
 324 or C<js> and defaults to C<html>. An exception will be thrown if that
 
 327 If C<< $options->{partial} >> or C<< $options->{inline} >> is trueish
 
 328 then neither the HTTP response header nor the standard HTML header is
 
 331 Otherwise at least the HTTP response header will be generated based on
 
 332 the template type (C<< $options->{type} >>).
 
 334 If the template type is C<html> then the standard HTML header will be
 
 335 output via C<< $::form->header >> with C<< $::form->{title} >> set to
 
 336 C<$locals{title}> (the latter only if C<$locals{title}> is
 
 337 trueish). Setting C<< $options->{no_layout} >> to trueish will prevent
 
 340 The template itself has access to the following variables:
 
 344 =item * C<AUTH> -- C<$::auth>
 
 346 =item * C<FORM> -- C<$::form>
 
 348 =item * C<LOCALE> -- C<$::locale>
 
 350 =item * C<LXCONFIG> -- all parameters from C<config/lx_office.conf>
 
 351 with the same name they appear in the file (first level is the
 
 352 section, second the actual variable, e.g. C<system.dbcharset>,
 
 353 C<features.webdav> etc)
 
 355 =item * C<LXDEBUG> -- C<$::lxdebug>
 
 357 =item * C<MYCONFIG> -- C<%::myconfig>
 
 359 =item * C<SELF> -- the controller instance
 
 361 =item * All items from C<%locals>
 
 365 Unless C<< $options->{inline} >> is trueish the function will send the
 
 366 output to the browser.
 
 368 The function will always return the output.
 
 370 Example: Render a HTML template with a certain title and a few locals
 
 372   $self->render('todo/list',
 
 373                 title      => 'List TODO items',
 
 374                 TODO_ITEMS => SL::DB::Manager::Todo->get_all_sorted);
 
 376 Example: Render a string and return its content for further processing
 
 377 by the calling function. No header is generated due to C<inline>.
 
 379   my $content = $self->render('[% USE JavaScript %][% JavaScript.replace_with("#someid", "js/something") %]',
 
 380                               { type => 'js', inline => 1 });
 
 382 Example: Render a JavaScript template and send it to the
 
 383 browser. Typical use for actions called via AJAX:
 
 385   $self->render('todo/single_item', { type => 'js' },
 
 386                 item => $employee->most_important_todo_item);
 
 388 =item C<send_file $file_name, [%params]>
 
 390 Sends the file C<$file_name> to the browser including appropriate HTTP
 
 391 headers for a download. C<%params> can include the following:
 
 395 =item * C<type> -- the file's content type; defaults to
 
 396 'application/octet_stream'
 
 398 =item * C<name> -- the name presented to the browser; defaults to
 
 403 =item C<url_for $url>
 
 405 =item C<url_for $params>
 
 407 =item C<url_for %params>
 
 409 Creates an URL for the given parameters suitable for calling an action
 
 410 controller. If there's only one scalar parameter then it is returned
 
 413 Otherwise the parameters are given either as a single hash ref
 
 414 parameter or as a normal hash.
 
 416 The controller to call is given by C<$params{controller}>. It defaults
 
 417 to the current controller as returned by
 
 418 L</_controller_name>.
 
 420 The action to call is given by C<$params{action}>. It defaults to
 
 423 All other key/value pairs in C<%params> are appended as GET parameters
 
 426 Usage from a template might look like this:
 
 428   <a href="[% SELF.url_for(controller => 'Message', action => 'new', recipient_id => 42) %]">create new message</a>
 
 430 =item C<redirect_to %url_params>
 
 432 Redirects the browser to a new URL by outputting a HTTP redirect
 
 433 header. The URL is generated by calling L</url_for> with
 
 436 =item C<run_before $sub, %params>
 
 438 =item C<run_after $sub, %params>
 
 440 Adds a hook to run before or after certain actions are run for the
 
 441 current package. The code to run is C<$sub> which is either the name
 
 442 of an instance method or a code reference. If it's the latter then the
 
 443 first parameter will be C<$self>.
 
 445 C<%params> can contain two possible values that restrict the code to
 
 446 be run only for certain actions:
 
 450 =item C<< only => \@list >>
 
 452 Only run the code for actions given in C<@list>. The entries are the
 
 453 action names, not the names of the sub (so it's C<list> instead of
 
 456 =item C<< except => \@list >>
 
 458 Run the code for all actions but for those given in C<@list>. The
 
 459 entries are the action names, not the names of the sub (so it's
 
 460 C<list> instead of C<action_list>).
 
 464 If neither restriction is used then the code will be run for any
 
 467 The hook's return values are discarded.
 
 471 =head2 PRIVATE FUNCTIONS
 
 473 These functions are supposed to be used from this base class only.
 
 477 =item C<_controller_name>
 
 479 Returns the name of the curernt controller package without the
 
 480 C<SL::Controller::> prefix.
 
 484 Implements the method lookup for indirect dispatching mentioned in the
 
 485 section L</INDIRECT DISPATCHING>.
 
 487 =item C<_run_action $action>
 
 489 Executes a sub based on the value of C<$action>. C<$action> is the sub
 
 490 name part of the C<action> GET or POST parameter as described in
 
 493 If C<$action> equals C<dispatch> then the sub L</_dispatch> in this
 
 494 base class is called for L</INDIRECT DISPATCHING>. Otherwise
 
 495 C<$action> is prefixed with C<action_>, and that sub is called on the
 
 496 current controller instance.
 
 502 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>