test adjustments for WebGUI::Paths

lib/WebGUI/Config.pm

@@ -164,7 +164,7 @@ sub new {
         return $config{$filename};
     }
     else {
-        my $self = $class->SUPER::new($fullPath);
+        my $self = $class->SUPER::new($filename);
         $config{$filename} = $self unless $noCache;
         return $self;
     }
@@ -186,7 +186,7 @@ sub readAllConfigs {
     my @configs = WebGUI::Paths->siteConfigs;
     my %configs = map {
         $_ => $class->new($_);
-    } @configs
+    } @configs;
     return \%configs;
 }
 

lib/WebGUI/Paths.pm

@@ -39,7 +39,7 @@ These methods are available from this class:
 =cut
 
 BEGIN {
-    use Sub::Name qw(subname);
+    use Class::MOP;
     my $root = realpath(catdir(
         catpath((splitpath(__FILE__))[0,1], ''), (updir) x 2
     ));
@@ -47,18 +47,18 @@ BEGIN {
         configBase         => catdir($root, 'etc'),
         logConfig          => catfile($root, 'etc', 'log.conf'),
         spectreConfig      => catfile($root, 'etc', 'spectre.conf'),
-        upgrades           => catfile($root, 'docs', 'upgrades'),
         preloadCustom      => catfile($root, 'etc', 'preload.custom'),
         preloadExclusions  => catfile($root, 'etc', 'preload.exclude'),
+        upgrades           => catdir($root, 'docs', 'upgrades'),
         extras             => catdir($root, 'www', 'extras'),
         defaultUploads     => catdir($root, 'www', 'uploads'),
         defaultCreateSQL   => catdir($root, 'docs', 'create.sql'),
         var                => catdir($root, 'var'),
     );
+    my $meta = Class::MOP::Class->initialize(__PACKAGE__);
     for my $sub (keys %paths) {
         my $path = $paths{$sub};
-        no strict 'refs';
+        $meta->add_method( $sub, sub () { $path } );
-        *{$sub} = subname $sub => sub () { $path };
     }
 }
 
@@ -77,7 +77,7 @@ sub import {
         }
     }
     if (@invalid) {
-        die 'Invalid options ' . join(', ', @invalid);
+        croak 'Invalid options ' . join(', ', @invalid);
     }
 }
 
