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 $main::lxdebug->enter_sub();
113 my ($self, $myconfig, $form, $item, $other) = @_;
115 my $module = $form->{script};
116 my $action = "section_menu";
119 if ($self->{$item}{module}) {
120 $module = $self->{$item}{module};
122 if ($self->{$item}{action}) {
123 $action = $self->{$item}{action};
125 if ($self->{$item}{target}) {
126 $target = $self->{$item}{target};
129 my $level = $form->escape($item);
131 my $str = qq|<a href="$module?action=| . $form->escape($action) . qq|&level=| . $form->escape($level);
133 my @vars = qw(module action target href);
135 if ($self->{$item}{href}) {
136 $str = qq|<a href=$self->{$item}{href}|;
137 @vars = qw(module target href);
140 map { delete $self->{$item}{$_} } @vars;
143 foreach my $key (keys %{ $self->{$item} }) {
144 $str .= "&" . $form->escape($key, 1) . "=";
145 ($value, $conf) = split(/=/, $self->{$item}{$key}, 2);
146 $value = $myconfig->{$value} . "/$conf" if ($conf);
147 $str .= $form->escape($value, 1);
153 $str .= qq| target="| . $form->quote($target) . qq|"|;
157 foreach my $key (keys(%{$other})) {
158 $str .= qq| ${key}="| . $form->quote($other->{$key}) . qq|"|;
164 $main::lxdebug->leave_sub();
170 $main::lxdebug->enter_sub();
172 my ($self, $myconfig, $form, $item, $other) = @_;
174 my $module = $form->{script};
175 my $action = "section_menu";
178 if ($self->{$item}{module}) {
179 $module = $self->{$item}{module};
181 if ($self->{$item}{action}) {
182 $action = $self->{$item}{action};
184 if ($self->{$item}{target}) {
185 $target = $self->{$item}{target};
188 my $level = $form->escape($item);
190 my $str = qq| link="$module?action=| . $form->escape($action) .
191 qq|&level=| . $form->escape($level);
193 my @vars = qw(module action target href);
195 if ($self->{$item}{href}) {
196 $str = qq| link=$self->{$item}{href}|;
197 @vars = qw(module target href);
200 map { delete $self->{$item}{$_} } @vars;
203 foreach my $key (keys %{ $self->{$item} }) {
204 $str .= "&" . $form->escape($key, 1) . "=";
205 ($value, $conf) = split(/=/, $self->{$item}{$key}, 2);
206 $value = $myconfig->{$value} . "/$conf" if ($conf);
207 $str .= $form->escape($value, 1);
215 foreach my $key (keys(%{$other})) {
216 $str .= qq| ${key}="| . $form->quote($other->{$key}) . qq|"|;
221 $main::lxdebug->leave_sub();
227 my ($self, $myconfig, $form, $item) = @_;
229 my $module = $form->{script};
230 my $action = "section_menu";
232 #if ($self->{$item}{module}) {
233 $module = $self->{$item}{module};
236 if ($self->{$item}{action}) {
237 $action = $self->{$item}{action};
240 my $level = $form->escape($item);
241 my $str = qq|$module?action=$action&level=$level|;
242 my @vars = qw(module action target href);
244 if ($self->{$item}{href}) {
245 $str = qq|$self->{$item}{href}|;
246 @vars = qw(module target href);
249 map { delete $self->{$item}{$_} } @vars;
252 foreach my $key (keys %{ $self->{$item} }) {
253 $str .= "&" . $form->escape($key, 1) . "=";
254 ($value, $conf) = split(/=/, $self->{$item}{$key}, 2);
255 $value = $myconfig->{$value} . "/$conf" if ($conf);
256 $str .= $form->escape($value, 1);
264 $main::lxdebug->enter_sub(2);
266 my ($self, $myconfig, $menulevel) = @_;
270 if ($menulevel eq "") {
271 @menu = grep { !/--/ } @{ $self->{ORDER} };
273 @menu = grep { /^${menulevel}--/ } @{ $self->{ORDER} };
276 my @a = split(/;/, $myconfig->{acs});
279 # remove --AR, --AP from array
280 grep { ($a, $b) = split(/--/); s/--$a$//; } @a;
282 map { $excl{$_} = 1 } @a;
285 map { push @a, $_ unless $excl{$_} } (@menu);
287 $main::lxdebug->leave_sub(2);
293 my ($self, $menulevel, $hash) = @_;
295 my @items = $self->access_control(\%main::myconfig, $menulevel);
297 $menulevel =~ s/[^A-Za-z_\/\.\+\-]/_/g;
298 $hash->{"access_" . lc($menulevel)} = 1 if ($menulevel);
300 foreach my $item (@items) {
301 $self->generate_acl($item, $hash); #unless ($menulevel);
305 sub parse_access_string {
313 push @stack, $cur_ary;
315 while ($access =~ m/^([a-z_]+|\||\&|\(|\)|\s+)/) {
317 substr($access, 0, length($1)) = "";
319 next if ($token =~ /\s/);
322 my $new_cur_ary = [];
323 push @stack, $new_cur_ary;
324 push @{$cur_ary}, $new_cur_ary;
325 $cur_ary = $new_cur_ary;
327 } elsif ($token eq ")") {
330 $main::form->error("Error in menu.ini for entry ${key}: missing '('");
332 $cur_ary = $stack[-1];
334 } elsif (($token eq "|") || ($token eq "&")) {
335 push @{$cur_ary}, $token;
338 push @{$cur_ary}, $main::auth->check_right($main::form->{login}, $token, 1);
343 $main::form->error("Error in menu.ini for entry ${name}: unrecognized token at the start of '$access'\n");
346 if (1 < scalar @stack) {
347 $main::form->error("Error in menu.ini for entry ${name}: Missing ')'\n");
350 return SL::Auth::evaluate_rights_ary($stack[0]);
358 foreach $key (@{ $self->{ORDER} }) {
359 my $entry = $self->{$key};
361 $entry->{GRANTED} = $entry->{ACCESS} ? $self->parse_access_string($key, $entry->{ACCESS}) : 1;
362 $entry->{IS_MENU} = $entry->{submenu} || ($key !~ m/--/);
363 $entry->{NUM_VISIBLE_CHILDREN} = 0;
367 substr($parent, rindex($parent, '--')) = '';
368 $entry->{GRANTED} &&= $self->{$parent}->{GRANTED};
371 $entry->{VISIBLE} = $entry->{GRANTED};
374 foreach $key (reverse @{ $self->{ORDER} }) {
375 my $entry = $self->{$key};
377 if ($entry->{IS_MENU}) {
378 $entry->{VISIBLE} &&= $entry->{NUM_VISIBLE_CHILDREN} > 0;
381 next if (($key !~ m/--/) || !$entry->{VISIBLE});
384 substr($parent, rindex($parent, '--')) = '';
385 $self->{$parent}->{NUM_VISIBLE_CHILDREN}++;
388 # $self->dump_visible();
390 $self->{ORDER} = [ grep { $self->{$_}->{VISIBLE} } @{ $self->{ORDER} } ];
392 map { delete @{$self->{$_}}{qw(GRANTED IS_MENU NUM_VISIBLE_CHILDREN VISIBLE ACCESS)} if ($_ ne 'ORDER') } keys %{ $self };
397 foreach my $key (@{ $self->{ORDER} }) {
398 my $entry = $self->{$key};
399 $main::lxdebug->message(0, "$entry->{GRANTED} $entry->{VISIBLE} $entry->{NUM_VISIBLE_CHILDREN} $key");