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 / TXT.pm < prev    next >
Encoding:
Perl POD Document  |  2004-02-21  |  3.0 KB  |  147 lines
  1. package Net::DNS::RR::TXT;
  2. #
  3. # $Id: TXT.pm,v 2.104 2004/02/17 03:37:51 ctriv Exp $
  4. #
  5. use strict;
  6. use vars qw(@ISA $VERSION);
  7.  
  8. use Net::DNS::Packet;
  9. use Text::ParseWords;
  10.  
  11. @ISA     = qw(Net::DNS::RR);
  12. $VERSION = (qw$Revision: 2.104 $)[1];
  13.  
  14. sub new {
  15.     my ($class, $self, $data, $offset) = @_;
  16.     
  17.     my $rdlength = $self->{'rdlength'} or return bless $self, $class;
  18.     my $end = $offset + $rdlength;
  19.     while ( $offset < $end ) {
  20.         my $strlen = unpack("\@$offset C", $$data );
  21.         ++$offset ;
  22.         my $char_str = substr($$data, $offset, $strlen);
  23.         $offset += $strlen;
  24.         push( @{ $self->{'char_str_list'} }, $char_str );
  25.     }
  26.  
  27.     return bless $self, $class;
  28. }
  29.  
  30. sub new_from_string {
  31.     my ( $class, $self, $rdata_string ) = @_ ;
  32.     
  33.     bless $self, $class;
  34.         
  35.     $self->_build_char_str_list($rdata_string);
  36.  
  37.     return $self ;
  38. }
  39.  
  40. sub txtdata {
  41.     my $self = shift;
  42.     return join(' ',  $self->char_str_list());
  43. }
  44.  
  45. sub rdatastr {
  46.     my $self = shift;
  47.         
  48.     if ($self->char_str_list) {
  49.         return join(' ', map { 
  50.             my $str = $_;  
  51.             $str =~ s/"/\\"/g;  
  52.             qq("$str");
  53.         } @{$self->{'char_str_list'}});
  54.     } 
  55.     
  56.     return '';
  57. }
  58.  
  59. sub _build_char_str_list {
  60.     my ($self, $rdata_string) = @_;
  61.     
  62.     my @words = shellwords($rdata_string);
  63.  
  64.     $self->{'char_str_list'} = [];
  65.  
  66.     if (@words) {
  67.         foreach my $string ( @words ) {
  68.             $string =~ s/\\"/"/g;
  69.             push(@{$self->{'char_str_list'}}, $string);
  70.         }
  71.     }
  72. }
  73.  
  74. sub char_str_list {
  75.     my $self = shift;
  76.     
  77.     if (not $self->{'char_str_list'}) {
  78.         $self->_build_char_str_list( $self->{'txtdata'} );
  79.     }
  80.  
  81.     return @{$self->{'char_str_list'}}; # unquoted strings
  82. }
  83.  
  84. sub rr_rdata {
  85.     my $self = shift;
  86.     my $rdata = "";
  87.  
  88.     foreach my $string ( $self->char_str_list() ) {
  89.         $rdata .= pack("C", length $string );
  90.         $rdata .= $string;
  91.     }
  92.  
  93.     return $rdata;
  94. }
  95.  
  96. 1;
  97. __END__
  98.  
  99. =head1 NAME
  100.  
  101. Net::DNS::RR::TXT - DNS TXT resource record
  102.  
  103. =head1 SYNOPSIS
  104.  
  105. C<use Net::DNS::RR>;
  106.  
  107. =head1 DESCRIPTION
  108.  
  109. Class for DNS Text (TXT) resource records.
  110.  
  111. =head1 METHODS
  112.  
  113. =head2 txtdata
  114.  
  115.     print "txtdata = ", $rr->txtdata, "\n";
  116.  
  117. Returns the descriptive text as a single string, regardless of actual 
  118. number of <character-string> elements.  Of questionable value.  Should 
  119. be deprecated.  
  120.  
  121. Use C<TXT-E<gt>rdatastr()> or C<TXT-E<gt>char_str_list()> instead.
  122.  
  123. =head2 char_str_list
  124.  
  125.     print "Individual <character-string> list: \n\t", \
  126.             join ( "\n\t", $rr->char_str_list() );
  127.  
  128. Returns a list of the individual <character-string> elements, 
  129. as unquoted strings.  Used by TXT->rdatastr and TXT->rr_rdata.
  130.  
  131. =head1 COPYRIGHT
  132.  
  133. Copyright (c) 1997-2002 Michael Fuhr. 
  134.  
  135. Portions Copyright (c) 2002-2003 Chris Reinhardt.
  136.  
  137. All rights reserved.  This program is free software; you may redistribute
  138. it and/or modify it under the same terms as Perl itself.
  139.  
  140. =head1 SEE ALSO
  141.  
  142. L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
  143. L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
  144. RFC 1035 Section 3.3.14
  145.  
  146. =cut
  147.