Neuer Routingmechanismus für Controller, die als Package implementiert sind

Voraussetzungen:

* Controller liegt in SL/Controller/Class.pm und ist von
SL::Controller::Base abgeleitet.

* Der Name von Subs, die als Action aufgerufen werden sollen, muss mit
"action_" beginnen. Alle Versuche, andere (auch existierende) Subs
aufzurufen, werden entsprechend mit Fehlermeldungen quittiert.

* Pro Request wird eine Instanz der Klasse erzeugt und danach vom
garbage collector entsorgt.

* Im Controller "$self->parse_html_template()" verwenden, dann ist im
Template $self als SELF verfügbar, z.B. "[% FOREACH message =
SELF.messages %]".

* Form-Parameter "action" muss das Format "Controller::action"
besitzen. "Controller" ist der Packagename ohne die Präfixe, sprich
der Basisdateiname. "action" ist der Name der aufzurufenden Sub ohne
das "action_"-Präfix. Aus "Message::list" würde also grob gesehen
"SL::Controller::Message->new->action_list()".

* Das Script in der URL muss 'controller.pl' heißen.

Conflicts:

	SL/Dispatcher.pm
	scripts/locales.pl

diff --git a/SL/Controller/Base.pm b/SL/Controller/Base.pm
new file mode 100644 (file)
index 0000000..06fd7fb
--- /dev/null
+++ b/SL/Controller/Base.pm
@@ -0,0 +1,51 @@
+package SL::Controller::Base;
+
+use parent qw(Rose::Object);
+
+use List::Util qw(first);
+
+sub parse_html_template {
+  my $self = shift;
+  my $name = shift;
+
+  return $::form->parse_html_template($name, { @_, SELF => $self });
+}
+
+sub url_for {
+  my $self = shift;
+
+  return $_[0] if scalar(@_) == 1;
+
+  my %params      = @_;
+  my $controller  = delete($params{controller}) || $self->_controller_name;
+  my $action      = delete($params{action})     || 'dispatch';
+  $params{action} = "${controller}::${action}";
+  my $query       = join('&', map { $::form->escape($_) . '=' . $::form->escape($params{$_}) } keys %params);
+
+  return "controller.pl?${query}";
+}
+
+sub _run_action {
+  my $self   = shift;
+  my $action = "action_" . shift;
+
+  return $self->_dispatch(@_) if $action eq 'action_dispatch';
+
+  $::form->error("Invalid action ${action} for controller " . ref($self)) if !$self->can($action);
+  $self->$action(@_);
+}
+
+sub _controller_name {
+  return (split(/::/, ref($_[0])))[-1];
+}
+
+sub _dispatch {
+  my $self    = shift;
+
+  my @actions = grep { m/^action_/ } keys %{ ref($self) . "::" };
+  my $action  = first { $::form->{$_} } @actions;
+
+  $self->$action(@_);
+}
+
+1;

diff --git a/SL/Dispatcher.pm b/SL/Dispatcher.pm
index 013dfe6077a53568bba1f092eb319f5f512b2d78..c412f64224ab168b1dea603a4f275eeeb2c339cd 100644 (file)
--- a/SL/Dispatcher.pm
+++ b/SL/Dispatcher.pm
@@ -123,12 +123,26 @@ sub require_main_code {
   $::lxdebug->leave_sub;
 }
 
   $::lxdebug->leave_sub;
 }
 

