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