$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;
- if ($yaml_xs) {
- $data = YAML::XS::LoadFile(File::Spec->catfile($path, $file));
- } else {
- $data = YAML::LoadFile(File::Spec->catfile($path, $file));
+ my $nodes = [];
+ my $nodes_by_id = {};
+ for my $file (@files) {
+ my $data;
+ eval {
+ if ($yaml_xs) {
+ $data = YAML::XS::LoadFile(File::Spec->catfile($path, $file));
+ } else {
+ $data = YAML::LoadFile(File::Spec->catfile($path, $file));
+ }
+ 1;
+ } or do {
+ die "Error while parsing $file: $@";
+ };
+
+ # check if this file is internally consistent.
+ die 'not an array ref' unless $data && 'ARRAY' eq ref $data; # TODO get better diag to user
+
+ # in particular duplicate ids tend to come up as a user error when editing the menu files
+ #my %uniq_ids;
+ #$uniq_ids{$_->{id}}++ && die "Error in $file: duplicate id $_->{id}" for @$data;
+
+ _merge($nodes, $nodes_by_id, $data);
}
- _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 {
my ($nodes, $by_id, $data) = @_;
- die 'not an array ref' unless $data && 'ARRAY' eq ref $data; # TODO check this sooner, to get better diag to user
-
for my $node (@$data) {
my $id = $node->{id};
# 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 = { };
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