diff options
| -rw-r--r-- | LedgerSMB/Menufile.pm | 271 | ||||
| -rw-r--r-- | bin/menu.pl | 378 |
2 files changed, 0 insertions, 649 deletions
diff --git a/LedgerSMB/Menufile.pm b/LedgerSMB/Menufile.pm deleted file mode 100644 index 85674efd..00000000 --- a/LedgerSMB/Menufile.pm +++ /dev/null @@ -1,271 +0,0 @@ - -=head1 NAME - -LedgerSMB::Menufile Routines to handle LedgerSMB menu files and format entries -for display. - -=head1 SYNOPSIS - -Routines to handle LedgerSMB menu files and conversion of menu entries into a -form usable by a web browser. LedgerSMB menu files are a specific form of ini -file. - -Files use both ';' and '#' to denote line comments. Any text after a line that -starts with '.' (i.e. ".foo") is ignored. Menu items are denoted as [section], -with the sections containing key=value pairs. The keys 'module', 'action', -'target', 'href', and 'submenu' are specially treated, while other keys are -output as arguments to the destination link. Blank lines are ignored. - -=head2 Special key treatment - -=over - -=item action - -This key is deleted on menuitem calls if there is no href value. - -=item module - -This is the Perl script that the menu item will call if the href attribute is -not set. This key is always deleted on a menuitem call. - -=item target - -The value given for target will be passed as the target attribute for the tag. -This key is always deleted on a menuitem call. - -=item href - -When set, this key's value becomes the base URL for the menu item. This key is -always deleted on a menuitem call. - -=item submenu - -This key is not displayed in output, but is deleted from the Menufile object -when menuitem is called on the item. - -=back - -=head2 Value Interpolation - -If a value for a regular key includes an equals sign (=), values from the user's -configuration are substituted into the place of the string preceding and the -first encountered equals sign in the value. So a menu entry of 'apples=login=' -would have the substition of 'apples=$myconfig->{login}' on generation of the -menu link. - -=head1 METHODS - -=over - -=item new ([$filename]) - -Create a new Menufile object. If a filename is specified, load the file with -add_file. - -=item add_file ($filename) - -Load the contents of the specified file into the Menufile object. If the file -cannot be read, Form->error will be called with the failure message. Attempts -to load already loaded items will result in the newer item merging with and -overwriting stored data from the previous load. - -Menu item titles are stored as keys in the Menufile object, and a special key, -ORDER maintains a list of the order in which menu items were first seen. - -=item menuitem ($myconfig, $form, $item) - -Formats the menu item for the given key $item as an HTML <a href=""> open tag. -Returns the tag and deletes the module, target, href, action, and submenu -attributes for the item from the Menufile object. - -If the menubar attribute of the passed in Form attribute is set, no style will -be set for the tag, otherwise the style is set to "display:block". - -=item access_control ($myconfig, [$menulevel]) - -Returns the list of menu items that can be displayed with $myconfig->{acs} at -the selected menu level. $menulevel is the string corresponding to a displayed -menu, such as 'AR' or 'AR--Reports'. A blank level corresponds to the top -level. Merely excluding a top-level element does not exclude corresponding -lower level elements, i.e. excluding 'AR' will not block 'AR--Reports'. - -$myconfig->{acs} is a semicolon seperated list of menu items to exclude. - -This is only a cosmetic form of access_control. Users can still access -"disallowed" sections of the application by manually entering in the URL. - -=back - -=head1 Copyright (C) 2006, The LedgerSMB core team. - - #==================================================================== - # LedgerSMB - # Small Medium Business Accounting software - # http://www.ledgersmb.org/ - # - # Copyright (C) 2006 - # This work contains copyrighted information from a number of sources - # all used with permission. - # - # This file contains source code included with or based on SQL-Ledger - # which is Copyright Dieter Simader and DWS Systems Inc. 2000-2005 - # and licensed under the GNU General Public License version 2 or, at - # your option, any later version. For a full list including contact - # information of contributors, maintainers, and copyright holders, - # see the CONTRIBUTORS file. - # - # Original Copyright Notice from SQL-Ledger 2.6.17 (before the fork): - # Copyright (C) 2002 - # - # Author: DWS Systems Inc. - # Web: http://www.sql-ledger.org - # - # Contributors: - # Tony Fraser <tony@sybaspace.com> - # - #===================================================================== -=cut - -package LedgerSMB::Menufile; - -use LedgerSMB::Form; - -sub new { - my ( $type, $file ) = @_; - - warn "$type has no copy constructor! creating a new object." - if ref($type); - $type = ref($type) || $type; - my $self = bless {}, $type; - $self->add_file($file) if defined $file; - - return $self; -} - -sub add_file { - my ( $self, $file ) = @_; - - my $id = ""; - my %menuorder = (); - - for ( @{ $self->{ORDER} } ) { $menuorder{$_} = 1 } - - open FH, '<', "$file" or Form->error("$file : $!"); - - while (<FH>) { - next if /^(#|;|\s)/; - last if /^\./; - - chop; - - # strip comments - s/\s*(#|;).*//g; - - # remove any trailing whitespace - s/^\s*(.*?)\s*$/$1/; - - if (/^\[/) { - s/(\[|\])//g; - $id = $_; - push @{ $self->{ORDER} }, $_ if !$menuorder{$_}; - $menuorder{$_} = 1; - next; - } - - # add key=value to $id - my ( $key, $value ) = split /=/, $_, 2; - - $self->{$id}{$key} = $value; - - } - close FH; - -} - -sub menuitem { - my ( $self, $myconfig, $form, $item ) = @_; - - my $module = - ( $self->{$item}{module} ) ? $self->{$item}{module} : $form->{script}; - my $action = - ( $self->{$item}{action} ) ? $self->{$item}{action} : "section_menu"; - my $target = ( $self->{$item}{target} ) ? $self->{$item}{target} : ""; - - my $level = $form->escape($item); - my $style; - if ( $form->{menubar} ) { - $style = ""; - } - else { - $style = "display:block;"; - } - my $str = - qq|<a style="$style"| - . qq|href="$module?path=$form->{path}&action=$action&| - . qq|level=$level&login=$form->{login}&| - . qq|timeout=$form->{timeout}&sessionid=$form->{sessionid}| - . qq|&js=$form->{js}|; - - my @vars = qw(module action target href); - - if ( $self->{$item}{href} ) { - $str = qq|<a href="$self->{$item}{href}|; - @vars = qw(module target href); - } - - for (@vars) { delete $self->{$item}{$_} } - - delete $self->{$item}{submenu}; - - # add other params - foreach my $key ( keys %{ $self->{$item} } ) { - $str .= "&" . $form->escape($key) . "="; - ( $value, $conf ) = split /=/, $self->{$item}{$key}, 2; - $value = "$myconfig->{$value}$conf" - if $self->{$item}{$key} =~ /=/; - - $str .= $form->escape($value); - } - - $str .= qq|#id$form->{tag}| if $target eq 'acc_menu'; - - if ($target) { - $str .= qq|" target="$target"|; - } - else { - $str .= '"'; - } - - $str .= qq|>|; - -} - -sub access_control { - my ( $self, $myconfig, $menulevel ) = @_; - - my @menu = (); - - if ( $menulevel eq "" ) { - @menu = grep { !/--/ } @{ $self->{ORDER} }; - } - else { - @menu = grep { /^${menulevel}--/; } @{ $self->{ORDER} }; - } - - my @a = split /;/, $myconfig->{acs}; - my %excl = (); - - # remove --AR, --AP from array - grep { ( $a, $b ) = split /--/; s/--$a$//; } @a; - - for (@a) { $excl{$_} = 1 } - - @a = (); - for (@menu) { push @a, $_ unless $excl{$_} } - - @a; - -} - -1; diff --git a/bin/menu.pl b/bin/menu.pl deleted file mode 100644 index f2bd469e..00000000 --- a/bin/menu.pl +++ /dev/null @@ -1,378 +0,0 @@ -#===================================================================== -# LedgerSMB -# Small Medium Business Accounting software -# http://www.ledgersmb.org/ -# -# -# See COPYRIGHT file for copyright information -#====================================================================== -# -# This file has undergone whitespace cleanup. -# -#====================================================================== -# -# two frame layout with refractured menu -# -####################################################################### - -$menufile = "menu.ini"; -use LedgerSMB::Menufile; - -1; - -# end of main - -sub display { - - if ( $form->{lynx} ) { - - $menu = new LedgerSMB::Menufile "$menufile"; - $menu->add_file("custom_$menufile") if -f "custom_$menufile"; - $menu->add_file("$form->{login}_$menufile") - if -f "$form->{login}_$menufile"; - - @menuorder = $menu->access_control( \%myconfig ); - - $form->{title} = "LedgerSMB $form->{version}"; - $form->header(1); - - $offset = int( 21 - $#menuorder ) / 2; - - print "<pre>"; - print "\n" x $offset; - print "</pre>"; - print qq|<center><table>|; - - map { - print "<tr><td>" - . $menu->menuitem( \%myconfig, \%$form, $_ ) - . $locale->text($_) - . qq|</a></td></tr>|; - } @menuorder; - - print qq'</table></body></html>'; - - } - else { - - $menuwidth = ( $ENV{HTTP_USER_AGENT} =~ /links/i ) ? "240" : "155"; - $menuwidth = $myconfig{menuwidth} if $myconfig{menuwidth}; - - $form->header( !$form->{duplicate} ); - - print qq| - <frameset cols="$menuwidth,*" border="1"> - <frame name="acc_menu" src="menu.pl?login=$form->{login}&sessionid=$form->{sessionid}&action=acc_menu&path=$form->{path}&js=$form->{js}" /> - <frame name="main_window" src="locale/html/splash.html" /> - </frameset> - </html> - |; - - } - -} - -sub acc_menu { - - if ( $form->{lynx} ) { - - §ion_menu; - - } - else { - - my $menu = new LedgerSMB::Menufile "$menufile"; - $menu->add_file("custom_$menufile") if -f "custom_$menufile"; - $menu->add_file("$form->{login}_$menufile") - if -f "$form->{login}_$menufile"; - - $form->{title} = $locale->text('Accounting Menu'); - - my $headeradd = q| - <script type="text/javascript"> - - function SwitchMenu(obj) { - if (document.getElementById) { - var el = document.getElementById(obj); - - if (el.style.display == "none") { - el.style.display = "block"; //display the block of info - } else { - el.style.display = "none"; - } - } - } - - function ChangeClass(menu, newClass) { - if (document.getElementById) { - document.getElementById(menu).className = newClass; - } - } - - document.onselectstart = new Function("return false"); - </script>|; - $form->header( undef, $headeradd ); - print q| - - <body class="menu"> - <img class="cornerlogo" src="images/ledgersmb_small.png" width="100" height="50" border="1" alt="LedgerSMB" /> - |; - - if ( $form->{js} ) { - &js_menu($menu); - } - else { - §ion_menu($menu); - } - - print q| - </body> - </html> - |; - } -} - -sub section_menu { - - if ( $form->{lynx} ) { - - $menu = new LedgerSMB::Menufile "$menufile", $form->{level}; - - $menu->add_file("custom_$menufile") if -f "custom_$menufile"; - $menu->add_file("$form->{login}_$menufile") - if -f "$form->{login}_$menufile"; - - # build tiered menus - @menuorder = $menu->access_control( \%myconfig, $form->{level} ); - - foreach $item (@menuorder) { - $a = $item; - $item =~ s/^$form->{level}--//; - push @neworder, $a unless ( $item =~ /--/ ); - } - - @menuorder = @neworder; - - $level = $form->{level}; - $level =~ s/--/ /g; - - $form->{title} = $locale->text($level); - $form->header; - - $offset = int( 21 - $#menuorder ) / 2; - - print "<pre>"; - print "\n" x $offset; - print "</pre>"; - print qq|<center><table>|; - - foreach $item (@menuorder) { - $label = $item; - $label =~ s/$form->{level}--//g; - - # remove target - $menu->{$item}{target} = ""; - - print "<tr><td>" - . $menu->menuitem( \%myconfig, \%$form, $item, $form->{level} ) - . $locale->text($label) - . "</a></td></tr>"; - } - - print qq'</table></body></html>'; - - } - else { - - my ( $menu, $level ) = @_; - - # build tiered menus - my @menuorder = $menu->access_control( \%myconfig, $level ); - - while (@menuorder) { - $item = shift @menuorder; - $label = $item; - $label =~ s/$level--//g; - - my $spacer = " " x ( ( $item =~ s/--/--/g ) * 2 ); - - $label =~ s/.*--//g; - $label = $locale->text($label); - $label =~ s/ / /g if $label !~ /<img /i; - - $menu->{$item}{target} = "main_window" - unless $menu->{$item}{target}; - - if ( $menu->{$item}{submenu} ) { - - $menu->{$item}{$item} = !$form->{$item}; - - if ( $form->{level} && $item =~ $form->{level} ) { - - # expand menu - print qq|<br />\n$spacer| - . $menu->menuitem( \%myconfig, \%$form, $item, $level ) - . qq|$label</a>|; - - # remove same level items - map { shift @menuorder } grep /^$item/, @menuorder; - - §ion_menu( $menu, $item ); - - print qq|<br />\n|; - - } - else { - - print qq|<br />\n$spacer| - . $menu->menuitem( \%myconfig, \%$form, $item, $level ) - . qq|$label ...</a>|; - - # remove same level items - map { shift @menuorder } grep /^$item/, @menuorder; - - } - - } - else { - - if ( $menu->{$item}{module} ) { - - print qq|<br />\n$spacer| - . $menu->menuitem( \%myconfig, \%$form, $item, $level ) - . qq|$label</a>|; - - } - else { - - $form->{tag}++; - print qq|<a name="id$form->{tag}"></a><p><b>$label</b></p>|; - - §ion_menu( $menu, $item ); - - print qq|<br />\n|; - - } - } - } - } -} - -sub js_menu { - - my ( $menu, $level ) = @_; - - print qq| <div id="div_$menu_$level"> |; - - # build tiered menus - my @menuorder = $menu->access_control( \%myconfig, $level ); - - while (@menuorder) { - $i++; - $item = shift @menuorder; - $label = $item; - $label =~ s/.*--//g; - $label = $locale->text($label); - - $menu->{$item}{target} = "main_window" unless $menu->{$item}{target}; - - if ( $menu->{$item}{submenu} ) { - - $display = "display: none;" unless $level eq ' '; - - print qq| - <div id="menu$i" class="menuOut" onclick="SwitchMenu('sub$i')" onmouseover="ChangeClass('menu$i','menuOver')" onmouseout="ChangeClass('menu$i','menuOut')">$label</div> - <div class="submenu" id="sub$i" style="$display">|; - - # remove same level items - map { shift @menuorder } grep /^$item/, @menuorder; - - &js_menu( $menu, $item ); - - print qq| - - </div> - |; - - } - else { - - if ( $menu->{$item}{module} ) { - - if ( $level eq "" ) { - print -qq|<div id="menu$i" class="menuOut" onmouseover="ChangeClass('menu$i','menuOver')" onmouseout="ChangeClass('menu$i','menuOut')"> | - . $menu->menuitem( \%myconfig, \%$form, $item, $level ) - . qq|$label</a></div>|; - - # remove same level items - map { shift @menuorder } grep /^$item/, @menuorder; - - &js_menu( $menu, $item ); - - } - else { - - print qq|<div class="submenu"> | - . $menu->menuitem( \%myconfig, \%$form, $item, $level ) - . qq|$label</a></div>|; - } - - } - else { - - $display = "display: none;" unless $item eq ' '; - - print qq| - <div id="menu$i" class="menuOut" onclick="SwitchMenu('sub$i')" onmouseover="ChangeClass('menu$i','menuOver')" onmouseout="ChangeClass('menu$i','menuOut')">$label</div> - <div class="submenu" id="sub$i" style="$display">|; - - &js_menu( $menu, $item ); - - print qq| </div> |; - - } - - } - - } - - print qq| </div> |; -} - -sub menubar { - - if ( $form->{lynx} ) { - - $menu = new LedgerSMB::Menufile "$menufile", ""; - - # build menubar - @menuorder = $menu->access_control( \%myconfig, "" ); - - @neworder = (); - map { push @neworder, $_ unless ( $_ =~ /--/ ) } @menuorder; - @menuorder = @neworder; - - print "<p>"; - $form->{script} = "menu.pl"; - - print "| "; - - foreach $item (@menuorder) { - $label = $item; - - # remove target - $menu->{$item}{target} = ""; - - print $menu->menuitem( \%myconfig, \%$form, $item, "" ) - . $locale->text($label) - . "</a> | "; - } - - } - else { - - 1; - } -} - |