home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / Question.pm < prev    next >
Encoding:
Perl POD Document  |  2003-12-13  |  4.1 KB  |  198 lines
  1. package Net::DNS::Question;
  2. #
  3. # $Id: Question.pm,v 2.100 2003/12/13 01:37:05 ctriv Exp $
  4. #
  5. use strict;
  6. use vars qw($VERSION $AUTOLOAD);
  7.  
  8. use Carp;
  9. use Net::DNS;
  10.  
  11. $VERSION = (qw$Revision: 2.100 $)[1];
  12.  
  13. =head1 NAME
  14.  
  15. Net::DNS::Question - DNS question class
  16.  
  17. =head1 SYNOPSIS
  18.  
  19. C<use Net::DNS::Question>
  20.  
  21. =head1 DESCRIPTION
  22.  
  23. A C<Net::DNS::Question> object represents a record in the
  24. question section of a DNS packet.
  25.  
  26. =head1 METHODS
  27.  
  28. =head2 new
  29.  
  30.     $question = Net::DNS::Question->new("example.com", "MX", "IN");
  31.  
  32. Creates a question object from the domain, type, and class passed
  33. as arguments.
  34.  
  35. =cut
  36.  
  37. sub new {
  38.     my $class = shift;
  39.     my %self = (
  40.         "qname"        => undef,
  41.         "qtype"        => undef,
  42.         "qclass"    => undef,
  43.     );
  44.  
  45.     my ($qname, $qtype, $qclass) = @_;
  46.  
  47.     $qname  = "" if !defined($qname);
  48.  
  49.     $qtype  = defined($qtype)  ? uc($qtype)  : "ANY";
  50.     $qclass = defined($qclass) ? uc($qclass) : "ANY";
  51.  
  52.     # Check if the caller has the type and class reversed.
  53.     # We are not that kind for unknown types.... :-)
  54.     if ((!exists $Net::DNS::typesbyname{$qtype} ||
  55.          !exists $Net::DNS::classesbyname{$qclass})
  56.         && exists $Net::DNS::classesbyname{$qtype}
  57.         && exists $Net::DNS::typesbyname{$qclass}) {
  58.  
  59.         ($qtype, $qclass) = ($qclass, $qtype);
  60.     }
  61.  
  62.     $qname =~ s/^\.+//;
  63.     $qname =~ s/\.+$//;
  64.  
  65.     $self{"qname"}  = $qname;
  66.     $self{"qtype"}  = $qtype;
  67.     $self{"qclass"} = $qclass;
  68.  
  69.     bless \%self, $class;
  70. }
  71.  
  72. #
  73. # Some people have reported that Net::DNS dies because AUTOLOAD picks up
  74. # calls to DESTROY.
  75. #
  76. sub DESTROY {}
  77.  
  78. =head2 qname, zname
  79.  
  80.     print "qname = ", $question->qname, "\n";
  81.     print "zname = ", $question->zname, "\n";
  82.  
  83. Returns the domain name.  In dynamic update packets, this field is
  84. known as C<zname> and refers to the zone name.
  85.  
  86. =head2 qtype, ztype
  87.  
  88.     print "qtype = ", $question->qtype, "\n";
  89.     print "ztype = ", $question->ztype, "\n";
  90.  
  91. Returns the record type.  In dymamic update packets, this field is
  92. known as C<ztype> and refers to the zone type (must be SOA).
  93.  
  94. =head2 qclass, zclass
  95.  
  96.     print "qclass = ", $question->qclass, "\n";
  97.     print "zclass = ", $question->zclass, "\n";
  98.  
  99. Returns the record class.  In dynamic update packets, this field is
  100. known as C<zclass> and refers to the zone's class.
  101.  
  102. =cut
  103.  
  104. sub AUTOLOAD {
  105.     my ($self) = @_;
  106.     
  107.     my $name = $AUTOLOAD;
  108.     $name =~ s/.*://;
  109.  
  110.     Carp::croak "$name: no such method" unless exists $self->{$name};
  111.  
  112.     no strict q/refs/;
  113.     
  114.     *{$AUTOLOAD} = sub {
  115.         my ($self, $new_val) = @_;
  116.         
  117.         if (defined $new_val) {
  118.             $self->{"$name"} = $new_val;
  119.         }
  120.         
  121.         return $self->{"$name"};
  122.     };
  123.     
  124.     goto &{$AUTOLOAD};    
  125. }
  126.  
  127.  
  128. sub zname  { &qname;  }
  129. sub ztype  { &qtype;  }
  130. sub zclass { &qclass; }
  131.  
  132. =head2 print
  133.  
  134.     $question->print;
  135.  
  136. Prints the question record on the standard output.
  137.  
  138. =cut
  139.  
  140. sub print {    print $_[0]->string, "\n"; }
  141.  
  142. =head2 string
  143.  
  144.     print $qr->string, "\n";
  145.  
  146. Returns a string representation of the question record.
  147.  
  148. =cut
  149.  
  150. sub string {
  151.     my $self = shift;
  152.     return "$self->{qname}.\t$self->{qclass}\t$self->{qtype}";
  153. }
  154.  
  155. =head2 data
  156.  
  157.     $qdata = $question->data($packet, $offset);
  158.  
  159. Returns the question record in binary format suitable for inclusion
  160. in a DNS packet.
  161.  
  162. Arguments are a C<Net::DNS::Packet> object and the offset within
  163. that packet's data where the C<Net::DNS::Question> record is to
  164. be stored.  This information is necessary for using compressed
  165. domain names.
  166.  
  167. =cut
  168.  
  169. sub data {
  170.     my ($self, $packet, $offset) = @_;
  171.  
  172.     my $data = $packet->dn_comp($self->{"qname"}, $offset);
  173.  
  174.     $data .= pack("n", Net::DNS::typesbyname(uc($self->{"qtype"})));
  175.     $data .= pack("n", Net::DNS::classesbyname(uc($self->{"qclass"})));
  176.     
  177.     return $data;
  178. }
  179.  
  180. =head1 COPYRIGHT
  181.  
  182. Copyright (c) 1997-2002 Michael Fuhr. 
  183.  
  184. Portions Copyright (c) 2002-2003 Chris Reinhardt.
  185.  
  186. All rights reserved.  This program is free software; you may redistribute
  187. it and/or modify it under the same terms as Perl itself.
  188.  
  189. =head1 SEE ALSO
  190.  
  191. L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
  192. L<Net::DNS::Update>, L<Net::DNS::Header>, L<Net::DNS::RR>,
  193. RFC 1035 Section 4.1.2
  194.  
  195. =cut
  196.  
  197. 1;
  198.