From 44d035fe38dac0b91e1fdadb576459f5ec19739a Mon Sep 17 00:00:00 2001 From: tetragon Date: Thu, 17 May 2007 21:15:52 +0000 Subject: Merging Inifile and Menu into Menufile Fixed a scope bug in Menufile, and added more tests git-svn-id: https://ledger-smb.svn.sourceforge.net/svnroot/ledger-smb/trunk@1204 4979c152-3d1c-0410-bac9-87ea11338e46 --- LedgerSMB/Inifile.pm | 91 ----------------- LedgerSMB/Locale.pm | 1 + LedgerSMB/Menu.pm | 125 ----------------------- LedgerSMB/Menufile.pm | 271 ++++++++++++++++++++++++++++++++++++++++++++++++++ bin/menu.pl | 10 +- t/01-load.t | 5 +- t/10-form.t | 65 ++++++------ t/11-ledgersmb.t | 2 +- t/12-menufile.t | 143 ++++++++++++++++++++++++++ t/98-pod-coverage.t | 19 ++++ t/data/12-menu1.ini | 5 + t/data/12-menu2.ini | 9 ++ t/data/12-menu3.ini | 9 ++ t/data/12-menu4.ini | 19 ++++ 14 files changed, 521 insertions(+), 253 deletions(-) delete mode 100644 LedgerSMB/Inifile.pm delete mode 100644 LedgerSMB/Menu.pm create mode 100644 LedgerSMB/Menufile.pm create mode 100644 t/12-menufile.t create mode 100644 t/98-pod-coverage.t create mode 100644 t/data/12-menu1.ini create mode 100644 t/data/12-menu2.ini create mode 100644 t/data/12-menu3.ini create mode 100644 t/data/12-menu4.ini diff --git a/LedgerSMB/Inifile.pm b/LedgerSMB/Inifile.pm deleted file mode 100644 index 1b89502c..00000000 --- a/LedgerSMB/Inifile.pm +++ /dev/null @@ -1,91 +0,0 @@ -#===================================================================== -# 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 -# -#====================================================================== -# -# This file has undergone whitespace cleanup. -# -#====================================================================== -# -# routines to retrieve / manipulate win ini style files -# ORDER is used to keep the elements in the order they appear in .ini -# -#===================================================================== - -package Inifile; - -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 () { - 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; - -} - -1; - diff --git a/LedgerSMB/Locale.pm b/LedgerSMB/Locale.pm index 90b269db..84c1ed13 100644 --- a/LedgerSMB/Locale.pm +++ b/LedgerSMB/Locale.pm @@ -1,3 +1,4 @@ + =head1 NAME LedgerSMB::Locale Locale handling class for LedgerSMB diff --git a/LedgerSMB/Menu.pm b/LedgerSMB/Menu.pm deleted file mode 100644 index 57c83245..00000000 --- a/LedgerSMB/Menu.pm +++ /dev/null @@ -1,125 +0,0 @@ -#===================================================================== -# 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 -# -#====================================================================== -# -# This file has undergone whitespace cleanup. -# -#====================================================================== -# -# routines for menu items -# -#===================================================================== - -package Menu; - -use LedgerSMB::Inifile; -@ISA = qw/Inifile/; - -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|{$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/LedgerSMB/Menufile.pm b/LedgerSMB/Menufile.pm new file mode 100644 index 00000000..85674efd --- /dev/null +++ b/LedgerSMB/Menufile.pm @@ -0,0 +1,271 @@ + +=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 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 + # + #===================================================================== +=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 () { + 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|{$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 index 1d44caaf..f2bd469e 100644 --- a/bin/menu.pl +++ b/bin/menu.pl @@ -16,7 +16,7 @@ ####################################################################### $menufile = "menu.ini"; -use LedgerSMB::Menu; +use LedgerSMB::Menufile; 1; @@ -26,7 +26,7 @@ sub display { if ( $form->{lynx} ) { - $menu = new Menu "$menufile"; + $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"; @@ -81,7 +81,7 @@ sub acc_menu { } else { - my $menu = new Menu "$menufile"; + 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"; @@ -136,7 +136,7 @@ sub section_menu { if ( $form->{lynx} ) { - $menu = new Menu "$menufile", $form->{level}; + $menu = new LedgerSMB::Menufile "$menufile", $form->{level}; $menu->add_file("custom_$menufile") if -f "custom_$menufile"; $menu->add_file("$form->{login}_$menufile") @@ -344,7 +344,7 @@ sub menubar { if ( $form->{lynx} ) { - $menu = new Menu "$menufile", ""; + $menu = new LedgerSMB::Menufile "$menufile", ""; # build menubar @menuorder = $menu->access_control( \%myconfig, "" ); diff --git a/t/01-load.t b/t/01-load.t index 8b83013e..60461f02 100644 --- a/t/01-load.t +++ b/t/01-load.t @@ -2,7 +2,7 @@ use strict; use warnings; -use Test::More tests => 31; +use Test::More tests => 30; use_ok('LedgerSMB'); use_ok('LedgerSMB::AA'); @@ -17,12 +17,11 @@ use_ok('LedgerSMB::HR'); use_ok('LedgerSMB::IC'); use_ok('LedgerSMB::IR'); use_ok('LedgerSMB::IS'); -use_ok('LedgerSMB::Inifile'); +use_ok('LedgerSMB::Menufile'); use_ok('LedgerSMB::JC'); use_ok('LedgerSMB::Locale'); use_ok('LedgerSMB::Log'); use_ok('LedgerSMB::Mailer'); -use_ok('LedgerSMB::Menu'); use_ok('LedgerSMB::Num2text'); use_ok('LedgerSMB::OE'); use_ok('LedgerSMB::OP'); diff --git a/t/10-form.t b/t/10-form.t index 6c170a80..2a5765e5 100644 --- a/t/10-form.t +++ b/t/10-form.t @@ -1,35 +1,25 @@ #!/usr/bin/perl -##format_amount in 02-number-handling.t -##parse_amount in 02-number-handling.t -##round_amount in 02-number-handling.t -##current_date in 03-date-handling.t -##split_date in 03-date-handling.t -##format_date in 03-date-handling.t -##from_to in 03-date-handling.t -##datetonum in 03-date-handling.t -##add_date in 03-date-handling.t - -##escape in 10-form.t -##unescape in 10-form.t -##quote in 10-form.t -##unquote in 10-form.t -##numtextrows in 10-form.t -##debug in 10-form.t -##hide_form in 10-form.t -##info in 10-form.t -##error in 10-form.t -##isblank in 10-form.t -##header in 10-form.t -##sort_columns in 10-form.t -##sort_order in 10-form.t -##print_button in 10-form.t - -##encode_all null -##decode_all null +# +# t/10-form.t +# +# Tests various functions in LedgerSMB::Form that aren't tested elsewhere. +# + +# format_amount in 02-number-handling.t +# parse_amount in 02-number-handling.t +# round_amount in 02-number-handling.t +# current_date in 03-date-handling.t +# split_date in 03-date-handling.t +# format_date in 03-date-handling.t +# from_to in 03-date-handling.t +# datetonum in 03-date-handling.t +# add_date in 03-date-handling.t + +# encode_all empty +# decode_all empty ##sub new { ##sub dberror { -##sub redirect { ##sub db_parse_numeric { ##sub callproc { ##sub get_my_emp_num { @@ -91,6 +81,10 @@ sub form_error_func { print $_[0]; } +sub redirect { + print "redirected\n"; +} + my $form = new Form; my %myconfig; my $utfstr; @@ -222,6 +216,7 @@ SKIP: { is($form->info('hello world'), 'hello world', 'info: CLI, function call'); }; +delete $ENV{info_function}; ## $form->error checks $form = new Form; @@ -415,3 +410,17 @@ is($trap->stdout, "