+sub _require_controller {
+  my $controller =  shift;
+  $controller    =~ s|[^A-Za-z0-9_]||g;
+
+  eval {
+    package main;
+    require "SL/Controller/${controller}.pm";
+  } or die $EVAL_ERROR;
+}
+
+sub _run_controller {
+  "SL::Controller::$_[0]"->new->_run_action($_[1]);
+}
+

 sub handle_request {
   $::lxdebug->enter_sub;
   $::lxdebug->begin_request;
 
   my $interface = lc(shift || 'cgi');
 sub handle_request {
   $::lxdebug->enter_sub;
   $::lxdebug->begin_request;
 
   my $interface = lc(shift || 'cgi');

-  my ($script_name, $action);
+  my ($script, $path, $suffix, $script_name, $action, $routing_type);

 
   $script_name = $ENV{SCRIPT_NAME};
 
 
   $script_name = $ENV{SCRIPT_NAME};
 


@@ -139,12 +153,21 @@ sub handle_request {
   $::form        = Form->new;
   %::called_subs = ();
 
   $::form        = Form->new;
   %::called_subs = ();
 

-  eval { ($script_name, $action) = _route_request($script_name); 1; } or return;
+  eval { ($routing_type, $script_name, $action) = _route_request($script_name); 1; } or return;

 
 

-  my ($script, $path, $suffix) = fileparse($script_name, ".pl");
-  require_main_code($script, $suffix);
+  if ($routing_type eq 'old') {
+    $::form->{action}  =  lc $::form->{action};
+    $::form->{action}  =~ s/( |-|,|\#)/_/g;

 
 

-  $::form->{script} = $script . $suffix;
+   ($script, $path, $suffix) = fileparse($script_name, ".pl");
+    require_main_code($script, $suffix);
+
+    $::form->{script} = $script . $suffix;
+
+  } else {
+    _require_controller($script_name);
+    $::form->{script} = "controller.pl";
+  }

 
   pre_request_checks();
 
 
   pre_request_checks();
 


@@ -178,7 +201,11 @@ sub handle_request {
           unless $action eq 'save' && $::form->{type} eq 'preferences';
 
         $::form->set_standard_title;
           unless $action eq 'save' && $::form->{type} eq 'preferences';
 
         $::form->set_standard_title;

-        ::call_sub('::' . $::locale->findsub($action));
+        if ($routing_type eq 'old') {
+          ::call_sub('::' . $::locale->findsub($action));
+        } else {
+          _run_controller($script_name, $action);
+        }

       } else {
         $::form->error($::locale->text('action= not defined!'));
       }
       } else {
         $::form->error($::locale->text('action= not defined!'));
       }


@@ -216,7 +243,9 @@ sub unrequire_bin_mozilla {
 sub _route_request {
   my $script_name = shift;
 
 sub _route_request {
   my $script_name = shift;
 

-  return $script_name =~ m/dispatcher\.pl$/ ? _route_dispatcher_request() : ($script_name, $::form->{action});
+  return $script_name =~ m/dispatcher\.pl$/ ? ('old',        _route_dispatcher_request())
+       : $script_name =~ m/controller\.pl/  ? ('controller', _route_controller_request())
+       :                                      ('old',        $script_name, $::form->{action});

 }
 
 sub _route_dispatcher_request {
 }
 
 sub _route_dispatcher_request {


@@ -249,6 +278,23 @@ sub _route_dispatcher_request {
   return ($script_name, $action);
 }
 
   return ($script_name, $action);
 }
 

+sub _route_controller_request {
+  my ($controller, $action);
+
+  eval {
+    $::form->{action}      =~ m|^ ( [A-Z] [A-Za-z0-9_]* ) :: ( [a-z] [a-z0-9_]* ) $|x || die "Unroutable request -- inavlid controller/action.\n";
+    ($controller, $action) =  ($1, $2);
+    delete $::form->{action};
+
+    1;
+  } or do {
+    $::form->{label_error} = $::cgi->pre($EVAL_ERROR);
+    show_error('generic/error');
+  };
+
+  return ($controller, $action);
+}
+

 package main;
 
 use strict;
 package main;
 
 use strict;

diff --git a/SL/Form.pm b/SL/Form.pm
index 6785c3ace1ba71284aabaab7ff799dddb016e49c..e2a484ed16da5e9cc0109b42020e038712315096 100644 (file)
--- a/SL/Form.pm
+++ b/SL/Form.pm
@@ -263,9 +263,6 @@ sub new {
 
   _recode_recursively(SL::Iconv->new($encoding, $db_charset), $self);
 
 
   _recode_recursively(SL::Iconv->new($encoding, $db_charset), $self);
 

-  $self->{action}  =  lc $self->{action};
-  $self->{action}  =~ s/( |-|,|\#)/_/g;
-

   #$self->{version} =  "2.6.1";                 # Old hardcoded but secure style
   open VERSION_FILE, "VERSION";                 # New but flexible code reads version from VERSION-file
   $self->{version} =  <VERSION_FILE>;
   #$self->{version} =  "2.6.1";                 # Old hardcoded but secure style
   open VERSION_FILE, "VERSION";                 # New but flexible code reads version from VERSION-file
   $self->{version} =  <VERSION_FILE>;

diff --git a/scripts/locales.pl b/scripts/locales.pl
index 16f2b3e850062defe8fed3f83b84b7eb5b2eefff..a5ec52fdc5c11a1937f2974eda45356338f10959 100755 (executable)
--- a/scripts/locales.pl
+++ b/scripts/locales.pl
@@ -31,7 +31,7 @@ parse_args();
 my $basedir      = "../..";
 my $locales_dir  = ".";
 my $bindir       = "$basedir/bin/mozilla";
 my $basedir      = "../..";
 my $locales_dir  = ".";
 my $bindir       = "$basedir/bin/mozilla";

-my @progdirs     = ( "$basedir/SL/Template/Plugin" );
+my @progdirs     = ( "$basedir/SL/Controller", "$basedir/SL/Template/Plugin" );

 my $dbupdir      = "$basedir/sql/Pg-upgrade";
 my $dbupdir2     = "$basedir/sql/Pg-upgrade2";
 my $menufile     = "menu.ini";
 my $dbupdir      = "$basedir/sql/Pg-upgrade";
 my $dbupdir2     = "$basedir/sql/Pg-upgrade2";
 my $menufile     = "menu.ini";