Revision 7a604472
Von Moritz Bunkus vor mehr als 14 Jahren hinzugefügt
| SL/Dispatcher.pm | ||
|---|---|---|
| 15 | 15 |
use SL::Locale; |
| 16 | 16 |
use SL::Common; |
| 17 | 17 |
use Form; |
| 18 |
use List::Util qw(first); |
|
| 18 | 19 |
use Moose; |
| 19 | 20 |
use Rose::DB; |
| 20 | 21 |
use Rose::DB::Object; |
| ... | ... | |
| 114 | 115 |
$::lxdebug->begin_request; |
| 115 | 116 |
|
| 116 | 117 |
my $interface = lc(shift || 'cgi'); |
| 117 |
my $script_name;
|
|
| 118 |
my ($script_name, $action);
|
|
| 118 | 119 |
|
| 119 | 120 |
if ($interface =~ m/^(?:fastcgi|fcgid|fcgi)$/) {
|
| 120 | 121 |
$script_name = $ENV{SCRIPT_NAME};
|
| ... | ... | |
| 124 | 125 |
$script_name = $0; |
| 125 | 126 |
} |
| 126 | 127 |
|
| 128 |
$::cgi = CGI->new('');
|
|
| 129 |
$::locale = Locale->new($::language); |
|
| 130 |
$::form = Form->new; |
|
| 131 |
|
|
| 132 |
eval { ($script_name, $action) = _route_request($script_name); 1; } or return;
|
|
| 133 |
|
|
| 127 | 134 |
my ($script, $path, $suffix) = fileparse($script_name, ".pl"); |
| 128 | 135 |
require_main_code($script, $suffix); |
| 129 | 136 |
|
| 130 |
$::cgi = CGI->new('');
|
|
| 131 |
$::locale = Locale->new($::language); |
|
| 132 |
$::form = Form->new; |
|
| 133 | 137 |
$::form->{script} = $script . $suffix;
|
| 134 | 138 |
|
| 135 | 139 |
pre_request_checks(); |
| ... | ... | |
| 139 | 143 |
$::form->{titlebar} = "Lx-Office " . $::locale->text('Version') . " $::form->{version}";
|
| 140 | 144 |
::run($::auth->restore_session); |
| 141 | 145 |
|
| 142 |
} elsif ($::form->{action}) {
|
|
| 146 |
} elsif ($action) {
|
|
| 143 | 147 |
# copy from am.pl routines |
| 144 | 148 |
$::form->error($::locale->text('System currently down for maintenance!')) if -e "$main::userspath/nologin" && $script ne 'admin';
|
| 145 | 149 |
|
| ... | ... | |
| 159 | 163 |
delete $::form->{password};
|
| 160 | 164 |
|
| 161 | 165 |
map { $::form->{$_} = $::myconfig{$_} } qw(stylesheet charset)
|
| 162 |
unless $::form->{action} eq 'save' && $::form->{type} eq 'preferences';
|
|
| 166 |
unless $action eq 'save' && $::form->{type} eq 'preferences';
|
|
| 163 | 167 |
|
| 164 | 168 |
$::form->set_standard_title; |
| 165 |
::call_sub('::' . $::locale->findsub($::form->{action}));
|
|
| 169 |
::call_sub('::' . $::locale->findsub($action));
|
|
| 166 | 170 |
|
| 167 | 171 |
} else {
|
| 168 | 172 |
$::form->error($::locale->text('action= not defined!'));
|
| ... | ... | |
| 195 | 199 |
} |
| 196 | 200 |
} |
| 197 | 201 |
|
| 202 |
sub _route_request {
|
|
| 203 |
my $script_name = shift; |
|
| 204 |
|
|
| 205 |
return $script_name =~ m/dispatcher\.pl$/ ? _route_dispatcher_request() : ($script_name, $::form->{action});
|
|
| 206 |
} |
|
| 207 |
|
|
| 208 |
sub _route_dispatcher_request {
|
|
| 209 |
my $action_re = '[a-z0-9_\-]+'; |
|
| 210 |
my ($script_name, $action); |
|
| 211 |
|
|
| 212 |
eval {
|
|
| 213 |
die "Unroutable request -- inavlid module name.\n" if !$::form->{M} || ($::form->{M} !~ m/^$action_re$/);
|
|
| 214 |
$script_name = $::form->{M} . '.pl';
|
|
| 215 |
|
|
| 216 |
if ($::form->{A}) {
|
|
| 217 |
$action = $::form->{A};
|
|
| 218 |
|
|
| 219 |
} else {
|
|
| 220 |
$action = first { m/^A_${action_re}$/ } keys %{ $::form };
|
|
| 221 |
die "Unroutable request -- inavlid action name.\n" if !$action; |
|
| 222 |
|
|
| 223 |
delete $::form->{$action};
|
|
| 224 |
$action = substr $action, 2; |
|
| 225 |
} |
|
| 226 |
|
|
| 227 |
delete @{$::form}{qw(M A)};
|
|
| 228 |
|
|
| 229 |
1; |
|
| 230 |
} or do {
|
|
| 231 |
$::form->{label_error} = $::cgi->pre($EVAL_ERROR);
|
|
| 232 |
show_error('generic/error');
|
|
| 233 |
}; |
|
| 234 |
|
|
| 235 |
return ($script_name, $action); |
|
| 236 |
} |
|
| 237 |
|
|
| 198 | 238 |
package main; |
| 199 | 239 |
|
| 200 | 240 |
use strict; |
Auch abrufbar als: Unified diff
Routingmechanismus mit Scriptname dispatcher.pl und Parametern 'M' und 'A' oder 'A_...' implementiert