SL/Controller/Base.pm

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