File Coverage

blib/lib/Barracuda/Api.pm
Criterion Covered Total %
statement 15 70 21.4
branch 0 26 0.0
condition 0 12 0.0
subroutine 5 15 33.3
pod 9 9 100.0
total 29 132 21.9


line stmt bran cond sub pod time code
1             package Barracuda::Api ;
2              
3 1     1   15245 use strict;
  1         1  
  1         26  
4 1     1   3 use warnings;
  1         2  
  1         23  
5 1     1   508 use Data::Dumper;
  1         7202  
  1         68  
6 1     1   436 use XML::RPC;
  1         7630  
  1         28  
7 1     1   9 use Carp qw(croak);
  1         2  
  1         665  
8              
9             our $VERSION = '0.03';
10              
11             sub new {
12 0     0 1   my ( $classe, $ref_args ) = @_;
13              
14 0   0       $classe = ref($classe) || $classe;
15              
16 0           my $self = {};
17 0           bless( $self, $classe );
18              
19 0           foreach my $attribut ( qw/domain password/ ) {
20 0 0         croak("Must set $attribut") unless $ref_args->{$attribut}
21             }
22              
23             # Default value if some attributes are not set
24 0 0         $ref_args->{port} = 8000 unless defined $ref_args->{port};
25 0 0         $ref_args->{verbose} = 0 unless defined $ref_args->{verbose};
26 0 0         $ref_args->{proto} = 'http' unless defined $ref_args->{proto};
27              
28 0           $self->{_DOMAIN} = $ref_args->{domain};
29 0           $self->{PORT} = $ref_args->{port};
30 0           $self->{_PASSWORD} = $ref_args->{password};
31 0           $self->{VERBOSE} = $ref_args->{verbose};
32 0           $self->{_PROTO} = $ref_args->{proto};
33 0           $self->{XMLRPC} = XML::RPC->new("$self->{_PROTO}://$self->{_DOMAIN}:$self->{PORT}/cgi-mod/api.cgi?password=$self->{_PASSWORD}");
34              
35 0           return $self;
36             }
37              
38             sub listAllDomain {
39 0     0 1   my $self = shift;
40              
41 0           $self->{XMLRPC}->call('config.list', { type => 'global',
42             child_type => 'domain' });
43              
44 0           $self->_parseOutput($self->{XMLRPC}->xml_in());
45             }
46              
47             sub getDestinationAddress {
48 0     0 1   my ( $self, $domain ) = @_;
49              
50 0           $self->{XMLRPC}->call('config.get', {
51             type => 'domain',
52             path => "$domain",
53             variable => 'mta_relay_advanced_host'});
54            
55 0           $self->_parseOutput($self->{XMLRPC}->xml_in());
56             }
57              
58             sub createDomain {
59 0     0 1   my ( $self, $domain, $destination ) = @_;
60              
61 0 0 0       croak('You must define domain and destination')
62             unless ( $domain && $destination);
63              
64 0           $self->{XMLRPC}->call('config.create', { parent_type => 'global',
65             parent_path => '',
66             type => 'domain',
67             name => "$domain",
68             mta_relay_advanced_host => "$destination" } );
69              
70 0           $self->_parseOutput($self->{XMLRPC}->xml_in());
71             }
72              
73             sub deleteDomain {
74 0     0 1   my ( $self, $domain ) = @_;
75              
76 0 0         croak('You must define domain')
77             unless ( $domain );
78              
79 0           $self->{XMLRPC}->call('config.delete', { parent_type => 'global',
80             parent_path => '',
81             type => 'domain',
82             path => "$domain" });
83              
84 0           $self->_parseOutput($self->{XMLRPC}->xml_in());
85             }
86              
87             sub createUser {
88 0     0 1   my ( $self, $user ) = @_;
89              
90 0 0         croak('You must define a user')
91             unless ( $user );
92              
93 0           $self->{XMLRPC}->call('user.create', {
94             user => "$user" });
95              
96 0           $self->_parseOutput($self->{XMLRPC}->xml_in());
97             }
98              
99             sub deleteUser {
100 0     0 1   my ( $self, $user ) = @_;
101              
102 0 0         croak('You must define a user')
103             unless ( $user );
104              
105 0           $self->{XMLRPC}->call('user.remove', {
106             user => "$user" });
107              
108 0           $self->_parseOutput($self->{XMLRPC}->xml_in());
109             }
110              
111             sub whitelistSenderForDomain {
112 0     0 1   my ( $self, $domain, $whitelist, $comment ) = @_;
113              
114 0 0 0       croak('You must define domain and whitelist')
115             unless ( $domain && $whitelist);
116              
117             # Do not print anything in comment if not set
118 0 0         $comment = '' unless defined $comment;
119              
120 0           $self->{XMLRPC}->call('config.create', { parent_type => 'domain',
121             parent_path => "$domain",
122             type => 'mta_sender_allow_address',
123             name => "$whitelist",
124             mta_sender_allow_comment => "$comment" });
125              
126 0           $self->_parseOutput($self->{XMLRPC}->xml_in());
127             }
128              
129             sub blacklistSenderForDomain {
130 0     0 1   my ( $self, $domain, $blacklist, $comment ) = @_;
131              
132 0 0 0       croak('You must define domain and blacklist')
133             unless ( $domain && $blacklist);
134              
135             # Print anything in comment if not set
136 0 0         $comment = '' unless defined $comment;
137              
138 0           $self->{XMLRPC}->call('config.create', { parent_type => 'domain',
139             parent_path => "$domain",
140             type => 'mta_sender_block_address',
141             name => "$blacklist",
142             mta_sender_allow_comment => "$comment" });
143              
144 0           $self->_parseOutput($self->{XMLRPC}->xml_in());
145             }
146              
147             sub _parseOutput {
148 0     0     my ( $self, $output ) = @_;
149 0           my $result = '';
150              
151 0 0         if ( $self->{VERBOSE} == 0 ) {
152 0           while ( $output =~ m/CDATA\[(.*)\]\]/g ) {
153 0           $result .= "$1\n";
154             }
155             } else {
156 0           $result = $output;
157             }
158              
159 0           $result
160             }
161              
162             1;
163             __END__