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