@@ -105,7 +105,8 @@ sub preloadPaths {
     try {
         @paths = grep {
             (-d) ? 1 : do {
-                warn "WARNING: Not adding lib directory '$_' from @{[$class->preloadCustom]}: Directory does not exist.\n";
+                warn "WARNING: Not adding lib directory '$_' from "
+                    . $class->preloadCustom . ": Directory does not exist.\n";
                 0;
             }
         } _readTextLines($class->preloadCustom);
@@ -132,7 +133,7 @@ sub preloadAll {
 
     WebGUI::Pluggable::findAndLoad( 'WebGUI', {
         exclude     => \( $class->preloadExclude ),
-        onLoadFail  => sub { warn sprintf 'Error loading %s: %s', @_ },
+        onLoadFail  => sub { warn sprintf "Error loading %s: %s\n", @_ },
     });
 }
 

lib/WebGUI/Session.pm

@@ -459,7 +459,7 @@ sub open {
 	my $request = shift;
 	my $server = shift;
     my $config;
-    if (try { $configFile->isa('WebGUI::Config' }) {
+    if (eval { $configFile->isa('WebGUI::Config') } ) {
         $config = $configFile;
     }
     else {

sbin/.gitignore

@@ -1,2 +0,0 @@
-/preload.custom
-/preload.exclude

t/Config.t

@@ -19,7 +19,6 @@ use File::Basename qw(basename);
 
 my $config     = WebGUI::Test->config;
 my $configFile = WebGUI::Test->file;
-my $webguiRoot = WebGUI::Test->root;
 
 ok( defined $config, "load config" );
 ok( $config->get("dsn") ne "", "get()" );

t/Help/isa.t

@@ -30,7 +30,8 @@ my $session = WebGUI::Test->session;
 
 plan tests => 4;
 
-installCollateral();
+local @INC = @INC;
+unshift @INC, File::Spec->catdir( WebGUI::Test->getTestCollateralPath, 'Help-isa', 'lib' );
 
 my $allHelp = WebGUI::Operation::Help::_load($session, 'HelpTest');
 
@@ -166,14 +167,3 @@ cmp_deeply(
     'isa imports variables with nested loops'
 );
 
-sub installCollateral {
-	copy( 
-        File::Spec->catfile( WebGUI::Test->getTestCollateralPath, qw/Help HelpTest.pm/),
-		File::Spec->catfile( WebGUI::Test->lib, qw/WebGUI Help/)
-	);
-}
-
-END {
-	unlink File::Spec->catfile(WebGUI::Test->lib, qw/WebGUI Help HelpTest.pm/);
-}
-

t/International.t

@@ -49,7 +49,8 @@ is($i18n->getNamespace(), 'Asset', 'getNamespace: set namespace to Asset');
 is($i18n->get('topicName'), 'Assets', 'get: get English label for topicName in Asset: Assets');
 is($i18n->get('topicName', 'WebGUI'), 'WebGUI', 'get: test manual namespace override');
 
-installPigLatin();
+local @INC = @INC;
+unshift @INC, File::Spec->catdir( WebGUI::Test->getTestCollateralPath, 'International', 'lib' );
 
 #tests for sub new
 my $i18nNew1 = WebGUI::International->new($session);
@@ -99,40 +100,24 @@ is($i18n->getLanguage('English', 'label'), 'English', 'getLanguage, specific pro
 
 isa_ok($i18n->getLanguage('English'), 'HASH', 'getLanguage, without a specific property returns a hashref');
 
-}
-
-sub installPigLatin {
-	mkdir File::Spec->catdir(WebGUI::Test->lib, 'WebGUI', 'i18n', 'PigLatin');
-	copy( 
-		WebGUI::Test->getTestCollateralPath('WebGUI.pm'),
-		File::Spec->catfile(WebGUI::Test->lib, qw/WebGUI i18n PigLatin WebGUI.pm/)
-	);
-	copy(
-		WebGUI::Test->getTestCollateralPath('PigLatin.pm'),
-		File::Spec->catfile(WebGUI::Test->lib, qw/WebGUI i18n PigLatin.pm/)
-	);
-}
-
 #test for sub new with language overridden by scratch
 my $formvariables = {
-        'op' =>'setLanguage',
+    'op' =>'setLanguage',
-        'language' => 'PigLatin'
+    'language' => 'PigLatin'
 };
 $session->request->setup_body($formvariables);
 WebGUI::Content::SetLanguage::handler($session);
 my $newi18n = WebGUI::International->new($session);
-        is(
+is(
-                $newi18n->get('webgui','WebGUI','PigLatin'),
+    $newi18n->get('webgui','WebGUI','PigLatin'),
-                'ebGUIWay',
+    'ebGUIWay',
-                'if the piglatin language is in the scratch that messages should be retrieved'
+    'if the piglatin language is in the scratch that messages should be retrieved'
 );
-	is(
+is(
-		$newi18n->get('104','Asset','PigLatin'),
+    $newi18n->get('104','Asset','PigLatin'),
-                $newi18n->get('104', 'WebGUI', 'English'),
+    $newi18n->get('104', 'WebGUI', 'English'),
-                'Language check after SetLanguage contentHandler : key from missing file return English key'
+    'Language check after SetLanguage contentHandler : key from missing file return English key'
 );
-END {
+
-	unlink File::Spec->catfile(WebGUI::Test->lib, qw/WebGUI i18n PigLatin WebGUI.pm/);
-	unlink File::Spec->catfile(WebGUI::Test->lib, qw/WebGUI i18n PigLatin.pm/);
-	rmdir File::Spec->catdir(WebGUI::Test->lib, qw/WebGUI i18n PigLatin/);
 }
+

t/Macro/FetchMimeType.t

@@ -59,7 +59,7 @@ plan tests => $numTests;
 
 foreach my $testSet (@testSets) {
 	my $file = $testSet->{input}
-		 ? join '/', WebGUI::Test->root, 'www/extras', $testSet->{input}
+		 ? join '/', WebGUI::Paths->extras, $testSet->{input}
 		 : $testSet->{input};
 	my $output = WebGUI::Macro::FetchMimeType::process($session, $file);
 	is($output, $testSet->{output}, $testSet->{comment} );

t/Paths.t

@@ -2,13 +2,35 @@ use 5.010;
 use strict;
 use warnings;
 
-use Test::More tests => 2;                      # last test to print
+use Test::More tests => 3;
 use WebGUI::Paths;
 
-can_ok 'WebGUI::Paths', qw(configBase logConfig spectreConfig upgradesPath preloadCustom preloadExclusions extras defaultUploads defaultCreateSQL);
+can_ok 'WebGUI::Paths', qw(
-ok !(grep { WebGUI::Paths->can($_) }
+    configBase
-    qw(croak realpath catdir splitpath catpath splitpath updir catfile try catch _readTextLines subname)),
+    logConfig
-    'Internal functions cleaned up';
+    spectreConfig
+    preloadCustom
+    preloadExclusions
+    upgrades
+    extras
+    defaultUploads
+    defaultCreateSQL
+    var
+);
+ok !(grep { WebGUI::Paths->can($_) } qw(
+    croak
+    realpath
+    catdir
+    splitpath
+    catpath
+    splitpath
+    updir
+    catfile
+    try
+    catch
+    _readTextLines
+    subname
+)), 'Internal functions cleaned up';
 
 my @configs = WebGUI::Paths->siteConfigs;
 ok !(\@configs ~~ WebGUI::Paths->spectreConfig), 'Spectre config not listed in configs';

t/Pluggable.t

@@ -65,13 +65,12 @@ is($dumper->Dump, q|$VAR1 = {
 #----------------------------------------------------------------------------
 # Test find and findAndLoad
 { # Block to localize @INC
-    my $lib     = WebGUI::Test->lib;
+    local @INC  = ( File::Spec->catdir( WebGUI::Test->getTestCollateralPath, 'Pluggable', 'lib' );
-    local @INC  = ( $lib );
 
     # Use the i18n files to test
     my @testFiles   = ();
-    File::Find::find( 
+    File::Find::find(
-        sub { 
+        sub {
             if ( !/^[.]/ && /[.]pm$/ ) {
                 my $name    = $File::Find::name;
                 $name   =~ s{^$lib[/]}{};
@@ -80,59 +79,57 @@ is($dumper->Dump, q|$VAR1 = {
                 push @testFiles, $name;
             }
         },
-        File::Spec->catfile( $lib, 'WebGUI', 'i18n' ),
+        File::Spec->catfile( $lib, 'WebGUI', 'Test', 'Pluggable' ),
     );
 
     cmp_deeply(
-        [ WebGUI::Pluggable::find( 'WebGUI::i18n' ) ],
+        [ WebGUI::Pluggable::find( 'WebGUI::Test::Pluggable' ) ],
         bag( @testFiles ),
         "find() finds all modules by default",
     );
 
     cmp_deeply(
-        [ WebGUI::Pluggable::find( 'WebGUI::i18n', { onelevel => 1 } ) ],
+        [ WebGUI::Pluggable::find( 'WebGUI::Test::Pluggable', { onelevel => 1 } ) ],
-        bag( grep { /^WebGUI::i18n::[^:]+$/ } @testFiles ),
+        bag( grep { /^WebGUI::Test::Pluggable::[^:]+$/ } @testFiles ),
         "find() with onelevel",
     );
 
     cmp_deeply(
-        [ WebGUI::Pluggable::find( 'WebGUI::i18n', { exclude => [ 'WebGUI::i18n::English::WebGUI' ] } ) ],
+        [ WebGUI::Pluggable::find( 'WebGUI::Test::Pluggable', { exclude => [ 'WebGUI::Test::Pluggable::Second' ] } ) ],
-        bag( grep { $_ ne 'WebGUI::i18n::English::WebGUI' } @testFiles ),
+        bag( grep { $_ ne 'WebGUI::Test::Pluggable::Second' } @testFiles ),
         "find() with exclude",
     );
 
     cmp_deeply(
-        [ WebGUI::Pluggable::find( 'WebGUI::i18n', { exclude => [ 'WebGUI::i18n::English::WebGUI*' ] } ) ],
+        [ WebGUI::Pluggable::find( 'WebGUI::Test::Pluggable', { exclude => [ 'WebGUI::Test::Pluggable::First*' ] } ) ],
-        bag( grep { $_ ne 'WebGUI::i18n::English::WebGUI' && $_ ne 'WebGUI::i18n::English::WebGUIProfile' } @testFiles ),
+        bag( grep { $_ ne 'WebGUI::Test::Pluggable::First' && $_ ne 'WebGUI::Test::Pluggable::FirstOne' } @testFiles ),
         "find() with exclude with glob",
     );
 
     cmp_deeply(
-        [ WebGUI::Pluggable::find( 'WebGUI::i18n', { exclude => [ 'WebGUI::i18n::English*' ] } ) ],
+        [ WebGUI::Pluggable::find( 'WebGUI::Test::Pluggable', { exclude => [ 'WebGUI::Test::Pluggable*' ] } ) ],
         [], 
         "find() with exclude with massive glob",
     );
 
     cmp_deeply(
-        [ WebGUI::Pluggable::find( 'WebGUI::i18n', { exclude => [ 'WebGUI::i18n::English::WebGUI.*' ] } ) ],
+        [ WebGUI::Pluggable::find( 'WebGUI::Test::Pluggable', { exclude => [ 'WebGUI::Test::Pluggable::First.*' ] } ) ],
-        bag( grep { $_ ne 'WebGUI::i18n::English::WebGUI' && $_ ne 'WebGUI::i18n::English::WebGUIProfile' } @testFiles ),
+        bag( grep { $_ ne 'WebGUI::Test::Pluggable::First' && $_ ne 'WebGUI::Test::Pluggable::FirstOne' } @testFiles ),
         "find() with exclude with regex",
     );
 
     cmp_deeply(
-        [ WebGUI::Pluggable::find( 'WebGUI::i18n', { exclude => [ qw/WebGUI::i18n::English::WebGUI.* WebGUI::i18n::English::ShipDriver_USPS*/ ] } ) ],
+        [ WebGUI::Pluggable::find( 'WebGUI::Test::Pluggable', { exclude => [ qw/WebGUI::Test::Pluggable::First WebGUI::Test::Pluggable::Second::Child/ ] } ) ],
         bag( grep {
-            $_ ne 'WebGUI::i18n::English::WebGUI'
+            $_ ne 'WebGUI::Test::Pluggable::First'
-         && $_ ne 'WebGUI::i18n::English::WebGUIProfile'
+         && $_ ne 'WebGUI::Test::Pluggable::Second::Child'
-         && $_ ne 'WebGUI::i18n::English::ShipDriver_USPS'
-         && $_ ne 'WebGUI::i18n::English::ShipDriver_USPSInternational'
         } @testFiles ),
         "find() with multiple excludes",
     );
 
-    cmp_deeply( 
+    cmp_deeply(
-        [ WebGUI::Pluggable::find( 'WebGUI::i18n', { onelevel => 1, return => "name" } ) ],
+        [ WebGUI::Pluggable::find( 'WebGUI::Test::Pluggable', { onelevel => 1, return => "name" } ) ],
-        bag( map { /::([^:]+)$/; $1 } grep { /^WebGUI::i18n::[^:]+$/ } @testFiles ),
+        bag( map { /::([^:]+)$/; $1 } grep { /^WebGUI::Test::Pluggable::[^:]+$/ } @testFiles ),
         "find() with return => name",
     );
 };

t/Session/DateTime.t

@@ -19,8 +19,9 @@ use WebGUI::Session;
 
 use Test::More tests => 90; # increment this value for each test you create
 
-installBadLocale();
+local @INC = @INC;
- 
+unshift @INC, File::Spec->catdir( WebGUI::Test->getTestCollateralPath, 'Session-DateTime', 'lib' );
+
 my $session = WebGUI::Test->session;
 
 my $dt = $session->datetime;
@@ -298,13 +299,3 @@ $session->user({user => $dude});
 is($dt->epochToHuman($wgbday), '8/16/2001  9:00 pm', 'epochToHuman: constructs a default locale if the language does not provide one.');
 $session->user({userId => 1});
 
-sub installBadLocale {
-	copy(
-		WebGUI::Test->getTestCollateralPath('BadLocale.pm'),
-		File::Spec->catfile(WebGUI::Test->lib, qw/WebGUI i18n BadLocale.pm/)
-	);
-}
-
-END {
-	unlink File::Spec->catfile(WebGUI::Test->lib, qw/WebGUI i18n BadLocale.pm/);
-}

t/badGatewayMacros.t

@@ -25,7 +25,6 @@ use Test::More; # increment this value for each test you create
 my $numTests = 0;
 
 my $session = WebGUI::Test->session;
-my $lib = WebGUI::Test->lib;
 
 ##Find the name of the International macro in the user's config file.
 

t/hardcodedExtras.t

@@ -25,7 +25,6 @@ use Test::More; # increment this value for each test you create
 my $numTests = 0;
 
 my $session = WebGUI::Test->session;
-my $lib = WebGUI::Test->lib;
 
 my $hardcodedExtras = qr!(?:href|src)=.\^?/[(;]?extras/!;
 

t/i18n/adminConsole.t

@@ -25,7 +25,6 @@ use Test::More; # increment this value for each test you create
 my $numTests = 0;
 
 my $session = WebGUI::Test->session;
-my $lib = WebGUI::Test->lib;
 
 # put your tests here
 

t/i18n/critic_labels.t

@@ -33,6 +33,6 @@ if ($@) {
 # Init
 my $session         = WebGUI::Test->session;
 
-my $label_profile = Path::Class::File->new( WebGUI::Test->root , 't', 'i18n', 'perlcriticrc');
+my $label_profile = Path::Class::File->new( $FindBin::Bin )->parent->file('i18n', 'perlcriticrc');
 Test::Perl::Critic->import(-profile => $label_profile->stringify);
 all_critic_ok(WebGUI::Test->lib);

t/i18n/template.t

@@ -28,7 +28,6 @@ use Test::More; # increment this value for each test you create
 my $numTests = 0;
 
 my $session = WebGUI::Test->session;
-my $lib = WebGUI::Test->lib;
 
 ## Remove all macros but International, and set them to call WebGUI::Macro::Callback
 my $originalMacros = $session->config->get('macros');

t/lib/WebGUI/Test.pm

@@ -39,30 +39,14 @@ use List::MoreUtils     qw( any );
 use Carp                qw( carp croak );
 use JSON                qw( from_json to_json );
 use Scope::Guard;
+use WebGUI::Paths -inc;
+
+our $WEBGUI_TEST_COLLATERAL = File::Spec->catdir( $file_root, (File::Spec->updir) x 3, 'supporting_collateral');
 
 BEGIN {
-    my $file_root = File::Spec->catpath((File::Spec->splitpath(__FILE__))[0,1], '');
-
     our $WEBGUI_ROOT = Cwd::realpath( File::Spec->catdir( $file_root, (File::Spec->updir) x 3 ));
     our $WEBGUI_TEST_COLLATERAL = File::Spec->catdir($WEBGUI_ROOT, 't', 'supporting_collateral');
     our $WEBGUI_LIB = File::Spec->catdir( $WEBGUI_ROOT, 'lib' );
-
-    push @INC, $WEBGUI_LIB;
-
-    ##Handle custom loaded library paths
-    my $customPreload = File::Spec->catfile( $WEBGUI_ROOT, 'sbin', 'preload.custom');
-    if (-e $customPreload) {
-        open my $PRELOAD, '<', $customPreload or
-            croak "Unload to open $customPreload: $!\n";
-        LINE: while (my $line = <$PRELOAD>) {
-            $line =~ s/#.*//;
-            $line =~ s/^\s+//;
-            $line =~ s/\s+$//;
-            next LINE if !$line;
-            unshift @INC, $line;
-        }
-        close $PRELOAD;
-    }
 }
 
 use WebGUI::Asset;
@@ -169,7 +153,7 @@ If true, the session won't be registered for automatic deletion.
 sub newSession {
     my $noCleanup = shift;
     my $pseudoRequest = WebGUI::PseudoRequest->new;
-    my $session = WebGUI::Session->open( $CLASS->root, $CLASS->file );
+    my $session = WebGUI::Session->open( $CLASS->file );
     $session->{_request} = $pseudoRequest;
     if ( ! $noCleanup ) {
         $CLASS->sessionsToDelete($session);
@@ -456,18 +440,6 @@ sub lib {
 
 #----------------------------------------------------------------------------
 
-=head2 root ( )
-
-Returns the full path to the WebGUI root directory, usually /data/WebGUI.
-
-=cut
-
-sub root {
-    return our $WEBGUI_ROOT;
-}
-
-#----------------------------------------------------------------------------
-
 =head2 session ( )
 
 Returns the WebGUI::Session object that was created by the test.  This session object

t/rawHrefUrls.t

@@ -27,6 +27,10 @@ my $numTests = 0;
 
 my $session = WebGUI::Test->session;
 
+##Find the name of the International macro in the user's config file.
+
+#note "International macro name = $international";
+
 ##Regexp setup for parsing out the Macro calls.
 my $macro     = qr{
                     \^

t/supporting_collateral/Pluggable/lib/WebGUI/Test/Pluggable/First.pm

@@ -0,0 +1,10 @@
+package WebGUI::Test::Pluggable::First;
+
+$VERSION = 1.0;
+
+sub first {
+    return 1;
+}
+
+1;
+

t/supporting_collateral/Pluggable/lib/WebGUI/Test/Pluggable/FirstOne.pm

@@ -0,0 +1,10 @@
+package WebGUI::Test::Pluggable::FirstOne;
+
+$VERSION = 1.0;
+
+sub first {
+    return 1;
+}
+
+1;
+

t/supporting_collateral/Pluggable/lib/WebGUI/Test/Pluggable/Second.pm

@@ -0,0 +1,10 @@
+package WebGUI::Test::Pluggable::Second;
+
+$VERSION = 1.0;
+
+sub second {
+    return 1;
+}
+
+1;
+

t/supporting_collateral/Pluggable/lib/WebGUI/Test/Pluggable/Second/Child.pm

@@ -0,0 +1,10 @@
+package WebGUI::Test::Pluggable::Second::Sub;
+
+$VERSION = 1.0;
+
+sub child {
+    return 1;
+}
+
+1;
+