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