File Coverage

blib/lib/iRedAdmin.pm

Criterion	Covered	Total	%
statement	24	71	33.8
branch	0	26	0.0
condition			n/a
subroutine	8	17	47.0
pod	4	5	80.0
total	36	119	30.2

package iRedAdmin;

use Moo;
use Email::Valid;
use Encode;
use WWW::Mechanize;
use HTTP::Cookies;
use iRedAdmin::Admin;
use iRedAdmin::Domain;
use iRedAdmin::User;

our $VERSION = '0.02';

has 'url' => (
    is => 'ro',
    isa => sub {
        my $url = $_[0];
        $url =~ s/^https?:\/\///;
        $url =~ s/\/.*$//;
        die "Domain is invalid! $url" unless Email::Valid->address('domain@'.$url)
    }
);

has 'username' => (
    is => 'ro',
    isa => sub {
        die "Username is invalid!" unless Email::Valid->address($_[0])
    }
);

has 'password' => (
    is => 'ro',
    isa => sub {
        die "Password this empty!" unless $_[0] =~ /.{1,}/
    }
);

has 'cookie' => (
    is => 'ro',
    isa => sub {
        die "Cookie this empty!" unless $_[0] =~ /.{1,}/
    }
);

has 'lang' => (
    is => 'ro',
    default => sub {
        'en_US'
    }
);

has 'mech' => (is => 'ro', writer => 'set_mech');

has 'error' => (is => 'ro', writer => 'set_error');

sub BUILD {
    my $self = shift;

    my $cookie_jar = HTTP::Cookies->new(
        file => $self->cookie,
        ignore_discard => 1,
        autosave => 1
    );

    my $mech = WWW::Mechanize->new(
        autocheck => 0,
        cookie_jar => $cookie_jar,
        ssl_opts => {
            verify_hostname => 0
        }
    );

    $self->set_mech($mech);

    if (-e $self->cookie) {
        my $result = undef;
        open FILE, '<', $self->cookie or die $!;
        while () {
            chomp;
            $result = $_ unless $result;
        }
        close FILE;
        $result =~ s/\s//g if $result;
        unless($result){
            $self->_connect;
        }
    }else{
        $self->_connect;
    }
}

sub _connect {
    my $self = shift;

    $self->mech->post($self->_address . '/login',
        [
            username => $self->username,
            password => $self->password,
            login => 'Login',
            lang => $self->_lang($self->lang),
            save_pass => 'yes'
        ]
    );

    if($self->mech->content =~ /login_form/){
        $self->mech->content =~ m! (.*?)!i;
        $self->set_error(encode('utf-8', $1));
        return 0;
    }

    return 2;
};

sub _success {
    my $self = shift;

    if($self->mech->content =~ /login_form/){
        $self->_connect;
    }elsif($self->mech->content =~ /error/i) {
        $self->mech->content =~ m! (.*?)!i;
        $self->set_error(encode('utf-8', $1));
        return 0;
    }else{
        return 1;
    }
}

sub _address {
    my $self = shift;

    my $url = $self->url;
    $url =~ s/\/$//;
    return $url;
}

sub _lang {
    my ($self, $value) = @_;

    my @lang = qw/
        cs_CZ
        de_DE
        en_US
        es_ES
        fi_FI
        fr_FR
        hu_HU
        it_IT
        ko_KR
        nl_NL
        pl_PL
        pt_BR
        ru_RU
        sl_SI
        zh_CN
        zh_TW
    /;

    if ($value =~ /\d/) {
        return $lang[$value-1] if $lang[$value-1];
        return 'en_US';
    }elsif($value =~ /\w/){
        return $value if grep(/^$value$/, @lang);
        return 'en_US';
    }else{
        return 'en_US';
    }
}

sub Admin {
    return iRedAdmin::Admin->new(ref => shift);
}

sub Domain {
    return iRedAdmin::Domain->new(ref => shift);
}

sub User {
    return iRedAdmin::User->new(ref => shift);
}

sub Logout {
    my $self = shift;
    $self->mech->get($self->url . '/logout');
    return 1 if $self->mech->content =~ /login_form/;
}

1;


__END__