File Coverage

blib/lib/WebService/SonarQube.pm

Criterion	Covered	Total	%
statement	98	98	100.0
branch	10	10	100.0
condition	7	7	100.0
subroutine	21	21	100.0
pod	1	1	100.0
total	137	137	100.0

package WebService::SonarQube;

# Created on: 2015-05-02 20:12:53
# Create by:  Ivan Wills
# $Id$
# $Revision$, $HeadURL$, $Date$
# $Revision$, $Source$, $Date$

use Moo;
use strict;
use warnings;
use Carp;
use namespace::clean;
use English qw/ -no_match_vars /;
use WWW::Mechanize;
use Type::Tiny;
use Types::Standard -types;
use URI;
use WWW::Mechanize;
use JSON;
use Try::Tiny;

our $VERSION = '0.10';

has url => (
    is       => 'rw',
    required => 1,
    isa      => Str,
);
has [qw/username password version/] => (
    is  => 'rw',
    isa => Str,
);
has mech => (
    is      => 'rw',
    default => sub { WWW::Mechanize->new(); },
);
has commands => (
    is => 'rw',
);

sub BUILD {
    my ($self) = @_;

    $self->mech->add_header(accept => 'application/json');

    if ($self->url =~ m{/$}) {
        my $url = $self->url;
        $url =~ s{/$}{};
        $self->url($url);
    }

    $self->_get_commands();

    my $server = $self->_get('server/index');
    $self->version($server->{version});
}

sub _get_commands {
    my ($self) = @_;

    my $list = $self->_get('webservices/list',  include_internals => 'true');

    my %commands;
    for my $ws (@{ $list->{webServices}}) {
        my $name = $ws->{path};
        $name =~ s{^api/}{};

        for my $action (@{ $ws->{actions} }) {
            $commands{$name . '/' . $action->{key}} = {
                name     => $name . '_' . $action->{key},
                url      => $name . '/' . $action->{key},
                internal => !!$action->{internal},
                post     => !!$action->{post},
                description => $action->{description},
            };
        }
    }

    $self->commands(\%commands);
}

our $AUTOLOAD;
sub AUTOLOAD {
    my ($self, %params) = @_;

    my $api =  $AUTOLOAD;
    $api =~ s{.*::}{};
    $api =~ s{_}{/}g;

    return if $api eq 'DESTROY';

    if (!$self->commands->{$api}) {
        confess "Unknown command $api for SonarQube " . $self->version . '!';
    }

    my $url = $self->url;
    $url =~ s{//(?:[^@]+[@])}{//};

    if ($self->username && $self->password) {
        $self->mech->credentials(_url_encode($self->username), _url_encode($self->password));
        my ($user, $pass) = map {_url_encode($_)} ($self->username, $self->password);
        $url =~ s{//}{//$user\:$pass\@};
    }
    $self->url($url);

    my $result;
    try {
        $result = $self->commands->{$api}{post} ? $self->_post($api, %params) : $self->_get($api, %params);
    }
    catch {
        local $Data::Dumper::Indent = 0;
        require Data::Dumper;
        my $args = Data::Dumper::Dumper( \%params );
        $args = s/^\$VAR\d\s+=\s+//;
        confess "Errored trying $AUTOLOAD($args)\n$_\n";
    };

    return $result;
}

sub _get {
    my ($self, $api, %params) = @_;

    my $mech = $self->mech;
    my $uri = URI->new($self->url . '/api/' . $api);
    $uri->query_form(%params);

    $mech->get($uri);

    return decode_json($mech->content || '{}');
}

sub _post {
    my ($self, $api, %params) = @_;

    my $mech = $self->mech;
    my $uri = URI->new($self->url . '/api/' . $api);

    $mech->post($uri, \%params);

    return decode_json($mech->content || '{}');
}

sub _url_encode {
    my ($str) = @_;
    $str =~ s/(\W)/sprintf('%%%x',ord($1))/eg;
    return $str;
};

1;

__END__