1package Net::DNS::Check::Test; 2 3use strict; 4use vars qw($VERSION); 5 6use Carp; 7use Net::DNS::Check::Config; 8use Net::DNS::Check::Test::unknown; 9 10# use vars qw( %_LOADED ); 11 12my %PUBLIC_ARGS = map { $_ => 1 } qw( 13 config 14 domain 15 type 16 nsquery 17 nsauth 18 hostslist 19 debug 20); 21 22 23sub new { 24 my ($class) = shift; 25 26 unless ( @_ ) { 27 # Some error 28 return; 29 } 30 31 my (%args) = @_; 32 33 34 my $subclass = _get_subclass($class, $args{type} ); 35 36 if ($subclass) { 37 my $self = $subclass->new(@_); 38# $self->{test_detail} = {}; 39 return $self; 40 } else { 41 return new Net::DNS::Check::Test::unknown(); 42 } 43} 44 45 46# Defined in subclass 47sub test { 48 49} 50 51 52 53# 54sub test_status { 55 my $self = shift; 56 return $self->{test_status}; 57} 58 59 60# 61sub test_detail { 62 my $self = shift; 63 my $key = shift; 64 65 if ($key) { 66 if ( exists $self->{test_detail}->{$key} ) { 67 return %{ $self->{test_detail}->{$key} }; 68 } else { 69 return (); 70 } 71 } else { 72 return %{ $self->{test_detail} }; 73 74 } 75} 76 77 78sub test_detail_desc { 79 my $self = shift; 80 my $key = shift; 81 82 if ($key && exists $self->{test_detail}->{$key} ) { 83 return $self->{test_detail}->{$key}->{desc}; 84 } else { 85 return; 86 } 87} 88 89sub test_detail_status { 90 my $self = shift; 91 my $key = shift; 92 93 if ($key && exists $self->{test_detail}->{$key} ) { 94 return $self->{test_detail}->{$key}->{status}; 95 } else { 96 return; 97 } 98} 99 100 101 102 103sub _process_args { 104 my ($self, %args) = @_; 105 106 foreach my $attr ( keys %args) { 107 next unless $PUBLIC_ARGS{$attr}; 108 109 # Controllare se effettivamente funziona questo test 110 if ($attr eq 'nsquery' || $attr eq 'nsauth') { 111 unless ( UNIVERSAL::isa($args{$attr}, 'ARRAY') ) { 112 die "Net::DNS::Check::Test->new(): $attr must be an arrayref\n"; 113 } 114 } 115 116 $self->{$attr} = $args{$attr}; 117 } 118 119 $self->{config} ||= new Net::DNS::Check::Config(); 120 121 $self->{debug} ||= $self->{config}->debug_default(); 122} 123 124 125sub _get_subclass { 126 my ($class, $type) = @_; 127 128 return unless $type; 129 130 my $subclass = join('::', $class, $type); 131 132 # probably this is useless because "require" function 133 # load files only once 134 #unless ($_LOADED{$subclass}) { 135 eval "require $subclass"; 136 if ( $@ ) { 137 carp $@; 138 $subclass = ''; 139 } #else { 140 # $_LOADED{$subclass}++; 141 #} 142 #} 143 144 return $subclass; 145} 146 147 148sub DESTROY {} 149 1501; 151 152__END__ 153 154=head1 NAME 155 156Net::DNS::Check::Test - base class for all type of tests 157 158=head1 SYNOPSIS 159 160C<use Net::DNS::Check::Test> 161 162=head1 DESCRIPTION 163 164This is the base class for all type of tests. 165 166 167=head1 METHODS 168 169=cut 170 171=head1 COPYRIGHT 172 173Copyright (c) 2005 Lorenzo Luconi Trombacchi - IIT-CNR 174 175All rights reserved. This program is free software; you may redistribute 176it and/or modify it under the same terms as Perl itself. 177 178=head1 SEE ALSO 179 180L<perl(1)> 181 182=cut 183 184