X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FMenu.pm;h=6bbcffb9c8af8adbfc42883522e3298b47a2e5cd;hb=71ada638068acc8b1481b7392bc0511fa627647e;hp=534a05e6ef7903b2f569a2b64c893bf756ca8afa;hpb=b251cc22f355941217493073e124ba3878d5530f;p=kivitendo-erp.git diff --git a/SL/Menu.pm b/SL/Menu.pm index 534a05e6e..6bbcffb9c 100644 --- a/SL/Menu.pm +++ b/SL/Menu.pm @@ -3,36 +3,55 @@ package SL::Menu; use strict; use SL::Auth; -use YAML::XS (); +use YAML (); use File::Spec; use SL::MoreCommon qw(uri_encode); +our $yaml_xs; +BEGIN { + $yaml_xs = eval { require YAML::XS }; +} + +our %menu_cache; + sub new { my ($package, $domain) = @_; - my $path = File::Spec->catdir('menus', $domain); + if (!$menu_cache{$domain}) { + my $path = File::Spec->catdir('menus', $domain); - opendir my $dir, $path or die "can't open $path: $!"; - my @files = sort grep -f "$path/$_", readdir $dir; - close $dir; + opendir my $dir, $path or die "can't open $path: $!"; + my @files = sort grep -f "$path/$_", grep /\.yaml$/, readdir $dir; + close $dir; - my $nodes = []; - my $nodes_by_id = {}; - for my $file (@files) { - my $data = YAML::XS::LoadFile(File::Spec->catfile($path, $file)); - _merge($nodes, $nodes_by_id, $data); - } + my $nodes = []; + my $nodes_by_id = {}; + for my $file (@files) { + my $data; + if ($yaml_xs) { + $data = YAML::XS::LoadFile(File::Spec->catfile($path, $file)); + } else { + $data = YAML::LoadFile(File::Spec->catfile($path, $file)); + } + _merge($nodes, $nodes_by_id, $data); + } - my $self = bless { - nodes => $nodes, - by_id => $nodes_by_id, - }, $package; + my $self = bless { + nodes => $nodes, + by_id => $nodes_by_id, + }, $package; - $self->build_tree; - $self->set_access; + $self->build_tree; - return $self; + $menu_cache{$domain} = $self; + } else { + $menu_cache{$domain}->clear_access; + } + + $menu_cache{$domain}->set_access; + + return $menu_cache{$domain}; } sub _merge { @@ -78,13 +97,13 @@ sub build_tree { # first, some sanity check. are all parents valid ids or empty? for my $node ($self->nodes) { next if !exists $node->{parent} || !$node->{parent} || $self->{by_id}->{$node->{id}}; - die "menu: node $node->{id} has non-existant parent $node->{parent}"; + die "menu: node $node->{id} has non-existent parent $node->{parent}"; } my %by_parent; # order them by parent for my $node ($self->nodes) { - push @{ $by_parent{ $node->{parent} } //= [] }, $node; + push @{ $by_parent{ $node->{parent} // '' } //= [] }, $node; } my $tree = { }; @@ -150,7 +169,7 @@ sub parse_access_string { } elsif ($token eq ")") { pop @stack; if (!@stack) { - die "Error in menu.ini for entry $node->{id}: missing '('"; + die "Error while parsing menu entry $node->{id}: missing '('"; } $cur_ary = $stack[-1]; @@ -167,11 +186,11 @@ sub parse_access_string { } if ($access) { - die "Error in menu.ini for entry $node->{id}: unrecognized token at the start of '$access'\n"; + die "Error while parsing menu entry $node->{id}: unrecognized token at the start of '$access'\n"; } if (1 < scalar @stack) { - die "Error in menu.ini for entry $node->{id}: Missing ')'\n"; + die "Error while parsing menu entry $node->{id}: Missing ')'\n"; } return SL::Auth::evaluate_rights_ary($stack[0]); @@ -201,6 +220,14 @@ sub parse_instance_conf_string { return $::instance_conf->data->{$setting}; } +sub clear_access { + my ($self) = @_; + for my $node ($self->tree_walk("all")) { + delete $node->{visible}; + delete $node->{visible_children}; + } +} + sub set_access { my ($self) = @_; # 1. evaluate access for all