Any patches to modules from libnet, and test additions, should be
against the latest libnet on CPAN, I do not want the core to diverge.
So if a test depends on a module in the core it should check that
the module is avaliable, so that the test is skipped with older
perl releases.
Graham.
On Sat, Oct 20, 2001 at 01:32:01AM -0600, chromatic wrote:
> 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);
> +}
