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 # private functions -- for use in Base only
  82 #
  83
  84 sub _run_action {
  85   my $self   = shift;
  86   my $action = "action_" . shift;
  87
  88   return $self->_dispatch(@_) if $action eq 'action_dispatch';
  89
  90   $::form->error("Invalid action ${action} for controller " . ref($self)) if !$self->can($action);
  91   $self->$action(@_);
  92 }
  93
  94 sub _controller_name {
  95   return (split(/::/, ref($_[0])))[-1];
  96 }
  97
  98 sub _dispatch {
  99   my $self    = shift;
 100
 101   no strict 'refs';
 102   my @actions = grep { m/^action_/ } keys %{ ref($self) . "::" };
 103   my $action  = first { $::form->{$_} } @actions;
 104
 105   $self->$action(@_);
 106 }
 107
 108 sub _template_obj {
 109   my ($self) = @_;
 110
 111   $self->{__basepriv_template_obj} ||=
 112     Template->new({ INTERPOLATE  => 0,
 113                     EVAL_PERL    => 0,
 114                     ABSOLUTE     => 1,
 115                     CACHE_SIZE   => 0,
 116                     PLUGIN_BASE  => 'SL::Template::Plugin',
 117                     INCLUDE_PATH => '.:templates/webpages',
 118                     COMPILE_EXT  => '.tcc',
 119                     COMPILE_DIR  => $::userspath . '/templates-cache',
 120                   }) || croak;
 121
 122   return $self->{__basepriv_template_obj};
 123 }
 124
 125 1;
 126
 127 __END__
 128
 129 =head1 NAME
 130
 131 SL::Controller::Base - base class for all action controllers
 132
 133 =head1 SYNOPSIS
 134
 135 =head2 OVERVIEW
 136
 137 This is a base class for all action controllers. Action controllers
 138 provide subs that are callable by special URLs.
 139
 140 For each request made to the web server an instance of the controller
 141 will be created. After the request has been served that instance will
 142 handed over to garbage collection.
 143
 144 This base class is derived from L<Rose::Object>.
 145
 146 =head2 CONVENTIONS
 147
 148 The URLs have the following properties:
 149
 150 =over 2
 151
 152 =item *
 153
 154 The script part of the URL must be C<controller.pl>.
 155
 156 =item *
 157
 158 There must be a GET or POST parameter named C<action> containing the
 159 name of the controller and the sub to call separated by C</>,
 160 e.g. C<Message/list>.
 161
 162 =item *
 163
 164 The controller name is the package's name without the
 165 C<SL::Controller::> prefix. At the moment only packages in the
 166 C<SL::Controller> namespace are valid; sub-namespaces are not
 167 allowed. The package name must start with an upper-case letter.
 168
 169 =item *
 170
 171 The sub part of the C<action> parameter is the name of the sub to
 172 call. However, the sub's name is automatically prefixed with
 173 C<action_>. Therefore for the example C<Message/list> the sub
 174 C<SL::DB::Message::action_list> would be called. This in turn means
 175 that subs whose name does not start with C<action_> cannot be invoked
 176 directly via the URL.
 177
 178 =back
 179
 180 =head2 INDIRECT DISPATCHING
 181
 182 In the case that there are several submit buttons on a page it is
 183 often impractical to have a single C<action> parameter match up
 184 properly. For such a case a special dispatcher method is available. In
 185 that case the C<action> parameter of the URL must be
 186 C<Controller/dispatch>.
 187
 188 The C<SL::Controller::Base::_dispatch> method will iterate over all
 189 subs in the controller package whose names start with C<action_>. The
 190 first one for which there's a GET or POST parameter with the same name
 191 and that's trueish is called.
 192
 193 Usage from a template usually looks like this:
 194
 195   <form method="POST" action="controller.pl">
 196     ...
 197     <input type="hidden" name="action" value="Message/dispatch">
 198     <input type="submit" name="action_mark_as_read" value="Mark messages as read">
 199     <input type="submit" name="action_delete" value="Delete messages">
 200   </form>
 201
 202 The dispatching is handled by the function L</_dispatch>.
 203
 204 =head1 FUNCTIONS
 205
 206 =head2 PUBLIC HELPER FUNCTIONS
 207
 208 These functions are supposed to be called by sub-classed controllers.
 209
 210 =over 4
 211
 212 =item C<render $template, [ $options, ] %locals>
 213
 214 Renders the template C<$template>. Provides other variables than
 215 C<Form::parse_html_template> does.
 216
 217 C<$options>, if present, must be a hash reference. All remaining
 218 parameters are slurped into C<%locals>.
 219
 220 What is rendered and how C<$template> is interpreted is determined by
 221 C<< $options->{inline} >> and C<< $options->{partial} >>.
 222
 223 If C<< $options->{inline} >> is trueish then C<$template> is a string
 224 containing the template code to interprete. Additionally the output
 225 will not be sent to the browser. Instead it is only returned to the
 226 caller.
 227
 228 If C<< $options->{inline} >> is falsish then C<$template> is
 229 interpreted as the name of a template file. It is prefixed with
 230 "templates/webpages/" and postfixed with ".html". An exception will be
 231 thrown if that file does not exist.
 232
 233 If C<< $options->{partial} >> or C<< $options->{inline} }} is trueish
 234 then C<< $::form->header >> will not be called. Otherwise
 235 C<< $::form->{header} >> will be set to C<$locals{header}> (only if
 236 $locals{header} is trueish) and C<< $::form->header >> will be called
 237 before the template itself is processed.
 238
 239 The template itself has access to the following variables:
 240
 241 =over 2
 242
 243 =item * C<AUTH> -- C<$::auth>
 244
 245 =item * C<FORM> -- C<$::form>
 246
 247 =item * C<LOCALE> -- C<$::locale>
 248
 249 =item * C<LXCONFIG> -- all parameters from C<config/lx-erp.conf> with
 250 the same name they appear in the file (e.g. C<dbcharset>, C<webdav>
 251 etc)
 252
 253 =item * C<LXDEBUG> -- C<$::lxdebug>
 254
 255 =item * C<MYCONFIG> -- C<%::myconfig>
 256
 257 =item * C<SELF> -- the controller instance
 258
 259 =item * All items from C<%locals>
 260
 261 =back
 262
 263 Unless C<< $options->{inline} >> is trueish the function will send the
 264 output to the browser.
 265
 266 The function will always return the output.
 267
 268 =item C<url_for $url>
 269
 270 =item C<url_for $params>
 271
 272 =item C<url_for %params>
 273
 274 Creates an URL for the given parameters suitable for calling an action
 275 controller. If there's only one scalar parameter then it is returned
 276 verbatim.
 277
 278 Otherwise the parameters are given either as a single hash ref
 279 parameter or as a normal hash.
 280
 281 The controller to call is given by C<$params{controller}>. It defaults
 282 to the current controller as returned by
 283 L</_controller_name>.
 284
 285 The action to call is given by C<$params{action}>. It defaults to
 286 C<dispatch>.
 287
 288 All other key/value pairs in C<%params> are appended as GET parameters
 289 to the URL.
 290
 291 Usage from a template might look like this:
 292
 293   <a href="[% SELF.url_for(controller => 'Message', action => 'new', recipient_id => 42) %]">create new message</a>
 294
 295 =item redirect_to %url_params
 296
 297 Redirects the browser to a new URL by outputting a HTTP redirect
 298 header. The URL is generated by calling L</url_for> with
 299 C<%url_params>.
 300
 301 =back
 302
 303 =head2 PRIVATE FUNCTIONS
 304
 305 These functions are supposed to be used from this base class only.
 306
 307 =over 4
 308
 309 =item C<_controller_name>
 310
 311 Returns the name of the curernt controller package without the
 312 C<SL::Controller::> prefix.
 313
 314 =item C<_dispatch>
 315
 316 Implements the method lookup for indirect dispatching mentioned in the
 317 section L</INDIRECT DISPATCHING>.
 318
 319 =item C<_run_action $action>
 320
 321 Executes a sub based on the value of C<$action>. C<$action> is the sub
 322 name part of the C<action> GET or POST parameter as described in
 323 L</CONVENTIONS>.
 324
 325 If C<$action> equals C<dispatch> then the sub L</_dispatch> in this
 326 base class is called for L</INDIRECT DISPATCHING>. Otherwise
 327 C<$action> is prefixed with C<action_>, and that sub is called on the
 328 current controller instance.
 329
 330 =back
 331
 332 =head1 AUTHOR
 333
 334 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 335
 336 =cut