X-Git-Url: http://wagnertech.de/gitweb/gitweb.cgi/mfinanz.git/blobdiff_plain/0dd879bc05be0e63a11dac93ec8134e7ac034c41..e97c628d0f75459a88926c33e4b370aa98c6b680:/SL/Menu.pm diff --git a/SL/Menu.pm b/SL/Menu.pm index 81eedb1a8..eac4e2fe6 100644 --- a/SL/Menu.pm +++ b/SL/Menu.pm @@ -37,11 +37,20 @@ package Menu; use SL::Auth; use SL::Inifile; +use strict; + +my $instance; + sub new { $main::lxdebug->enter_sub(); my ($type, $menufile) = @_; + if ($instance) { + $::lxdebug->leave_sub; + return $instance; + } + my $self = {}; my $inifile = Inifile->new($menufile); @@ -53,36 +62,29 @@ sub new { $main::lxdebug->leave_sub(); - return $self; + return $instance = $self; } -sub menuitem { - $main::lxdebug->enter_sub(); - +sub menuitem_js { my ($self, $myconfig, $form, $item) = @_; my $module = $form->{script}; my $action = "section_menu"; - my $target = ""; - if ($self->{$item}{module}) { - $module = $self->{$item}{module}; - } + #if ($self->{$item}{module}) { + $module = $self->{$item}{module}; + + #} if ($self->{$item}{action}) { $action = $self->{$item}{action}; } - if ($self->{$item}{target}) { - $target = $self->{$item}{target}; - } my $level = $form->escape($item); - - my $str = qq|{$item}{href}) { - $str = qq|{$item}{href}|; + $str = qq|$self->{$item}{href}|; @vars = qw(module target href); } @@ -91,20 +93,13 @@ sub menuitem { # add other params foreach my $key (keys %{ $self->{$item} }) { $str .= "&" . $form->escape($key, 1) . "="; - ($value, $conf) = split(/=/, $self->{$item}{$key}, 2); + my ($value, $conf) = split(/=/, $self->{$item}{$key}, 2); $value = $myconfig->{$value} . "/$conf" if ($conf); $str .= $form->escape($value, 1); } - if ($target) { - $str .= qq| target=$target|; - } + $str .= " "; - $str .= ">"; - - $main::lxdebug->leave_sub(); - - return $str; } sub menuitem_new { @@ -112,7 +107,8 @@ sub menuitem_new { my ($self, $name, $item) = @_; - my $form = $main::form; + my $form = $main::form; + my $myconfig = \%main::myconfig; my $module = $self->{$name}->{module} || $form->{script}; my $action = $self->{$name}->{action}; @@ -170,7 +166,7 @@ sub menuitem_v3 { # add other params foreach my $key (keys %{ $self->{$item} }) { $str .= "&" . $form->escape($key, 1) . "="; - ($value, $conf) = split(/=/, $self->{$item}{$key}, 2); + my ($value, $conf) = split(/=/, $self->{$item}{$key}, 2); $value = $myconfig->{$value} . "/$conf" if ($conf); $str .= $form->escape($value, 1); } @@ -230,7 +226,7 @@ sub menuitem_XML { # add other params foreach my $key (keys %{ $self->{$item} }) { $str .= "&" . $form->escape($key, 1) . "="; - ($value, $conf) = split(/=/, $self->{$item}{$key}, 2); + my ($value, $conf) = split(/=/, $self->{$item}{$key}, 2); $value = $myconfig->{$value} . "/$conf" if ($conf); $str .= $form->escape($value, 1); } @@ -274,6 +270,10 @@ sub parse_access_string { my $key = shift; my $access = shift; + my $form = $main::form; + my $auth = $main::auth; + my $myconfig = \%main::myconfig; + my @stack; my $cur_ary = []; @@ -294,7 +294,7 @@ sub parse_access_string { } elsif ($token eq ")") { pop @stack; if (!@stack) { - $main::form->error("Error in menu.ini for entry ${key}: missing '('"); + $form->error("Error in menu.ini for entry ${key}: missing '('"); } $cur_ary = $stack[-1]; @@ -302,16 +302,16 @@ sub parse_access_string { push @{$cur_ary}, $token; } else { - push @{$cur_ary}, $main::auth->check_right($main::form->{login}, $token, 1); + push @{$cur_ary}, $auth->check_right($form->{login}, $token, 1); } } if ($access) { - $main::form->error("Error in menu.ini for entry ${name}: unrecognized token at the start of '$access'\n"); + $form->error("Error in menu.ini for entry ${key}: unrecognized token at the start of '$access'\n"); } if (1 < scalar @stack) { - $main::form->error("Error in menu.ini for entry ${name}: Missing ')'\n"); + $main::form->error("Error in menu.ini for entry ${key}: Missing ')'\n"); } return SL::Auth::evaluate_rights_ary($stack[0]); @@ -356,7 +356,10 @@ sub set_access { $self->{ORDER} = [ grep { $self->{$_}->{VISIBLE} } @{ $self->{ORDER} } ]; + { no strict 'refs'; + # ToDO: fix this. nuke and pave algorithm without type checking screams for problems. map { delete @{$self->{$_}}{qw(GRANTED IS_MENU NUM_VISIBLE_CHILDREN VISIBLE ACCESS)} if ($_ ne 'ORDER') } keys %{ $self }; + } } sub dump_visible {