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 / SOA.pm < prev    next >
Encoding:
Perl POD Document  |  2004-01-04  |  3.8 KB  |  176 lines
  1. package Net::DNS::RR::SOA;
  2. #
  3. # $Id: SOA.pm,v 2.101 2004/01/04 04:31:11 ctriv Exp $
  4. #
  5. use strict;
  6. use vars qw(@ISA $VERSION);
  7.  
  8. use Net::DNS::Packet;
  9.  
  10. @ISA     = qw(Net::DNS::RR);
  11. $VERSION = (qw$Revision: 2.101 $)[1];
  12.  
  13. sub new {
  14.     my ($class, $self, $data, $offset) = @_;
  15.  
  16.     if ($self->{"rdlength"} > 0) {
  17.         ($self->{"mname"}, $offset) = Net::DNS::Packet::dn_expand($data, $offset);
  18.         ($self->{"rname"}, $offset) = Net::DNS::Packet::dn_expand($data, $offset);
  19.  
  20.         @{$self}{qw(serial refresh retry expire minimum)} = unpack("\@$offset N5", $$data);
  21.     }
  22.  
  23.     return bless $self, $class;
  24. }
  25.  
  26. sub new_from_string {
  27.     my ($class, $self, $string) = @_;
  28.  
  29.     if ($string) {
  30.         $string =~ tr/()//d;
  31.         
  32.         # XXX do we need to strip out comments here now that RR.pm does it?
  33.         $string =~ s/;.*$//mg;
  34.  
  35.         @{$self}{qw(mname rname serial refresh retry expire minimum)} = $string =~ /(\S+)/g;
  36.  
  37.         $self->{'mname'} =~ s/\.+$//;
  38.         $self->{'rname'} =~ s/\.+$//;
  39.     }
  40.  
  41.     return bless $self, $class;
  42. }
  43.  
  44. sub rdatastr {
  45.     my $self = shift;
  46.     my $rdatastr;
  47.  
  48.     if (exists $self->{"mname"}) {
  49.         $rdatastr  = "$self->{mname}. $self->{rname}. (\n";
  50.         $rdatastr .= "\t" x 5 . "$self->{serial}\t; Serial\n";
  51.         $rdatastr .= "\t" x 5 . "$self->{refresh}\t; Refresh\n";
  52.         $rdatastr .= "\t" x 5 . "$self->{retry}\t; Retry\n";
  53.         $rdatastr .= "\t" x 5 . "$self->{expire}\t; Expire\n";
  54.         $rdatastr .= "\t" x 5 . "$self->{minimum} )\t; Minimum TTL";
  55.     } else {
  56.         $rdatastr = '';
  57.     }
  58.  
  59.     return $rdatastr;
  60. }
  61.  
  62. sub rr_rdata {
  63.     my ($self, $packet, $offset) = @_;
  64.     my $rdata = "";
  65.  
  66.     # Assume that if one field exists, they all exist.  Script will
  67.     # print a warning otherwise.
  68.  
  69.     if (exists $self->{"mname"}) {
  70.         $rdata .= $packet->dn_comp($self->{"mname"}, $offset);
  71.         $rdata .= $packet->dn_comp($self->{"rname"},  $offset + length $rdata);
  72.  
  73.         $rdata .= pack("N5", @{$self}{qw(serial refresh retry expire minimum)});
  74.     }
  75.  
  76.     return $rdata;
  77. }
  78.  
  79.  
  80.  
  81. sub _canonicalRdata {
  82.     my $self=shift;
  83.     my $rdata = "";
  84.  
  85.     # Assume that if one field exists, they all exist.  Script will
  86.     # print a warning otherwise.
  87.     
  88.     if (exists $self->{"mname"}) {
  89.         $rdata .= $self->_name2wire($self->{"mname"});        
  90.         $rdata .= $self->_name2wire($self->{"rname"});
  91.         $rdata .= pack("N5", @{$self}{qw(serial refresh retry expire minimum)});
  92.     }
  93.  
  94.     return $rdata;
  95. }
  96.  
  97.  
  98.  
  99. 1;
  100. __END__
  101.  
  102. =head1 NAME
  103.  
  104. Net::DNS::RR::SOA - DNS SOA resource record
  105.  
  106. =head1 SYNOPSIS
  107.  
  108. C<use Net::DNS::RR>;
  109.  
  110. =head1 DESCRIPTION
  111.  
  112. Class for DNS Start of Authority (SOA) resource records.
  113.  
  114. =head1 METHODS
  115.  
  116. =head2 mname
  117.  
  118.     print "mname = ", $rr->mname, "\n";
  119.  
  120. Returns the domain name of the original or primary nameserver for
  121. this zone.
  122.  
  123. =head2 rname
  124.  
  125.     print "rname = ", $rr->rname, "\n";
  126.  
  127. Returns a domain name that specifies the mailbox for the person
  128. responsible for this zone.
  129.  
  130. =head2 serial
  131.  
  132.     print "serial = ", $rr->serial, "\n";
  133.  
  134. Returns the zone's serial number.
  135.  
  136. =head2 refresh
  137.  
  138.     print "refresh = ", $rr->refresh, "\n";
  139.  
  140. Returns the zone's refresh interval.
  141.  
  142. =head2 retry
  143.  
  144.     print "retry = ", $rr->retry, "\n";
  145.  
  146. Returns the zone's retry interval.
  147.  
  148. =head2 expire
  149.  
  150.     print "expire = ", $rr->expire, "\n";
  151.  
  152. Returns the zone's expire interval.
  153.  
  154. =head2 minimum
  155.  
  156.     print "minimum = ", $rr->minimum, "\n";
  157.  
  158. Returns the minimum (default) TTL for records in this zone.
  159.  
  160. =head1 COPYRIGHT
  161.  
  162. Copyright (c) 1997-2002 Michael Fuhr. 
  163.  
  164. Portions Copyright (c) 2002-2003 Chris Reinhardt.
  165.  
  166. All rights reserved.  This program is free software; you may redistribute
  167. it and/or modify it under the same terms as Perl itself.
  168.  
  169. =head1 SEE ALSO
  170.  
  171. L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
  172. L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
  173. RFC 1035 Section 3.3.13
  174.  
  175. =cut
  176.