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