1 #=====================================================================
4 # Based on SQL-Ledger Version 2.1.9
5 # Web http://www.lx-office.org
7 #=====================================================================
8 # SQL-Ledger Accounting
11 # Author: Dieter Simader
12 # Email: dsimader@sql-ledger.org
13 # Web: http://www.sql-ledger.org
17 # This program is free software; you can redistribute it and/or modify
18 # it under the terms of the GNU General Public License as published by
19 # the Free Software Foundation; either version 2 of the License, or
20 # (at your option) any later version.
22 # This program is distributed in the hope that it will be useful,
23 # but WITHOUT ANY WARRANTY; without even the implied warranty of
24 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
25 # GNU General Public License for more details.
26 # You should have received a copy of the GNU General Public License
27 # along with this program; if not, write to the Free Software
28 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
29 #=====================================================================
31 # routines for menu items
33 #=====================================================================
41 $main::lxdebug->enter_sub();
43 my ($type, $menufile) = @_;
46 my $inifile = Inifile->new($menufile);
48 map { $self->{$_} = $inifile->{$_} } keys %{ $inifile };
54 $main::lxdebug->leave_sub();
60 $main::lxdebug->enter_sub();
62 my ($self, $myconfig, $form, $item) = @_;
64 my $module = $form->{script};
65 my $action = "section_menu";
68 if ($self->{$item}{module}) {
69 $module = $self->{$item}{module};
71 if ($self->{$item}{action}) {
72 $action = $self->{$item}{action};
74 if ($self->{$item}{target}) {
75 $target = $self->{$item}{target};
78 my $level = $form->escape($item);
80 my $str = qq|<a style="vertical-align:top" href=$module?action=$action&level=$level|;
82 my @vars = qw(module action target href);
84 if ($self->{$item}{href}) {
85 $str = qq|<a href=$self->{$item}{href}|;
86 @vars = qw(module target href);
89 map { delete $self->{$item}{$_} } @vars;
92 foreach my $key (keys %{ $self->{$item} }) {
93 $str .= "&" . $form->escape($key, 1) . "=";
94 ($value, $conf) = split(/=/, $self->{$item}{$key}, 2);
95 $value = $myconfig->{$value} . "/$conf" if ($conf);
96 $str .= $form->escape($value, 1);
100 $str .= qq| target=$target|;
105 $main::lxdebug->leave_sub();
111 my ($self, $myconfig, $form, $item) = @_;
113 my $module = $form->{script};
114 my $action = "section_menu";
116 #if ($self->{$item}{module}) {
117 $module = $self->{$item}{module};
120 if ($self->{$item}{action}) {
121 $action = $self->{$item}{action};
124 my $level = $form->escape($item);
125 my $str = qq|$module?action=$action&level=$level|;
126 my @vars = qw(module action target href);
128 if ($self->{$item}{href}) {
129 $str = qq|$self->{$item}{href}|;
130 @vars = qw(module target href);
133 map { delete $self->{$item}{$_} } @vars;
136 foreach my $key (keys %{ $self->{$item} }) {
137 $str .= "&" . $form->escape($key, 1) . "=";
138 ($value, $conf) = split(/=/, $self->{$item}{$key}, 2);
139 $value = $myconfig->{$value} . "/$conf" if ($conf);
140 $str .= $form->escape($value, 1);
148 $main::lxdebug->enter_sub();
150 my ($self, $name, $item) = @_;
152 my $form = $main::form;
154 my $module = $self->{$name}->{module} || $form->{script};
155 my $action = $self->{$name}->{action};
157 $item->{target} = $self->{$name}->{target} || "main_window";
158 $item->{href} = $self->{$name}->{href} || "${module}?action=" . $form->escape($action);
160 my @vars = qw(module target href);
161 push @vars, 'action' unless ($self->{$name}->{href});
163 map { delete $self->{$name}{$_} } @vars;
166 foreach my $key (keys %{ $self->{$name} }) {
167 my ($value, $conf) = split(m/=/, $self->{$name}->{$key}, 2);
168 $value = $myconfig->{$value} . "/$conf" if ($conf);
169 $item->{href} .= "&" . $form->escape($key) . "=" . $form->escape($value);
172 $main::lxdebug->leave_sub();
176 $main::lxdebug->enter_sub();
178 my ($self, $myconfig, $form, $item, $other) = @_;
180 my $module = $form->{script};
181 my $action = "section_menu";
184 if ($self->{$item}{module}) {
185 $module = $self->{$item}{module};
187 if ($self->{$item}{action}) {
188 $action = $self->{$item}{action};
190 if ($self->{$item}{target}) {
191 $target = $self->{$item}{target};
194 my $level = $form->escape($item);
196 my $str = qq|<a href="$module?action=| . $form->escape($action) . qq|&level=| . $form->escape($level);
198 my @vars = qw(module action target href);
200 if ($self->{$item}{href}) {
201 $str = qq|<a href=$self->{$item}{href}|;
202 @vars = qw(module target href);
205 map { delete $self->{$item}{$_} } @vars;
208 foreach my $key (keys %{ $self->{$item} }) {
209 $str .= "&" . $form->escape($key, 1) . "=";
210 ($value, $conf) = split(/=/, $self->{$item}{$key}, 2);
211 $value = $myconfig->{$value} . "/$conf" if ($conf);
212 $str .= $form->escape($value, 1);
218 $str .= qq| target="| . $form->quote($target) . qq|"|;
222 foreach my $key (keys(%{$other})) {
223 $str .= qq| ${key}="| . $form->quote($other->{$key}) . qq|"|;
229 $main::lxdebug->leave_sub();
235 $main::lxdebug->enter_sub();
237 my ($self, $myconfig, $form, $item, $other) = @_;
239 my $module = $form->{script};
240 my $action = "section_menu";
243 if ($self->{$item}{module}) {
244 $module = $self->{$item}{module};
246 if ($self->{$item}{action}) {
247 $action = $self->{$item}{action};
249 if ($self->{$item}{target}) {
250 $target = $self->{$item}{target};
253 my $level = $form->escape($item);
255 my $str = qq| link="$module?action=| . $form->escape($action) .
256 qq|&level=| . $form->escape($level);
258 my @vars = qw(module action target href);
260 if ($self->{$item}{href}) {
261 $str = qq| link=$self->{$item}{href}|;
262 @vars = qw(module target href);
265 map { delete $self->{$item}{$_} } @vars;
268 foreach my $key (keys %{ $self->{$item} }) {
269 $str .= "&" . $form->escape($key, 1) . "=";
270 ($value, $conf) = split(/=/, $self->{$item}{$key}, 2);
271 $value = $myconfig->{$value} . "/$conf" if ($conf);
272 $str .= $form->escape($value, 1);
280 foreach my $key (keys(%{$other})) {
281 $str .= qq| ${key}="| . $form->quote($other->{$key}) . qq|"|;
286 $main::lxdebug->leave_sub();
292 $main::lxdebug->enter_sub(2);
294 my ($self, $myconfig, $menulevel) = @_;
298 if ($menulevel eq "") {
299 @menu = grep { !/--/ } @{ $self->{ORDER} };
301 @menu = grep { /^${menulevel}--/ } @{ $self->{ORDER} };
304 $main::lxdebug->leave_sub(2);
309 sub parse_access_string {
317 push @stack, $cur_ary;
319 while ($access =~ m/^([a-z_]+|\||\&|\(|\)|\s+)/) {
321 substr($access, 0, length($1)) = "";
323 next if ($token =~ /\s/);
326 my $new_cur_ary = [];
327 push @stack, $new_cur_ary;
328 push @{$cur_ary}, $new_cur_ary;
329 $cur_ary = $new_cur_ary;
331 } elsif ($token eq ")") {
334 $main::form->error("Error in menu.ini for entry ${key}: missing '('");
336 $cur_ary = $stack[-1];
338 } elsif (($token eq "|") || ($token eq "&")) {
339 push @{$cur_ary}, $token;
342 push @{$cur_ary}, $main::auth->check_right($main::form->{login}, $token, 1);
347 $main::form->error("Error in menu.ini for entry ${name}: unrecognized token at the start of '$access'\n");
350 if (1 < scalar @stack) {
351 $main::form->error("Error in menu.ini for entry ${name}: Missing ')'\n");
354 return SL::Auth::evaluate_rights_ary($stack[0]);
362 foreach $key (@{ $self->{ORDER} }) {
363 my $entry = $self->{$key};
365 $entry->{GRANTED} = $entry->{ACCESS} ? $self->parse_access_string($key, $entry->{ACCESS}) : 1;
366 $entry->{IS_MENU} = $entry->{submenu} || ($key !~ m/--/);
367 $entry->{NUM_VISIBLE_CHILDREN} = 0;
371 substr($parent, rindex($parent, '--')) = '';
372 $entry->{GRANTED} &&= $self->{$parent}->{GRANTED};
375 $entry->{VISIBLE} = $entry->{GRANTED};
378 foreach $key (reverse @{ $self->{ORDER} }) {
379 my $entry = $self->{$key};
381 if ($entry->{IS_MENU}) {
382 $entry->{VISIBLE} &&= $entry->{NUM_VISIBLE_CHILDREN} > 0;
385 next if (($key !~ m/--/) || !$entry->{VISIBLE});
388 substr($parent, rindex($parent, '--')) = '';
389 $self->{$parent}->{NUM_VISIBLE_CHILDREN}++;
392 # $self->dump_visible();
394 $self->{ORDER} = [ grep { $self->{$_}->{VISIBLE} } @{ $self->{ORDER} } ];
396 map { delete @{$self->{$_}}{qw(GRANTED IS_MENU NUM_VISIBLE_CHILDREN VISIBLE ACCESS)} if ($_ ne 'ORDER') } keys %{ $self };
401 foreach my $key (@{ $self->{ORDER} }) {
402 my $entry = $self->{$key};
403 $main::lxdebug->message(0, "$entry->{GRANTED} $entry->{VISIBLE} $entry->{NUM_VISIBLE_CHILDREN} $key");