File Coverage

blib/lib/DNS/Config/Statement/Key.pm
Criterion Covered Total %
statement 18 60 30.0
branch 0 16 0.0
condition 0 12 0.0
subroutine 6 12 50.0
pod 0 6 0.0
total 24 106 22.6


line stmt bran cond sub pod time code
1             #!/usr/local/bin/perl -w
2             ######################################################################
3             #
4             # DNS/Config/Statement/Key.pm
5             #
6             # $Id: Key.pm,v 1.3 2003/02/16 10:15:33 awolf Exp $
7             # $Revision: 1.3 $
8             # $Author: awolf $
9             # $Date: 2003/02/16 10:15:33 $
10             #
11             # Copyright (C)2003 Bruce Campbell. All rights reserved.
12             # Base Class (Options) (C)2001-2003 Andy Wolf. All rights reserved.
13             #
14             # This library is free software; you can redistribute it and/or
15             # modify it under the same terms as Perl itself.
16             #
17             ######################################################################
18              
19             package DNS::Config::Statement::Key;
20              
21 1     1   1673 no warnings 'portable';
  1         5  
  1         112  
22 1     1   23 use 5.6.0;
  1         8  
  1         92  
23 1     1   10 use strict;
  1         4  
  1         77  
24 1     1   8 use warnings;
  1         4  
  1         45  
25 1     1   8 use vars qw(@ISA);
  1         4  
  1         251  
26              
27 1     1   11 use DNS::Config::Statement;
  1         5  
  1         1504  
28              
29             @ISA = qw(DNS::Config::Statement);
30              
31             my $VERSION = '0.66';
32             my $REVISION = sprintf("%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/);
33              
34             sub new {
35 0     0 0   my($pkg) = @_;
36 0   0       my $class = ref($pkg) || $pkg;
37              
38 0           my $self = {
39             'ALGORITHM' => 'hmac-md5'
40             };
41              
42              
43 0           bless $self, $class;
44              
45 0           return $self;
46             }
47              
48             sub parse_tree {
49 0     0 0   my($self, @array) = @_;
50            
51 0 0 0       return undef if((scalar(@array) < 2) || (scalar(@array) > 3));
52            
53 0           $self->{'NAME'} = shift @array;
54 0           $self->{'NAME'} =~ s/^\"//g;
55 0           $self->{'NAME'} =~ s/\"$//g;
56            
57 0           my $data = shift @array;
58 0           my @data = @$data;
59              
60 0           foreach my $stmt (@data) {
61 0           my @stmt = @$stmt;
62            
63 0           my $key = uc shift @stmt;
64            
65 0 0         if(scalar(@stmt) == 1) {
66 0           $self->{$key} = shift @stmt;
67 0           $self->{$key} =~ s/^\"//g;
68 0           $self->{$key} =~ s/\"$//g;
69             }
70             else {
71 0           $self->{$key} = \@stmt;
72             }
73             }
74            
75 0           return $self;
76             }
77              
78             sub dump {
79 0     0 0   my($self) = @_;
80 0           my @array;
81            
82             my @array2;
83 0           foreach my $key (keys %$self) {
84 0 0 0       if(($key =~ /FILE/) || ($key =~ /DIRECTORY/)) {
    0 0        
85 0           push @array2, ([ lc $key, q(") . $self->{$key} . q(")]);
86             }
87             elsif(($key ne 'NAME') && ($key ne 'CLASS')) {
88 0           push @array2, ([ lc $key, $self->{$key}]);
89             }
90             }
91            
92 0           push @array, ('key', q(") . $self->{'NAME'} . q("));
93 0 0         push @array, ($self->{'CLASS'}) if(exists $self->{'CLASS'});
94 0           push @array, (\@array2);
95            
96 0           my $string = $self->substatement(@array);
97 0           print $string, "\n";
98            
99 0           return $self;
100             }
101              
102             sub name {
103 0     0 0   my($self, $name) = @_;
104              
105 0 0         $self->{'NAME'} = $name if($name);
106            
107 0           return $self->{'NAME'};
108             }
109              
110             sub algorithm {
111 0     0 0   my($self, $alg) = @_;
112              
113 0 0         $self->{'ALGORITHM'} = $alg if($alg);
114            
115 0           return $self->{'ALGORITHM'};
116             }
117              
118             sub secret {
119 0     0 0   my($self, $secret) = @_;
120            
121 0 0         $self->{'SECRET'} = $secret if($secret);
122            
123 0           return $self->{'SECRET'};
124             }
125              
126             1;
127              
128             __END__