File Coverage

blib/lib/Dist/AutomationPolicy.pm

Criterion	Covered	Total	%
statement	75	78	96.1
branch	21	30	70.0
condition	10	18	55.5
subroutine	17	17	100.0
pod	4	6	66.6
total	127	149	85.2

package Dist::AutomationPolicy;

use v5.24;

use Moo;

use Carp qw( croak );
use File::ShareDir qw( dist_file );
use JSON ();
use JSON::Schema::Validate v0.7.0;
use Path::Tiny qw( path );
use PerlX::Maybe qw( maybe );

use namespace::clean;

use experimental qw( postderef signatures );

our $VERSION = 'v0.2.2';

# ABSTRACT: generate and parse distribution automation policies


has version => (
    is       => 'ro',
    default  => 1,
    required => 1,
);


has distribution => (
    is        => 'ro',
    predicate => 1,
);


has description => (
    is        => 'ro',
    predicate => 1,
);


has document => (
    is        => 'ro',
    predicate => 1,
);


has code_generation => (
    is       => 'ro',
    required => 1,
);


has automated_contributions => (
    is       => 'ro',
    required => 1,
);


has automated_actions => (
    is       => 'ro',
    required => 1,
);


has models => (
    is     => 'ro',
    coerce => sub($val) {
        return $val if ref($val) eq "ARRAY";
        return [$val];
    },
    builder => sub($self) { return [] },
);


has filename => (
    is      => 'lazy',
    default => 'CPAN-META/automation-policy.json',
);

my $json = JSON->new->utf8->pretty->canonical;

my $file = path( dist_file( __PACKAGE__ =~ s/::/-/gr, "automation-policy-schema.json" ) );

my $schema = JSON::Schema::Validate->new( $json->decode( $file->slurp_raw ), compile => 1, );


sub data($self) {
    #<<<
    return {
        version                 => $self->version,
        maybe distribution      => $self->distribution,
        maybe description       => $self->has_description ? $self->description : undef,
        maybe document          => $self->has_document    ? $self->document    : undef,
        code_generation         => $self->code_generation,
        automated_contributions => $self->automated_contributions,
        automated_actions       => $self->automated_actions,
        maybe models            => $self->models->[0] ? $self->models : undef,
    };
    #>>>
}


sub validate( $self, $data = undef ) {
    $data //= $self->data;
    return $schema->is_valid( $data );
}


sub to_json($self) {
    return $json->encode( $self->data );
}


sub BUILD( $self, $ ) {
    $schema->is_valid( $self->data ) or die $schema->error;
}


sub BUILDARGS( $, @args ) {

    if ( @args == 1 && !ref( $args[0] ) ) {
        unshift @args, "template";
    }

    my %args = ( @args == 1 && ref( $args[0] ) eq "HASH" ) ? $args[0]->%* : @args;

    if ( my $version = $args{version} ) {
        croak "unsupported version '${version}'" if $version ne 1;
    }


    if ( my $template = delete $args{template} ) {

        my %templates = (

            no_automation => {
                code_generation         => "toolchain",
                automated_contributions => "none",
                automated_actions       => "comment",
              },

              issues_only => {
                code_generation         => "toolchain",
                automated_contributions => "issue",
                automated_actions       => "issue",
              },

              human_supervised => {
                code_generation         => "machine_generated",
                automated_contributions => "code_request",
                automated_actions       => "code_request",
              },

              data_driven_updates => {
                code_generation         => "external_sources",
                automated_contributions => "issue",
                automated_actions       => "release",
              },

              full_automation => {
                code_generation         => "code_generation",
                automated_contributions => "code_request",
                automated_actions       => "release",
              },

        );

        if ( my $match = $templates{$template} ) {

            for my $attr ( keys $match->%* ) {
                $args{$attr} //= $match->{$attr};
            }

        }
        else {
            croak "Unsupported template: '${template}'";
        }


    }

    return \%args;
}


sub from_json( $class, @args ) {


    if ( @args == 1 && !ref( $args[0] ) ) {
        unshift @args, "json";
    }

    my %args = ( @args == 1 && ref( $args[0] ) eq "HASH" ) ? $args[0]->%* : @args;

    croak "json is required" unless defined $args{json};

    $args{json} = $json->decode( $args{json} ) unless ref( $args{json} );

    if ( my $res = $schema->validate( $args{json} ) ) {
        return $class->new( $args{json} );
    }
    else {
        croak $_ for $res->errors;
    }

}

1;

__END__