Here's a test suite for Net::Config. In the process of writing this, I've fixed an apparent bug that prevented single values from becoming array references when necessary. I think it's right, but perhaps Graham should weigh in on this.
In the process, with some advice from perl-qa, I've added a mock object so the test could control the output of Socket::inet_ntoa() and Socket::inet_aton(). t/lib/Mock/ seemed like as good a place as any. I'm happy to rework this patch if it personally offends anyone whose opinion matters. :) -- c --- lib/Net/~Config.pm Sat Oct 20 01:23:46 2001 +++ lib/Net/Config.pm Sat Oct 20 01:23:54 2001 @@ -13,7 +13,7 @@ @EXPORT = qw(%NetConfig); @ISA = qw(Net::LocalCfg Exporter); -$VERSION = "1.05"; # $Id: //depot/libnet/Net/Config.pm#9 $ +$VERSION = "1.06"; # $Id: //depot/libnet/Net/Config.pm#9 $ eval { local $SIG{__DIE__}; require Net::LocalCfg }; @@ -54,11 +54,11 @@ } my ($k,$v); while(($k,$v) = each %NetConfig) { - $v = [ $v ] - if($k =~ /_hosts$/ && !ref($v)); + $NetConfig{$k} = [ $v ] + if($k =~ /_hosts$/ && !ref($v)); } -# Take a hostname and determine if it is inside te firewall +# Take a hostname and determine if it is inside the firewall sub requires_firewall { shift; # ignore package --- ~MANIFEST Sat Oct 20 01:24:04 2001 +++ MANIFEST Sat Oct 20 01:24:42 2001 @@ -1065,6 +1065,7 @@ lib/Net/Cmd.pm libnet lib/Net/Config.eg libnet lib/Net/Config.pm libnet +lib/Net/Config.pm libnet (see if Net::Config works) lib/Net/demos/ftp libnet lib/Net/demos/inetd libnet lib/Net/demos/nntp libnet --- /dev/null Thu Aug 30 03:54:37 2001 +++ t/lib/Mock/Socket.pm Sat Oct 20 00:02:49 2001 @@ -0,0 +1,31 @@ +package Mock::Socket; + +# this is not the package you're looking for + +package Socket; + +$INC{'Socket.pm'} = 1; + +use Exporter; +@Socket::ISA = ( 'Exporter' ); +@EXPORT = qw( &inet_aton &inet_ntoa ); + +my (%aton, %ntoa); + +sub set_dns { + while (my ($name, $number) = splice(@_, 0, 2)) { + my $packed = unpack( "N", pack("C*", split(/\./, $number))); + $aton{$name} = $packed; + $ntoa{$packed} = $number; + } +} + +sub inet_aton { + return $aton{$_[0]}; +} + +sub inet_ntoa { + return $ntoa{$_[0]}; +} + +1; --- /dev/null Thu Aug 30 03:54:37 2001 +++ lib/Net/Config.t Sat Oct 20 01:18:50 2001 @@ -0,0 +1,85 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + @INC = ( 'lib', '../lib' ); +} + +# lots of magic, see t/lib/Mock/Socket +use Mock::Socket; +use Test::More tests => 14; + +use_ok( 'Net::Config' ); +ok( keys %NetConfig, '%NetConfig should be imported' ); + +undef $NetConfig{'ftp_firewall'}; +is( Net::Config->requires_firewall, 0, + 'requires_firewall() should return 0 without ftp_firewall defined' ); + +# this calls inet_aton in the mock Socket, so it *may* not be portable +$NetConfig{'ftp_firewall'} = 1; +is( Net::Config->requires_firewall, -1, + '... should return -1 without a valid hostname' ); + +# use the mock Socket to resolve addresses our way +Socket::set_dns( localhost => '127.0.0.1', remotehost => '192.168.10.0' ); +delete $NetConfig{'local_netmask'}; +is( Net::Config->requires_firewall('localhost'), 0, + '... should return 0 without local_netmask defined' ); + +# +$NetConfig{'local_netmask'} = '127.0.0.1/24'; +is( Net::Config->requires_firewall('localhost'), 0, + '... should return false if host is within netmask' ); +is( Net::Config->requires_firewall('remotehost'), 1, + '... should return true if host is outside netmask' ); + +# now try more netmasks +Socket::set_dns( otherlocal => '10.10.255.254' ); +$NetConfig{'local_netmask'} = [ '127.0.0.1/24', '10.0.0.0/8' ]; +is( Net::Config->requires_firewall('otherlocal'), 0, + '... should find success with mutiple local netmasks' ); +is( Net::Config->requires_firewall('remotehost'), 1, + '... should handle failure with multiple local netmasks' ); + +# now fool Perl into compiling this again. HEY, LOOK OVER THERE! +my $path = $INC{'Net/Config.pm'}; +delete $INC{'Net/Config.pm'}; + +# Net::Config populates %NetConfig from 'libnet.cfg', if possible +my $wrote_file = 0; + +(my $cfgfile = $path) =~ s/Config.pm/libnet.cfg/; +if (open(OUT, '>' . $cfgfile)) { + use Data::Dumper; + print OUT Dumper({ + some_hosts => [ 1, 2, 3 ], + time_hosts => 'abc', + some_value => 11, + }); + close OUT; + $wrote_file = 1; +} + +SKIP: { + skip('could not write cfg file', 4) unless $wrote_file; + + # and here comes Net::Config, again! no import() necessary + require $path; + + is( $NetConfig{some_value}, 11, + 'Net::Config should populate %NetConfig from libnet.cfg file' ); + is( scalar @{ $NetConfig{time_hosts} }, 1, + '... should turn _hosts keys into array references' ); + is( scalar @{ $NetConfig{some_hosts} }, 3, + '... should not mangle existing array references' ); + is( $NetConfig{some_hosts}[0], 1, + '... and one last check for multivalues' ); +} + +is( \&Net::Config::is_external, \&Net::Config::requires_firewall, + 'is_external() should be an alias for requires_firewall()' ); + +END { + 1 while unlink ($cfgfile); +}