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 / AAAA.pm < prev    next >
Encoding:
Perl POD Document  |  2004-01-04  |  2.6 KB  |  123 lines
  1. package Net::DNS::RR::AAAA;
  2. #
  3. # $Id: AAAA.pm,v 2.101 2004/01/04 04:31:10 ctriv Exp $
  4. #
  5. use strict;
  6. use vars qw(@ISA $VERSION);
  7.  
  8. use Net::DNS;
  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.         my @addr = unpack("\@$offset n8", $$data);
  18.         $self->{"address"} = sprintf("%x:%x:%x:%x:%x:%x:%x:%x", @addr);
  19.     }
  20.     return bless $self, $class;
  21. }
  22.  
  23. sub new_from_string {
  24.     my ($class, $self, $string) = @_;
  25.  
  26.     if ($string) {
  27.         my @addr;
  28.  
  29.         # I think this is correct, per RFC 1884 Sections 2.2 & 2.4.4.
  30.         if ($string =~ /^(.*):(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
  31.             my ($front, $a, $b, $c, $d) = ($1, $2, $3, $4, $5);
  32.             $string = $front . sprintf(":%x:%x",
  33.                            ($a << 8 | $b),
  34.                            ($c << 8 | $d));
  35.         }
  36.             
  37.         if ($string =~ /^(.*)::(.*)$/) {
  38.             my ($front, $back) = ($1, $2);
  39.             my @front = split(/:/, $front);
  40.             my @back  = split(/:/, $back);
  41.             my $fill = 8 - (@front ? $#front + 1 : 0)
  42.                      - (@back  ? $#back  + 1 : 0);
  43.             my @middle = (0) x $fill;
  44.             @addr = (@front, @middle, @back);
  45.         }
  46.         else {
  47.             @addr = split(/:/, $string);
  48.             if (@addr < 8) {
  49.                 @addr = ((0) x (8 - @addr), @addr);
  50.             }
  51.         }
  52.  
  53.         $self->{"address"} = sprintf("%x:%x:%x:%x:%x:%x:%x:%x",
  54.                          map { hex $_ } @addr);
  55.     }
  56.  
  57.     return bless $self, $class;
  58. }
  59.  
  60. sub rdatastr {
  61.     my $self = shift;
  62.  
  63.     return $self->{"address"} || '';
  64. }
  65.  
  66. sub rr_rdata {
  67.     my $self = shift;
  68.     my $rdata = "";
  69.  
  70.     if (exists $self->{"address"}) {
  71.         my @addr = split(/:/, $self->{"address"});
  72.         $rdata .= pack("n8", map { hex $_ } @addr);
  73.     }
  74.  
  75.     return $rdata;
  76. }
  77.  
  78. 1;
  79. __END__
  80.  
  81. =head1 NAME
  82.  
  83. Net::DNS::RR::AAAA - DNS AAAA resource record
  84.  
  85. =head1 SYNOPSIS
  86.  
  87. C<use Net::DNS::RR>;
  88.  
  89. =head1 DESCRIPTION
  90.  
  91. Class for DNS IPv6 Address (AAAA) resource records.
  92.  
  93. =head1 METHODS
  94.  
  95. =head2 address
  96.  
  97.     print "address = ", $rr->address, "\n";
  98.  
  99. Returns the RR's address field.
  100.  
  101. =head1 BUGS
  102.  
  103. The C<string> method returns only the preferred method of address
  104. representation ("x:x:x:x:x:x:x:x", as documented in RFC 1884,
  105. Section 2.2, Para 1).
  106.  
  107. =head1 COPYRIGHT
  108.  
  109. Copyright (c) 1997-2002 Michael Fuhr. 
  110.  
  111. Portions Copyright (c) 2002-2003 Chris Reinhardt.
  112.  
  113. All rights reserved.  This program is free software; you may redistribute
  114. it and/or modify it under the same terms as Perl itself.
  115.  
  116. =head1 SEE ALSO
  117.  
  118. L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
  119. L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
  120. RFC 1886 Section 2, RFC 1884 Sections 2.2 & 2.4.4
  121.  
  122. =cut
  123.