X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FMenu.pm;h=06ea6ee43ed44c04b21459694f7e7ebce836b05b;hb=fb03d191f53516cbf1022e755665556e7f1acb82;hp=7abab0d6a432f8aa7eb157fa5aef39123892ada3;hpb=d46070343706247c7365968e4ab7783aec361c03;p=kivitendo-erp.git diff --git a/SL/Menu.pm b/SL/Menu.pm index 7abab0d6a..06ea6ee43 100644 --- a/SL/Menu.pm +++ b/SL/Menu.pm @@ -37,227 +37,59 @@ package Menu; use SL::Auth; use SL::Inifile; -sub new { - $main::lxdebug->enter_sub(); - - my ($type, $menufile) = @_; - - my $self = {}; - my $inifile = Inifile->new($menufile); - - map { $self->{$_} = $inifile->{$_} } keys %{ $inifile }; - - bless $self, $type; - - $self->set_access(); - - $main::lxdebug->leave_sub(); - - return $self; -} - -sub menuitem { - $main::lxdebug->enter_sub(); - - 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}{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}|; - @vars = qw(module target href); - } - - map { delete $self->{$item}{$_} } @vars; - - # add other params - foreach my $key (keys %{ $self->{$item} }) { - $str .= "&" . $form->escape($key, 1) . "="; - ($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 .= ">"; - - $main::lxdebug->leave_sub(); - - return $str; -} - -sub menuitem_v3 { - $main::lxdebug->enter_sub(); - - my ($self, $myconfig, $form, $item, $other) = @_; - - my $module = $form->{script}; - my $action = "section_menu"; - my $target = ""; - - 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|escape($key, 1) . "="; - ($value, $conf) = split(/=/, $self->{$item}{$key}, 2); - $value = $myconfig->{$value} . "/$conf" if ($conf); - $str .= $form->escape($value, 1); - } - - $str .= '"'; - - if ($target) { - $str .= qq| target="| . $form->quote($target) . qq|"|; - } - - if ($other) { - foreach my $key (keys(%{$other})) { - $str .= qq| ${key}="| . $form->quote($other->{$key}) . qq|"|; - } - } - - $str .= ">"; - - $main::lxdebug->leave_sub(); - - return $str; -} - -sub menuitem_XML { +sub new { $main::lxdebug->enter_sub(); - my ($self, $myconfig, $form, $item, $other) = @_; - - my $module = $form->{script}; - my $action = "section_menu"; - my $target = ""; - - 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 ($type, @menufiles) = @_; + my $self = bless {}, $type; - my $level = $form->escape($item); + my @order; - my $str = qq| link="$module?action=| . $form->escape($action) . - qq|&level=| . $form->escape($level); + foreach my $menufile (grep { -f } @menufiles) { + my $inifile = Inifile->new($menufile); - my @vars = qw(module action target href); - - if ($self->{$item}{href}) { - $str = qq| link=$self->{$item}{href}|; - @vars = qw(module target href); + push @order, @{ delete($inifile->{ORDER}) || [] }; + $self->{$_} = $inifile->{$_} for keys %{ $inifile }; } - map { delete $self->{$item}{$_} } @vars; - - # add other params - foreach my $key (keys %{ $self->{$item} }) { - $str .= "&" . $form->escape($key, 1) . "="; - ($value, $conf) = split(/=/, $self->{$item}{$key}, 2); - $value = $myconfig->{$value} . "/$conf" if ($conf); - $str .= $form->escape($value, 1); - } - - $str .= '"'; - - - - if ($other) { - foreach my $key (keys(%{$other})) { - $str .= qq| ${key}="| . $form->quote($other->{$key}) . qq|"|; - } - } + $self->{ORDER} = \@order; + $self->set_access(); $main::lxdebug->leave_sub(); - return $str; + return $self; } -sub menuitemNew { - my ($self, $myconfig, $form, $item) = @_; +sub menuitem_new { + $main::lxdebug->enter_sub(LXDebug::DEBUG2()); - my $module = $form->{script}; - my $action = "section_menu"; + my ($self, $name, $item) = @_; - #if ($self->{$item}{module}) { - $module = $self->{$item}{module}; + my $form = $main::form; + my $myconfig = \%main::myconfig; - #} - if ($self->{$item}{action}) { - $action = $self->{$item}{action}; - } + my $module = $self->{$name}->{module} || $form->{script}; + my $action = $self->{$name}->{action}; - my $level = $form->escape($item); - my $str = qq|$module?action=$action&level=$level|; - my @vars = qw(module action target href); + $item->{target} = $self->{$name}->{target} || "main_window"; + $item->{href} = $self->{$name}->{href} || "${module}?action=" . $form->escape($action); - if ($self->{$item}{href}) { - $str = qq|$self->{$item}{href}|; - @vars = qw(module target href); - } + my @vars = qw(module target href); + push @vars, 'action' unless ($self->{$name}->{href}); - map { delete $self->{$item}{$_} } @vars; + map { delete $self->{$name}{$_} } @vars; # add other params - foreach my $key (keys %{ $self->{$item} }) { - $str .= "&" . $form->escape($key, 1) . "="; - ($value, $conf) = split(/=/, $self->{$item}{$key}, 2); - $value = $myconfig->{$value} . "/$conf" if ($conf); - $str .= $form->escape($value, 1); + foreach my $key (keys %{ $self->{$name} }) { + my ($value, $conf) = split(m/=/, $self->{$name}->{$key}, 2); + $value = $myconfig->{$value} . "/$conf" if ($conf); + $item->{href} .= "&" . $form->escape($key) . "=" . $form->escape($value); } - $str .= " "; - + $main::lxdebug->leave_sub(LXDebug::DEBUG2()); } sub access_control { @@ -267,39 +99,15 @@ sub access_control { my @menu = (); - if ($menulevel eq "") { + if (!$menulevel) { @menu = grep { !/--/ } @{ $self->{ORDER} }; } else { @menu = grep { /^${menulevel}--/ } @{ $self->{ORDER} }; } - my @a = split(/;/, $myconfig->{acs}); - my $excl = (); - - # remove --AR, --AP from array - grep { ($a, $b) = split(/--/); s/--$a$//; } @a; - - map { $excl{$_} = 1 } @a; - - @a = (); - map { push @a, $_ unless $excl{$_} } (@menu); - $main::lxdebug->leave_sub(2); - return @a; -} - -sub generate_acl { - my ($self, $menulevel, $hash) = @_; - - my @items = $self->access_control(\%main::myconfig, $menulevel); - - $menulevel =~ s/[^A-Za-z_\/\.\+\-]/_/g; - $hash->{"access_" . lc($menulevel)} = 1 if ($menulevel); - - foreach my $item (@items) { - $self->generate_acl($item, $hash); #unless ($menulevel); - } + return @menu; } sub parse_access_string { @@ -307,6 +115,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 = []; @@ -327,7 +139,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]; @@ -335,16 +147,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]); @@ -389,7 +201,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 {