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
+++ MANIFESTSat 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/inetdlibnet
lib/Net/demos/nntp libnet
--- /dev/null Thu Aug 30 03:54:37 2001
+++ t/lib/Mock/Socket.pmSat 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.tSat 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
