1package Net::DNS::Check::HostsList;
2
3use strict;
4use Net::DNS::Check::Config;
5use Net::DNS::Check::Host;
6
7
8sub new {
9	my ($pkg, %param) = @_;
10	my $self;
11
12	$self->{domain}		= $param{domain};
13
14	# Quotiamo i '.'
15	$self->{qdomain}	= $param{domain};
16	$self->{qdomain}	=~ s/\./\\./g;
17
18
19	$self->{config}		= $param{config} || new Net::DNS::Check::Config;
20
21	$self->{debug} 		= $param{debug} || $self->{config}->debug_default();
22
23	$self->{list}		= {};
24
25	bless $self, $pkg;
26
27	if ($param{load_predefined}) {
28		$self->load_predefined_host();
29	}
30
31	return $self;
32}
33
34
35sub load_predefined_host() {
36    my $self = shift;
37
38	# Precaricamento dei predefined_hosts
39	foreach my $prehost ( keys %{$self->{config}->{predefined_hosts} } ) {
40		my $host_obj = new Net::DNS::Check::Host(
41			init_only  => 1,
42			debug      => $self->{debug},
43			host       => $prehost,
44			config     => $self->{config},
45			ip         => $self->{config}->{predefined_hosts}->{$prehost}
46		);
47
48		$self->{list}->{$prehost} = $host_obj;
49	}
50
51	return 1;
52}
53
54
55sub add_host {
56	my $self 		= shift;
57	my %param		= @_;
58	my $hostname 	= lc $param{hostname}; # nome del dns
59	my $ip 			= $param{ip} 		|| []; # ip array pointer (facoltativo)
60	my $ip_orig 	= $param{ip_orig} 	|| []; # ip array pointer (facoltativo)
61
62	return undef if (!$hostname);
63
64	if ( exists $self->{list}->{$hostname} ) {
65		# print "$hostname: already present\n";
66		# Se c'e' gia' riportiamo il record gia' presente
67		return $self->{list}->{$hostname};
68	} else {
69		# Passiamo l'IP (query non ricorsiva) solo se l'host
70		# fa parte del dominio che stiamo analizzando
71		# print "$hostname: not present found: ";
72		my $host;
73
74		my @temp;
75		@temp = split('\.', $self->{domain});
76		my $domcount = scalar @temp;
77		@temp = split('\.', $hostname);
78		my $hostcount = (scalar @temp)-1;
79
80		if ( ($self->{domain} eq $hostname) || $self->{domain} && $hostname =~ /.*$self->{qdomain}$/ && $domcount == $hostcount ) {
81# print "$hostname inside query /$self->{domain}, $domcount, $hostcount\n";
82			$host = new Net::DNS::Check::Host(
83				debug 	=> $self->{debug},
84				host 	=> $hostname,
85				config	=> $self->{config},
86				ip   	=> $ip,
87				ip_orig	=> $ip_orig
88			);
89		} else {
90# print "$hostname outside query /$self->{domain}, $domcount, $hostcount\n";
91			$host = new Net::DNS::Check::Host(
92				debug 	=> $self->{debug},
93				config	=> $self->{config},
94				host 	=> $hostname,
95				ip_orig	=> $ip_orig
96			);
97		}
98
99		$self->{list}->{$hostname} = $host;
100
101		return $host;
102	}
103}
104
105
106# Rimuove un host dalla HostsList. Servira'? Boh?
107sub rm_host() {
108	my $self = shift;
109	my $hostname = shift;
110
111	if (exists $self->{list}->{$hostname} ) {
112		delete $self->{list}->{$hostname};
113		return 1;
114	}
115
116	return undef;
117}
118
119
120
121# Riporta la lista degli oggetti Host contenuti nella HostsList (che giro
122# di parole!!)
123sub get_list() {
124	my $self = shift;
125
126	return keys %{$self->{list}};
127}
128
129
130# Riporta l'oggetto host specifico corrispondente all'hostname passato come
131# parametro
132sub get_host() {
133	my $self = shift;
134	my $hostname = shift;
135
136	if (exists $self->{list}->{$hostname} ) {
137		return $self->{list}->{$hostname};
138	}
139
140	return undef;
141}
142
1431;
144
145__END__
146
147=head1 NAME
148
149Net::DNS::Check::HostsList - Class for maintaining a list of Net::DNS::Check::Host objects.
150
151=head1 DESCRIPTION
152
153This class is used for maintaing a list of L<Net::DNS::Check::Host> objects. At present L<Net::DNS::Check> maintains two kind of this lists (Net::DNS::Check::HostsList object) one for every authoritative nameservers and one general list used by all the authoritative nameservers.
154
155The are several methods implemented by this class, but at present are all for internal use only and L<Net::DNS::Check> users don't need to directly create  Net::DNS::Check::HostsList object and call his methods.
156
157Anyway a complete documentation of all methods will be released as soon as possible.
158
159=head1 COPYRIGHT
160
161Copyright (c) 2005 Lorenzo Luconi Trombacchi - IIT-CNR
162
163All rights reserved.  This program is free software; you may redistribute
164it and/or modify it under the same terms as Perl itself.
165
166=head1 SEE ALSO
167
168L<perl(1)>
169
170=cut
171