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