File Coverage

blib/lib/Barracuda/Api.pm
Criterion Covered Total %
statement 15 55 27.2
branch 0 20 0.0
condition 0 12 0.0
subroutine 5 11 45.4
pod 5 5 100.0
total 25 103 24.2


line stmt bran cond sub pod time code
1             package Barracuda::Api ;
2              
3 1     1   24063 use strict;
  1         2  
  1         27  
4 1     1   5 use warnings;
  1         2  
  1         27  
5 1     1   934 use Data::Dumper;
  1         10274  
  1         63  
6 1     1   824 use XML::RPC;
  1         11488  
  1         30  
7 1     1   9 use Carp qw(croak);
  1         2  
  1         715  
8              
9             our $VERSION = '0.01';
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 createDomain {
48 0     0 1   my ( $self, $domain, $destination ) = @_;
49              
50 0 0 0       croak('You must define domain and destination')
51             unless ( $domain && $destination);
52              
53 0           $self->{XMLRPC}->call('config.create', { parent_type => 'global',
54             parent_path => '',
55             type => 'domain',
56             name => "$domain",
57             mta_relay_advanced_host => "$destination" } );
58              
59 0           $self->_parseOutput($self->{XMLRPC}->xml_in());
60             }
61              
62             sub whitelistSenderForDomain {
63 0     0 1   my ( $self, $domain, $whitelist, $comment ) = @_;
64              
65 0 0 0       croak('You must define domain and whitelist')
66             unless ( $domain && $whitelist);
67              
68             # Do not print anything in comment if not set
69 0 0         $comment = '' unless defined $comment;
70              
71 0           $self->{XMLRPC}->call('config.create', { parent_type => 'domain',
72             parent_path => "$domain",
73             type => 'mta_sender_allow_address',
74             name => "$whitelist",
75             mta_sender_allow_comment => "$comment" });
76              
77 0           $self->_parseOutput($self->{XMLRPC}->xml_in());
78             }
79              
80             sub blacklistSenderForDomain {
81 0     0 1   my ( $self, $domain, $blacklist, $comment ) = @_;
82              
83 0 0 0       croak('You must define domain and blacklist')
84             unless ( $domain && $blacklist);
85              
86             # Print anything in comment if not set
87 0 0         $comment = '' unless defined $comment;
88              
89 0           $self->{XMLRPC}->call('config.create', { parent_type => 'domain',
90             parent_path => "$domain",
91             type => 'mta_sender_block_address',
92             name => "$blacklist",
93             mta_sender_allow_comment => "$comment" });
94              
95 0           $self->_parseOutput($self->{XMLRPC}->xml_in());
96             }
97              
98             sub _parseOutput {
99 0     0     my ( $self, $output ) = @_;
100 0           my $result = '';
101              
102 0 0         if ( $self->{VERBOSE} == 0 ) {
103 0           while ( $output =~ m/CDATA\[(.*)\]\]/g ) {
104 0           $result .= "$1\n";
105             }
106             } else {
107 0           $result = $output;
108             }
109              
110 0           $result
111             }
112              
113             1;
114             __END__