[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
SF.net SVN: ledger-smb: [1204] trunk
- Subject: SF.net SVN: ledger-smb: [1204] trunk
- From: ..hidden..
- Date: Thu, 17 May 2007 14:15:53 -0700
Revision: 1204
http://svn.sourceforge.net/ledger-smb/?rev=1204&view=rev
Author: tetragon
Date: 2007-05-17 14:15:52 -0700 (Thu, 17 May 2007)
Log Message:
-----------
Merging Inifile and Menu into Menufile
Fixed a scope bug in Menufile, and added more tests
Modified Paths:
--------------
trunk/LedgerSMB/Locale.pm
trunk/bin/menu.pl
trunk/t/01-load.t
trunk/t/10-form.t
trunk/t/11-ledgersmb.t
Added Paths:
-----------
trunk/LedgerSMB/Menufile.pm
trunk/t/12-menufile.t
trunk/t/98-pod-coverage.t
trunk/t/data/
trunk/t/data/12-menu1.ini
trunk/t/data/12-menu2.ini
trunk/t/data/12-menu3.ini
trunk/t/data/12-menu4.ini
Removed Paths:
-------------
trunk/LedgerSMB/Inifile.pm
trunk/LedgerSMB/Menu.pm
Deleted: trunk/LedgerSMB/Inifile.pm
===================================================================
--- trunk/LedgerSMB/Inifile.pm 2007-05-17 15:25:20 UTC (rev 1203)
+++ trunk/LedgerSMB/Inifile.pm 2007-05-17 21:15:52 UTC (rev 1204)
@@ -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 <..hidden..>
-#
-#======================================================================
-#
-# 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 (<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;
-
-}
-
-1;
-
Modified: trunk/LedgerSMB/Locale.pm
===================================================================
--- trunk/LedgerSMB/Locale.pm 2007-05-17 15:25:20 UTC (rev 1203)
+++ trunk/LedgerSMB/Locale.pm 2007-05-17 21:15:52 UTC (rev 1204)
@@ -1,3 +1,4 @@
+
=head1 NAME
LedgerSMB::Locale Locale handling class for LedgerSMB
Deleted: trunk/LedgerSMB/Menu.pm
===================================================================
--- trunk/LedgerSMB/Menu.pm 2007-05-17 15:25:20 UTC (rev 1203)
+++ trunk/LedgerSMB/Menu.pm 2007-05-17 21:15:52 UTC (rev 1204)
@@ -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 <..hidden..>
-#
-#======================================================================
-#
-# This file has undergone whitespace cleanup.
-#
-#======================================================================
-#
-# routines for menu items
-#
-#=====================================================================
-
-package Menu;
-
-use LedgerSMB::Inifile;
..hidden.. = 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|<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;
-
Copied: trunk/LedgerSMB/Menufile.pm (from rev 1203, trunk/LedgerSMB/Menu.pm)
===================================================================
--- trunk/LedgerSMB/Menufile.pm (rev 0)
+++ trunk/LedgerSMB/Menufile.pm 2007-05-17 21:15:52 UTC (rev 1204)
@@ -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 <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 <..hidden..>
+ #
+ #=====================================================================
+=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;
Modified: trunk/bin/menu.pl
===================================================================
--- trunk/bin/menu.pl 2007-05-17 15:25:20 UTC (rev 1203)
+++ trunk/bin/menu.pl 2007-05-17 21:15:52 UTC (rev 1204)
@@ -16,7 +16,7 @@
#######################################################################
$menufile = "menu.ini";
-use LedgerSMB::Menu;
+use LedgerSMB::Menufile;
1;
@@ -26,7 +26,7 @@
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 @@
}
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 @@
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 @@
if ( $form->{lynx} ) {
- $menu = new Menu "$menufile", "";
+ $menu = new LedgerSMB::Menufile "$menufile", "";
# build menubar
@menuorder = $menu->access_control( \%myconfig, "" );
Modified: trunk/t/01-load.t
===================================================================
--- trunk/t/01-load.t 2007-05-17 15:25:20 UTC (rev 1203)
+++ trunk/t/01-load.t 2007-05-17 21:15:52 UTC (rev 1204)
@@ -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::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');
Modified: trunk/t/10-form.t
===================================================================
--- trunk/t/10-form.t 2007-05-17 15:25:20 UTC (rev 1203)
+++ trunk/t/10-form.t 2007-05-17 21:15:52 UTC (rev 1204)
@@ -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
+#
+# t/10-form.t
+#
+# Tests various functions in LedgerSMB::Form that aren't tested elsewhere.
+#
-##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
+# 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 null
-##decode_all null
+# 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 @@
print $_[0];
}
+sub redirect {
+ print "redirected\n";
+}
+
my $form = new Form;
my %myconfig;
my $utfstr;
@@ -222,6 +216,7 @@
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 @@
## $form->like checks
$form = new Form;
is($form->like('hello world'), '%hello world%', 'like');
+
+## $form->redirect checks
+$form = new Form;
+ok(!defined $form->{callback}, 'redirect: No callback set');
..hidden.. = trap{$form->redirect};
+is($trap->stdout, "redirected\n", 'redirect: No message or callback redirect');
..hidden.. = trap{$form->redirect('hello world')};
+is($trap->stdout, "hello world\n",
+ 'redirect: message, no callback redirect');
+$form->{callback} = 1;
..hidden.. = trap{$form->redirect};
+is($trap->stdout, "redirected\n", 'redirect: callback, no message redirect');
..hidden.. = trap{$form->redirect("hello world\n")};
+is($trap->stdout, "redirected\n", 'redirect: callback and message redirect');
Modified: trunk/t/11-ledgersmb.t
===================================================================
--- trunk/t/11-ledgersmb.t 2007-05-17 15:25:20 UTC (rev 1203)
+++ trunk/t/11-ledgersmb.t 2007-05-17 21:15:52 UTC (rev 1204)
@@ -140,7 +140,7 @@
$lsmb->{file} = 't/this is a bad directory, I do not exist/foo';
@r = trap {$lsmb->debug('file' => $lsmb->{file}, $lsmb)};
-like($trap->die, qr/No such file or directory at LedgerSMB\.pm/,
+like($trap->die, qr/No such file or directory/,
"debug: open failure causes death");
ok(!-e $lsmb->{file}, "debug: file creation failed");
Added: trunk/t/12-menufile.t
===================================================================
--- trunk/t/12-menufile.t (rev 0)
+++ trunk/t/12-menufile.t 2007-05-17 21:15:52 UTC (rev 1204)
@@ -0,0 +1,143 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+$ENV{TMPDIR} = 't/var';
+
+use Test::More tests => 42;
+use Test::Trap qw(trap $trap);
+
+use LedgerSMB::Form;
+use LedgerSMB::Menufile;
+
+my $ini;
+my @r;
+my $form;
+my $myconfig;
+
+# general new and add_file checks
+$ini = new LedgerSMB::Menufile;
+ok(defined $ini, 'new: File not provided');
+isa_ok($ini, 'LedgerSMB::Menufile', 'new: File not provided gives correct type');
+$ini->add_file('t/data/12-menu1.ini');
+is_deeply($ini->{'AR--Add Transaction'},
+ {'action' => 'add', 'module' => 'ar.pl'},
+ 'add_file: First file added, leaf correct');
+is_deeply($ini->{'ORDER'},
+ ['AR', 'AR--Add Transaction'],
+ 'add_file: First file added, order correct');
+
+$ini->add_file('t/data/12-menu2.ini');
+is_deeply($ini->{'AR--Add Transaction'},
+ {'action' => 'add', 'module' => 'ar.pl'},
+ 'add_file: Second file added, old leaf correct');
+is_deeply($ini->{'AR--foo'},
+ {'module' => 'am.pl'},
+ 'add_file: Second file added, new leaf correct');
+is_deeply($ini->{'ORDER'},
+ ['AR', 'AR--Add Transaction', 'section', 'AR--foo'],
+ 'add_file: Second file added, order correct');
+
+$ini = LedgerSMB::Menufile->new('t/data/12-menu2.ini');
+ok(defined $ini, 'new: File provided');
+isa_ok($ini, 'LedgerSMB::Menufile', 'new: File provided gives correct type');
+is_deeply($ini->{'AR--foo'},
+ {'module' => 'am.pl'},
+ 'new: File provided, leaf correct');
+is_deeply($ini->{'ORDER'},
+ ['section', 'AR--foo'],
+ 'new: File provided, order correct');
+
+$ini->add_file('t/data/12-menu3.ini');
+is_deeply($ini->{'AR--foo'},
+ {'module' => 'ax.pl'},
+ 'add_file: Data re-added, leaf correct, not duplicated');
+is_deeply($ini->{'ORDER'},
+ ['section', 'AR--foo'],
+ 'add_file: Data re-added, order correct, not duplicated');
+
+# menuitem checks
+$form = new Form;
+$form->{script} = 'tt.pl';
+$form->{tag} = '1';
+$myconfig = {'login' => 'testuser', 'numberformat' => '1000.00'};
+$ini = new LedgerSMB::Menufile('t/data/12-menu4.ini');
+is_deeply($ini->{'AR--foo'},
+ {'module' => 'ax.pl', 'action' => 'add', 'type' => 'foo'},
+ 'new: Data for menu item test 1 correct');
+is_deeply($ini->{'New Window'}, {'target' => '_blank'},
+ 'new: Data for menu item test 2 correct');
+is_deeply($ini->{'Website'}, {'href' => 'ledgersmb.org'},
+ 'new: Data for menu item test 3 correct');
+is_deeply($ini->{'AR--test'},
+ {'module' => 'test', 'apples' => 'login=', 'pears' => 'numberformat=2'},
+ 'new: Data for menu item test 4 correct');
+is_deeply($ini->{'AR'}, {'target' => 'acc_menu', 'type' => 'test'},
+ 'new: Data for menu item test 5 correct');
+
+is($ini->menuitem($myconfig, $form, 'AR--foo'), '<a style="display:block;"href="ax.pl?path=bin/mozilla&action=add&level=AR--foo&login=&timeout=&sessionid=&js=&type=foo">',
+ 'menuitem: Menu item test 1, base');
+ok(!defined $ini->{'AR--foo'}->{'module'}, 'menuitem: Deleted module');
+ok(!defined $ini->{'AR--foo'}->{'action'}, 'menuitem: Deleted action');
+is($ini->menuitem($myconfig, $form, 'New Window'), '<a style="display:block;"href="tt.pl?path=bin/mozilla&action=section_menu&level=New%20Window&login=&timeout=&sessionid=&js=" target="_blank">',
+ 'menuitem: Menu item test 2, target');
+is($ini->menuitem($myconfig, $form, 'Website'), '<a href="ledgersmb.org">',
+ 'menuitem: Menu item test 3, href');
+ok(!defined $ini->{'Website'}->{'href'}, 'menuitem: Deleted href');
+$form->{menubar} = 1;
+is($ini->menuitem($myconfig, $form, 'AR--test'), '<a style=""href="test?path=bin/mozilla&action=section_menu&level=AR--test&login=&timeout=&sessionid=&js=&apples=testuser&pears=1000.002">',
+ 'menuitem: Menu item test 4, myconfig substitutions');
+is($ini->menuitem($myconfig, $form, 'AR'), '<a style=""href="tt.pl?path=bin/mozilla&action=section_menu&level=AR&login=&timeout=&sessionid=&js=&type=test#id1" target="acc_menu">',
+ 'menuitem: Menu item test 5, acc_menu');
+ok(!defined $ini->{'AR'}->{'target'}, 'menuitem: Deleted target');
+
+# access_control check
+$myconfig = {'acs' => 'AR--test'};
+$ini = new LedgerSMB::Menufile('t/data/12-menu4.ini');
+is_deeply([$ini->access_control($myconfig)], ['AR', 'New Window', 'Website'],
+ 'access_control: Single item, not top exclusion, top');
+is_deeply([$ini->access_control($myconfig, 'AR')], ['AR--foo'],
+ 'access_control: Single item, not top exclusion, submenu');
+$myconfig = {'acs' => 'Website'};
+is_deeply([$ini->access_control($myconfig)], ['AR', 'New Window'],
+ 'access_control: Single item, top exclusion, top');
+is_deeply([$ini->access_control($myconfig, 'AR')], ['AR--foo', 'AR--test'],
+ 'access_control: Single item, top exclusion, sub menu');
+$myconfig = {'acs' => 'AR--test;AR--foo;New Window'};
+is_deeply([$ini->access_control($myconfig)], ['AR', 'Website'],
+ 'access_control: Multiple items, top');
+is_deeply([$ini->access_control($myconfig, 'AR')], [],
+ 'access_control: Multiple items, sub menu');
+$myconfig = {'acs' => 'AR'};
+is_deeply([$ini->access_control($myconfig)], ['New Window', 'Website'],
+ 'access_control: Top menu exclusion, top');
+is_deeply([$ini->access_control($myconfig, 'AR')], ['AR--foo', 'AR--test'],
+ 'access_control: Top menu exclusion, sub menu');
+
+# file not found check
+$ini = new LedgerSMB::Menufile;
..hidden.. = trap{$ini->add_file('t/data/12-not-a-file')};
+is_deeply($ini->{'ORDER'}, [],
+ 'add_file: Non-existent file added, order correct');
+like($trap->die, qr|12-not-a-file :|,
+ 'add_file: Non-existent file causes error display');
+
+# Gratuitous testing to increase coverage rating
+$ini = undef;
..hidden.. = trap{$ini = LedgerSMB::Menufile::new};
+isa_ok($ini, 'main', 'new: No type passed gives main type');
+
+my $pkg = 'foo';
+$ini = undef;
..hidden.. = trap{$ini = LedgerSMB::Menufile::new(\$pkg)};
+like($trap->{warn}[0], qr|has no copy constructor! creating a new object|,
+ 'new: Type passed scalar reference');
+isa_ok($ini, 'SCALAR', 'new: Type passed scalar reference gives SCALAR type');
+LedgerSMB::Menufile::add_file($ini, 't/data/12-menu1.ini');
+is_deeply($ini->{'AR--Add Transaction'},
+ {'action' => 'add', 'module' => 'ar.pl'},
+ 'add_file: File added to SCALAR, leaf correct');
+is_deeply($ini->{'ORDER'},
+ ['AR', 'AR--Add Transaction'],
+ 'add_file: File added to SCALAR, order correct');
Added: trunk/t/98-pod-coverage.t
===================================================================
--- trunk/t/98-pod-coverage.t (rev 0)
+++ trunk/t/98-pod-coverage.t 2007-05-17 21:15:52 UTC (rev 1204)
@@ -0,0 +1,19 @@
+#!/usr/bin/perl
+#
+# t/98-pod-coverage.t
+#
+# Checks POD coverage.
+#
+
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+use Test::More;
+eval "use Test::Pod::Coverage";
+plan skip_all => "Test::Pod::Coverage required for testing POD coverage" if $@;
+
+pod_coverage_ok("LedgerSMB");
+pod_coverage_ok("LedgerSMB::Locale");
+pod_coverage_ok("LedgerSMB::Log");
+pod_coverage_ok("LedgerSMB::Menufile");
Added: trunk/t/data/12-menu1.ini
===================================================================
--- trunk/t/data/12-menu1.ini (rev 0)
+++ trunk/t/data/12-menu1.ini 2007-05-17 21:15:52 UTC (rev 1204)
@@ -0,0 +1,5 @@
+[AR]
+
+[AR--Add Transaction]
+module=ar.pl
+action=add
Added: trunk/t/data/12-menu2.ini
===================================================================
--- trunk/t/data/12-menu2.ini (rev 0)
+++ trunk/t/data/12-menu2.ini 2007-05-17 21:15:52 UTC (rev 1204)
@@ -0,0 +1,9 @@
+# Second test inifile
+[section] ; New section
+[AR--foo] ; But appending now to an old one
+module=am.pl
+.
+No more content... Time to go home
+Yes, really.
+[This is not a real section]
+not=real
Added: trunk/t/data/12-menu3.ini
===================================================================
--- trunk/t/data/12-menu3.ini (rev 0)
+++ trunk/t/data/12-menu3.ini 2007-05-17 21:15:52 UTC (rev 1204)
@@ -0,0 +1,9 @@
+# Third test inifile
+[AR--foo] ; But appending now to an old one
+module=ax.pl
+[section] ; New section
+.
+No more content... Time to go home
+Yes, really.
+[This is not a real section]
+not=real
Added: trunk/t/data/12-menu4.ini
===================================================================
--- trunk/t/data/12-menu4.ini (rev 0)
+++ trunk/t/data/12-menu4.ini 2007-05-17 21:15:52 UTC (rev 1204)
@@ -0,0 +1,19 @@
+# Fourth test menu file
+[AR]
+type=test
+target=acc_menu
+
+[AR--foo]
+module=ax.pl
+action=add
+type=foo
+[AR--test]
+module=test
+apples=login= ; becomes apples=$myconfig->{login}
+pears=numberformat=2 ; becomes pears=$myconfig->{numberformat}2
+
+[New Window]
+target=_blank
+
+[Website]
+href=ledgersmb.org
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.