File Coverage

blib/lib/Barracuda/Api.pm

Criterion	Covered	Total	%
statement	15	67	22.3
branch	0	26	0.0
condition	0	12	0.0
subroutine	5	14	35.7
pod	8	8	100.0
total	28	127	22.0

package Barracuda::Api ;

use strict;
use warnings;
use Data::Dumper;
use XML::RPC;
use Carp qw(croak);

our $VERSION = '0.02';

sub new {
    my ( $classe, $ref_args ) = @_;

    $classe = ref($classe) || $classe;

    my $self = {};
    bless( $self, $classe );

    foreach my $attribut ( qw/domain password/ ) {
        croak("Must set $attribut") unless $ref_args->{$attribut}
    }

    # Default value if some attributes are not set
    $ref_args->{port} = 8000 unless defined $ref_args->{port};
    $ref_args->{verbose} = 0 unless defined $ref_args->{verbose};
    $ref_args->{proto} = 'http' unless defined $ref_args->{proto};

    $self->{_DOMAIN}       = $ref_args->{domain};
    $self->{PORT}          = $ref_args->{port};
    $self->{_PASSWORD}     = $ref_args->{password};
    $self->{VERBOSE}       = $ref_args->{verbose};
    $self->{_PROTO}        = $ref_args->{proto};
    $self->{XMLRPC}        = XML::RPC->new("$self->{_PROTO}://$self->{_DOMAIN}:$self->{PORT}/cgi-mod/api.cgi?password=$self->{_PASSWORD}");

    return $self;
}

sub listAllDomain {
    my $self = shift;

    $self->{XMLRPC}->call('config.list', { type => 'global',
                                child_type => 'domain' });

    $self->_parseOutput($self->{XMLRPC}->xml_in());
}

sub createDomain {
    my ( $self, $domain, $destination ) = @_;

    croak('You must define domain and destination')
                        unless ( $domain && $destination);

    $self->{XMLRPC}->call('config.create', { parent_type => 'global',
                                parent_path => '',
                                type => 'domain',
                                name => "$domain",
                                mta_relay_advanced_host => "$destination" } );

    $self->_parseOutput($self->{XMLRPC}->xml_in());
}

sub deleteDomain {
    my ( $self, $domain ) = @_;

    croak('You must define domain')
                        unless ( $domain );

    $self->{XMLRPC}->call('config.delete', { parent_type => 'global',
                                parent_path => '',
                                type => 'domain',
                                path => "$domain" });

    $self->_parseOutput($self->{XMLRPC}->xml_in());
}

sub createUser {
    my ( $self, $user ) = @_;

    croak('You must define a user')
                        unless ( $user );

    $self->{XMLRPC}->call('user.create', {
				user => "$user" });

    $self->_parseOutput($self->{XMLRPC}->xml_in());
}

sub deleteUser {
    my ( $self, $user ) = @_;

    croak('You must define a user')
                        unless ( $user );

    $self->{XMLRPC}->call('user.remove', {
                                user => "$user" });

    $self->_parseOutput($self->{XMLRPC}->xml_in());
}

sub whitelistSenderForDomain {
    my ( $self, $domain, $whitelist, $comment ) = @_;

    croak('You must define domain and whitelist')
                        unless ( $domain && $whitelist);

    # Do not print anything in comment if not set
    $comment = '' unless defined $comment;

    $self->{XMLRPC}->call('config.create', { parent_type => 'domain',
                                parent_path => "$domain",
                                type => 'mta_sender_allow_address',
                                name => "$whitelist",
                                mta_sender_allow_comment => "$comment" });

    $self->_parseOutput($self->{XMLRPC}->xml_in());
}

sub blacklistSenderForDomain {
    my ( $self, $domain, $blacklist, $comment ) = @_;

    croak('You must define domain and blacklist')
                        unless ( $domain && $blacklist);

    # Print anything in comment if not set
    $comment = '' unless defined $comment;

    $self->{XMLRPC}->call('config.create', { parent_type => 'domain',
                                parent_path => "$domain",
                                type => 'mta_sender_block_address',
                                name => "$blacklist",
                                mta_sender_allow_comment => "$comment" });

    $self->_parseOutput($self->{XMLRPC}->xml_in());
}

sub _parseOutput {
    my ( $self, $output ) = @_;
    my $result = '';

    if ( $self->{VERBOSE} == 0 ) {
        while ( $output =~ m/CDATA\[(.*)\]\]/g ) {
            $result .= "$1\n";
        }
    } else {
        $result = $output;
    }

    $result
}

1;
__END__