Merge branch 'master' of http://wagnertech.de/git/mfinanz

[mfinanz.git] / SL / Menu.pm

diff --git a/SL/Menu.pm b/SL/Menu.pm
index bdac42c0de54a5a11904540a48767bcf0802f68e..083b4b8427486b27c871d6bdeff297acced9e48b 100644 (file)
--- a/SL/Menu.pm
+++ b/SL/Menu.pm
@@ -3,14 +3,10 @@ package SL::Menu;
 use strict;
 
 use SL::Auth;
-use YAML ();
 use File::Spec;
 use SL::MoreCommon qw(uri_encode);
-
-our $yaml_xs;
-BEGIN {
-   $yaml_xs =  eval { require YAML::XS };
-}
+use SL::InstanceState;
+use SL::YAML;
 
 our %menu_cache;
 
@@ -29,11 +25,7 @@ sub new {
     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));
-        }
+        $data = SL::YAML::LoadFile(File::Spec->catfile($path, $file));
         1;
       } or do {
         die "Error while parsing $file: $@";
@@ -43,16 +35,18 @@ sub new {
       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;
+      #my %uniq_ids;
+      #$uniq_ids{$_->{id}}++ && die "Error in $file: duplicate id $_->{id}" for @$data;
 
       _merge($nodes, $nodes_by_id, $data);
     }
 
+    my $instance_state = SL::InstanceState->new;
 
     my $self = bless {
       nodes => $nodes,
       by_id => $nodes_by_id,
+      instance_state => $instance_state,
     }, $package;
 
     $self->build_tree;
@@ -73,6 +67,8 @@ sub _merge {
   for my $node (@$data) {
     my $id = $node->{id};
 
+    die "menu: node with name '$node->{name}' does not have an id" if !$id;
+
     my $merge_to = $by_id->{$id};
 
     if (!$merge_to) {
@@ -117,6 +113,19 @@ sub build_tree {
     push @{ $by_parent{ $node->{parent} // '' } //= [] }, $node;
   }
 
+  # autovivify order in by_parent, so that numerical sorting for entries without order
+  # preserves their order and position with respect to entries with order.
+  for (values %by_parent) {
+    my $last_order = 0;
+    for my $node (@$_) {
+      if (defined $node->{order} && $node->{order} * 1) {
+        $last_order = $node->{order};
+      } else {
+        $node->{order} = ++$last_order;
+      }
+    }
+  }
+
   my $tree = { };
   $self->{by_id}{''} = $tree;
 
@@ -165,7 +174,7 @@ sub parse_access_string {
 
   my $access = $node->{access};
 
-  while ($access =~ m/^([a-z_\/]+|\||\&|\(|\)|\s+)/) {
+  while ($access =~ m/^([a-z_\/]+|\!|\||\&|\(|\)|\s+)/) {
     my $token = $1;
     substr($access, 0, length($1)) = "";
 
@@ -184,12 +193,14 @@ sub parse_access_string {
       }
       $cur_ary = $stack[-1];
 
-    } elsif (($token eq "|") || ($token eq "&")) {
+    } elsif (($token eq "|") || ($token eq "&") || ($token eq "!")) {
       push @{$cur_ary}, $token;
 
     } else {
       if ($token =~ m{^ client / (.*) }x) {
         push @{$cur_ary}, $self->parse_instance_conf_string($1);
+      } elsif ($token =~ m{^ state / (.*) }x) {
+        push @{$cur_ary}, $self->parse_instance_state_string($1);
       } else {
         push @{$cur_ary}, $::auth->check_right($::myconfig{login}, $token, 1);
       }
@@ -212,14 +223,16 @@ sub href_for_node {
 
   return undef if !$node->{href} && !$node->{module} && !$node->{params};
 
-  my $href = $node->{href} || $node->{module} || 'controller.pl';
-  my @tokens;
+  return $node->{href_for_node} ||= do {
+    my $href = $node->{href} || $node->{module} || 'controller.pl';
+    my @tokens;
 
-  while (my ($key, $value) = each %{ $node->{params} }) {
-    push @tokens, uri_encode($key, 1) . "=" . uri_encode($value, 1);
-  }
+    while (my ($key, $value) = each %{ $node->{params} }) {
+      push @tokens, uri_encode($key, 1) . "=" . uri_encode($value, 1);
+    }
 
-  return join '?', $href, grep $_, join '&', @tokens;
+    join '?', $href, grep $_, join '&', @tokens;
+  }
 }
 
 sub name_for_node {
@@ -231,6 +244,11 @@ sub parse_instance_conf_string {
   return $::instance_conf->data->{$setting};
 }
 
+sub parse_instance_state_string {
+  my ($self, $setting) = @_;
+  return $self->{instance_state}->$setting;
+}
+
 sub clear_access {
   my ($self) = @_;
   for my $node ($self->tree_walk("all")) {
@@ -256,4 +274,3 @@ sub set_access {
 }
 
 1;
-