SL/Controller/Base.pm

   1 package SL::Controller::Base;
   2
   3 use parent qw(Rose::Object);
   4
   5 use List::Util qw(first);
   6
   7 #
   8 # public/helper functions
   9 #
  10
  11 sub parse_html_template {
  12   my $self   = shift;
  13   my $name   = shift;
  14   my $locals = shift || {};
  15
  16   return $::form->parse_html_template($name, { %{ $locals }, SELF => $self });
  17 }
  18
  19 sub url_for {
  20   my $self = shift;
  21
  22   return $_[0] if (scalar(@_) == 1) && !ref($_[0]);
  23
  24   my %params      = ref($_[0]) eq 'HASH' ? %{ $_[0] } : @_;
  25   my $controller  = delete($params{controller}) || $self->_controller_name;
  26   my $action      = delete($params{action})     || 'dispatch';
  27   $params{action} = "${controller}/${action}";
  28   my $query       = join('&', map { $::form->escape($_) . '=' . $::form->escape($params{$_}) } keys %params);
  29
  30   return "controller.pl?${query}";
  31 }
  32
  33 sub redirect_to {
  34   my $self = shift;
  35   my $url  = $self->url_for(@_);
  36
  37   print $::cgi->redirect($url);
  38 }
  39
  40 sub render {
  41   my $self = shift;
  42
  43   my $template;
  44   $template  = shift if scalar(@_) % 2;
  45   my %params = @_;
  46
  47   if ($params{title}) {
  48     $::form->{title} = delete $params{title};
  49     $::form->header;
  50   }
  51
  52   print $self->parse_html_template($template, $params{locals});
  53 }
  54
  55 #
  56 # private functions -- for use in Base only
  57 #
  58
  59 sub _run_action {
  60   my $self   = shift;
  61   my $action = "action_" . shift;
  62
  63   return $self->_dispatch(@_) if $action eq 'action_dispatch';
  64
  65   $::form->error("Invalid action ${action} for controller " . ref($self)) if !$self->can($action);
  66   $self->$action(@_);
  67 }
  68
  69 sub _controller_name {
  70   return (split(/::/, ref($_[0])))[-1];
  71 }
  72
  73 sub _dispatch {
  74   my $self    = shift;
  75
  76   my @actions = grep { m/^action_/ } keys %{ ref($self) . "::" };
  77   my $action  = first { $::form->{$_} } @actions;
  78
  79   $self->$action(@_);
  80 }
  81
  82 1;
  83
  84 __END__
  85
  86 =head1 NAME
  87
  88 SL::Controller::Base - base class for all action controllers
  89
  90 =head1 SYNOPSIS
  91
  92 =head2 OVERVIEW
  93
  94 This is a base class for all action controllers. Action controllers
  95 provide subs that are callable by special URLs.
  96
  97 For each request made to the web server an instance of the controller
  98 will be created. After the request has been served that instance will
  99 handed over to garbage collection.
 100
 101 This base class is derived from L<Rose::Object>.
 102
 103 =head2 CONVENTIONS
 104
 105 The URLs have the following properties:
 106
 107 =over 2
 108
 109 =item *
 110
 111 The script part of the URL must be C<controller.pl>.
 112
 113 =item *
 114
 115 There must be a GET or POST parameter named C<action> containing the
 116 name of the controller and the sub to call separated by C</>,
 117 e.g. C<Message/list>.
 118
 119 =item *
 120
 121 The controller name is the package's name without the
 122 C<SL::Controller::> prefix. At the moment only packages in the
 123 C<SL::Controller> namespace are valid; sub-namespaces are not
 124 allowed. The package name must start with an upper-case letter.
 125
 126 =item *
 127
 128 The sub part of the C<action> parameter is the name of the sub to
 129 call. However, the sub's name is automatically prefixed with
 130 C<action_>. Therefore for the example C<Message/list> the sub
 131 C<SL::DB::Message::action_list> would be called. This in turn means
 132 that subs whose name does not start with C<action_> cannot be invoked
 133 directly via the URL.
 134
 135 =back
 136
 137 =head2 INDIRECT DISPATCHING
 138
 139 In the case that there are several submit buttons on a page it is
 140 often impractical to have a single C<action> parameter match up
 141 properly. For such a case a special dispatcher method is available. In
 142 that case the C<action> parameter of the URL must be
 143 C<Controller/dispatch>.
 144
 145 The C<SL::Controller::Base::_dispatch> method will iterate over all
 146 subs in the controller package whose names start with C<action_>. The
 147 first one for which there's a GET or POST parameter with the same name
 148 and that's trueish is called.
 149
 150 Usage from a template usually looks like this:
 151
 152   <form method="POST" action="controller.pl">
 153     ...
 154     <input type="hidden" name="action" value="Message/dispatch">
 155     <input type="submit" name="action_mark_as_read" value="Mark messages as read">
 156     <input type="submit" name="action_delete" value="Delete messages">
 157   </form>
 158
 159 The dispatching is handled by the function L</_dispatch>.
 160
 161 =head1 FUNCTIONS
 162
 163 =head2 PUBLIC HELPER FUNCTIONS
 164
 165 These functions are supposed to be called by sub-classed controllers.
 166
 167 =over 4
 168
 169 =item C<parse_html_template $file_name, $local_variables>
 170
 171 Outputs an HTML template. It is a thin wrapper around
 172 C<Form::parse_html_template> which also adds the current object as the
 173 template variable C<SELF>.
 174
 175 =item C<render $template, %params>
 176
 177 Renders the template C<$template> by calling
 178 L</parse_html_template>. C<$params{locals}> will be used as the second
 179 parameter to L</parse_html_template>.
 180
 181 If C<$params{title}> is trueish then the function also sets
 182 C<< $::form->{header} >> to that value and calls C<< $::form->header >>.
 183
 184 =item C<url_for $url>
 185
 186 =item C<url_for $params>
 187
 188 =item C<url_for %params>
 189
 190 Creates an URL for the given parameters suitable for calling an action
 191 controller. If there's only one scalar parameter then it is returned
 192 verbatim.
 193
 194 Otherwise the parameters are given either as a single hash ref
 195 parameter or as a normal hash.
 196
 197 The controller to call is given by C<$params{controller}>. It defaults
 198 to the current controller as returned by
 199 L</_controller_name>.
 200
 201 The action to call is given by C<$params{action}>. It defaults to
 202 C<dispatch>.
 203
 204 All other key/value pairs in C<%params> are appended as GET parameters
 205 to the URL.
 206
 207 Usage from a template might look like this:
 208
 209   <a href="[% SELF.url_for(controller => 'Message', action => 'new', recipient_id => 42) %]">create new message</a>
 210
 211 =item redirect_to %url_params
 212
 213 Redirects the browser to a new URL by outputting a HTTP redirect
 214 header. The URL is generated by calling L</url_for> with
 215 C<%url_params>.
 216
 217 =back
 218
 219 =head2 PRIVATE FUNCTIONS
 220
 221 These functions are supposed to be used from this base class only.
 222
 223 =over 4
 224
 225 =item C<_controller_name>
 226
 227 Returns the name of the curernt controller package without the
 228 C<SL::Controller::> prefix.
 229
 230 =item C<_dispatch>
 231
 232 Implements the method lookup for indirect dispatching mentioned in the
 233 section L</INDIRECT DISPATCHING>.
 234
 235 =item C<_run_action $action>
 236
 237 Executes a sub based on the value of C<$action>. C<$action> is the sub
 238 name part of the C<action> GET or POST parameter as described in
 239 L</CONVENTIONS>.
 240
 241 If C<$action> equals C<dispatch> then the sub L</_dispatch> in this
 242 base class is called for L</INDIRECT DISPATCHING>. Otherwise
 243 C<$action> is prefixed with C<action_>, and that sub is called on the
 244 current controller instance.
 245
 246 =back
 247
 248 =head1 AUTHOR
 249
 250 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 251
 252 =cut