File Coverage

blib/lib/Teamcity/Executor.pm

Criterion	Covered	Total	%
statement	32	172	18.6
branch	0	14	0.0
condition	0	8	0.0
subroutine	11	24	45.8
pod	0	10	0.0
total	43	228	18.8

package Teamcity::Executor;
use 5.020;
use strict;
use warnings;

our $VERSION = "1.3.1";

use Moose;
use HTTP::Tiny;
use Cpanel::JSON::XS;
use IO::Async::Timer::Periodic;
use Log::Any qw($log);
use Try::Tiny::Retry ':all';

use feature 'signatures';
no warnings 'experimental::signatures';

has credentials => (is => 'ro', isa => 'HashRef');

has build_id_mapping => (is => 'ro', isa => 'HashRef');

has http => (
    is      => 'ro',
    isa     => 'HTTP::Tiny',
    default => sub { HTTP::Tiny->new(timeout => 10) }
);

has loop => (
    is  => 'ro',
    isa => 'IO::Async::Loop',
);

has teamcity_builds => (
    is      => 'ro',
    isa     => 'HashRef',
    default => sub { {} },
);

has poll_interval => (
    is      => 'ro',
    isa     => 'Int',
    default => 10,
);

has teamcity_auth_url => (
    is      => 'ro',
    isa     => 'Str',
    lazy    => 1,
    default => sub ($self) {
        my $url  = $self->credentials->{url};
        my $user = $self->credentials->{user};
        my $pass = $self->credentials->{pass};

        my ($protocol, $address) = $url =~ m{(http[s]://)(.*)};

        return $protocol . $user . ':' . $pass . '@' . $address;
    }
);

sub http_request ($self, $method, $url, $headers = {}, $content = '') {
    my $response;

    # this code handles the teamcity authentification issues (sometimes authentification fails
    # without a reason)
    retry {
        $response = $self->http->request(
            $method, $url,
            {
                headers => $headers,
                content => $content,
            }
        );

        if ($response->{status} == 599 || ($response->{status} == 401 && !$response->{reason})) {
            $log->info("Authentification to teamcity failed, retrying.");
            die 'Authentification to teamcity failed';
        }
    }
    delay_exp { 10, 1e6 };

    if (!$response->{success}) {
        die "HTTP $method request to $url failed: " . "$response->{status}: $response->{reason}";
    }

    return $response;
}

sub start_teamcity_build ($self, $build_type_id, $properties, $build_name) {
    $build_name //= 'unnamed-build';

    my $build_queue_url = $self->teamcity_auth_url . '/httpAuth/app/rest/buildQueue';

    my $xml_properties = '';

    for my $key (keys %{$properties}) {
        my $value = $properties->{$key};
        $xml_properties .= qq{<property name="$key" value="$value" />\n};
    }

    my $request_body = qq{<build>
                        <buildType id="$build_type_id"/>
                        <properties>
                        $xml_properties
                        </properties>
                </build>};

    my $response = $self->http_request(
        'POST',
        $build_queue_url,
        {
            'Content-Type' => 'application/xml',
            'Accept'       => 'application/json',
        },
        $request_body,
    );

    return decode_json $response->{content};
}

sub run_teamcity_build ($self, $build_type_id, $properties, $build_name, $wait = 1) {

    my $json = $self->start_teamcity_build($build_type_id, $properties, $build_name);

    my $build_id          = $json->{id};
    my $build_detail_href = $json->{webUrl};

    my $f = $self->loop->new_future();

    if ($wait) {
        $self->teamcity_builds->{$build_id} = {
            id          => $build_id,
            status_href => $json->{href},
            href        => $build_detail_href,
            name        => $build_name,
            params      => $properties,
            future      => $f,
        };
    }
    else {
        $f->done({ id => $build_id, href => $build_detail_href, status => '', params => $properties, output => '' });
    }

    return $f, $build_id, $json->{webUrl};
}

sub get_artifact_list ($self, $build_result) {
    # get artifacts summary
    my $artifacts_href = $build_result->{output}{artifacts}{href};
    my $artifacts_url  = $self->teamcity_auth_url . $artifacts_href;
    my $response = $self->http_request('GET', $artifacts_url, { 'Accept' => 'application/json' },);

    my $json = decode_json $response->{content};

    my %artifacts;

    # get individual artifacts URLs
    for my $node (@{$json->{file}}) {
        my $content_href  = $node->{content}{href};
        my $metadata_href = $node->{content}{href};
        my $name          = $node->{name};
        $artifacts{$name} = {
            name          => $name,
            content_href  => $content_href,
            metadata_href => $metadata_href,
        };
    }

    return \%artifacts;
}

sub get_artifact_content ($self, $build_result, $artifact_name) {
    my $artifact_list = $self->get_artifact_list($build_result);

    die "The artifact $artifact_name could not be found!" unless %$artifact_list{$artifact_name};

    my $content_url = $self->teamcity_auth_url . $artifact_list->{$artifact_name}{content_href};

    my $response = $self->http_request('GET', $content_url);

    return $response->{content};
}

sub run ($self, $build_name, $properties = {}) {

    my $teamcity_job_parameters = join(', ', map { "$_: '$properties->{$_}'" } keys %{$properties});
    $log->info("RUN\t$build_name($teamcity_job_parameters)");

    my ($f, $id, $url) = $self->run_teamcity_build($self->build_id_mapping->{$build_name}, $properties, $build_name,);

    $log->info("\t[$id]\t$url");

    return $f;
}

sub touch ($self, $build_name, $properties = {}) {
    my $teamcity_job_parameters = join(', ', map { "$_: '$properties->{$_}'" } keys %{$properties});
    $log->info("TOUCH\t$build_name($teamcity_job_parameters)");

    my ($f, $id, $url) = $self->run_teamcity_build($self->build_id_mapping->{$build_name}, $properties, $build_name, 0);

    $log->info("\t[$id]\t$url");

    return $f;
}

sub touch_without_future ($self, $build_name, $properties = {}) {
    my $teamcity_job_parameters = join(', ', map { "$_: '$properties->{$_}'" } keys %{$properties});
    $log->info("TOUCH WITHOUT FUTURE\t$build_name($teamcity_job_parameters)");

    my $result_json = $self->start_teamcity_build($self->build_id_mapping->{$build_name}, $properties, $build_name);

    $log->info("\t[$result_json->{id}]\t$result_json->{webUrl}");
    return { id => $result_json->{id}, href => $result_json->{webUrl}, status => '', params => $properties, output => $result_json };
}


sub poll_teamcity_results($self) {
    $log->info('.');

    for my $build (values %{$self->teamcity_builds}) {
        my $url = $self->teamcity_auth_url . $build->{status_href};

        my $response = $self->http_request('GET', $url, { 'Accept' => 'application/json' },);

        my $json = decode_json $response->{content};

        my $state  = $json->{state};
        my $status = $json->{status};

        $log->info("$build->{name} [$build->{id}]: QUEUED") if $state eq 'queued';

        next if $state ne 'finished';

        my $job_result = {
            id     => $build->{id},
            href   => $build->{href},
            status => $status,
            params => $build->{params},
            output => $json
        };

        my $teamcity_job_parameters = join(', ', map { "$_: '$build->{params}->{$_}'" } keys %{$build->{params}});
        $log->info("$status\t".$build->{name}."($teamcity_job_parameters)");
        $log->info("\t[".$build->{id}."]\t".$build->{href});

        if ($status eq 'SUCCESS') {
            $build->{future}->done($job_result);
        }
        else {
            $build->{future}->fail($job_result);
        }

        delete $self->teamcity_builds->{ $build->{id} };
    }
}

sub register_polling_timer($self) {
    my $timer = IO::Async::Timer::Periodic->new(
        interval => $self->poll_interval,
        on_tick  => sub {
            $self->poll_teamcity_results();
        },
    );

    $self->loop->add($timer);
    $timer->start();
}

1;
__END__

=encoding utf-8

=head1 NAME

Teamcity::Executor - Executor of TeamCity build configurations

=head1 SYNOPSIS 1 - asynchronous usage

    use Teamcity::Executor;
    use IO::Async::Loop;
    use Log::Any::Adapter;

    Log::Any::Adapter->set(
        'Dispatch',
        outputs => [
            [
                'Screen',
                min_level => 'debug',
                stderr    => 1,
                newline   => 1
            ]
        ]
    );

    my $loop = IO::Async::Loop->new;
    my $tc = Teamcity::Executor->new(
        credentials => {
            url  => 'https://teamcity.example.com',
            user => 'user',
            pass => 'password',
        },
        build_id_mapping => {
            hello_world => 'playground_HelloWorld',
            hello_name  => 'playground_HelloName',
        }
        poll_interval => 10,
        loop => $loop,
    );

    $tc->register_polling_timer();

    my $future = $tc->run('hello_name', { name => 'TeamCity' })->then(
        sub {
            my ($build) = @_;
            print "Build succeeded\n";
            my $greeting = $tc->get_artifact_content($build, 'greeting.txt');
            print "Content of greeting.txt artifact: $greeting\n";
        },
        sub {
            print "Build failed\n";
            exit 1
        }
    );

    my $touch_future = $tc->touch('hello_name', { name => 'TeamCity' })->then(
        sub {
            my ($build) = @_;
            print "Touch build started\n";
            $loop->stop();
        },
        sub {
            print "Touch build failed to start\n";
            exit 1
        }
    );

    $loop->run();

=head1 SYNOPSIS 2 - synchronous usage

    use Teamcity::Executor;
    use Log::Any::Adapter;

    Log::Any::Adapter->set(
        'Dispatch',
        outputs => [
            [
                'Screen',
                min_level => 'debug',
                stderr    => 1,
                newline   => 1
            ]
        ]
    );

    my $tc = Teamcity::Executor->new(
        credentials => {
            url  => 'https://teamcity.example.com',
            user => 'user',
            pass => 'password',
        },
        build_id_mapping => {
            hello_world => 'playground_HelloWorld',
            hello_name  => 'playground_HelloName',
        }
    );

    my $resp = $tc->touch_without_future('hello_name', {});

    print "id: $resp->{id}\n";
    print "webUrl: $resp->{webUrl}\n";

=head1 DESCRIPTION

Teamcity::Executor is a module for executing Teamcity build configurations.
When you execute one, you'll receive a future of the build. Teamcity::Executor
polls TeamCity and when it finds the build has ended, it resolves the future.

=head1 LICENSE

Copyright (C) Avast Software

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 AUTHOR

Miroslav Tynovsky E<lt>[e-mail]<gt>

=cut