view release on metacpan or  search on metacpan

lib/API/Docker/Type.pm  view on Meta::CPAN

package API::Docker::Type;
# ABSTRACT: The DSL and attribute registry behind the generated Docker types
our $VERSION = '0.004';
our %REGISTRY;
use Moo ();
use Moo::Role ();
use Carp qw( croak );
use Import::Into;
use Module::Runtime qw( use_module );
use Package::Stash;
use Scalar::Util qw( blessed );
use Types::Standard qw( Any ArrayRef Bool HashRef InstanceOf Int Maybe Num Str );
use API::Docker::Role::Type ();
use JSON::MaybeXS ();
use namespace::clean;


my %SCALAR_TYPE = (
  Str  => Str,
  Int  => Int,
  Num  => Num,
  Bool => Bool,
);

# Names API::Docker::Role::Type already occupies. A generated attribute that
# collided with one of these would silently replace it, so it is refused
# instead -- the generator has to pick another Perl name and say so with an
# explicit `wire`.
my %RESERVED = map { ($_ => 1) } qw(
  new BUILDARGS unknown_fields rejected_fields from_data from_json TO_JSON to_json
  docker_attributes docker_attribute_order docker docker_extends
);

sub import {
  my ($class) = @_;
  $class->_setup_class(scalar caller);
  return;
}

# Per-class state that has to outlive the class's own compilation, because a
# generated class ends its body with `use namespace::clean`. That pragma takes
# a snapshot of the package's subs when it is reached and strips every one of
# them at the end of the class's compilation -- the imported Moo and type
# sugar, the two DSL keywords, AND anything a role composed at that point had
# already installed. Two consequences shape the setup below.
#
#   has / extends -- The runtime `docker ...;` and `docker_extends ...;` lines
#     fire after that cleanup, so by then `has` and `extends` are gone from the
#     class and `$target->can('has')` returns undef. The `docker` keyword and
#     the `Str`/`Int`/... it is handed survive the same cleanup only because
#     Perl bound their CV into the call site at compile time; a name the DSL
#     looks up by string at runtime has no such binding, so the two it resolves
#     that way are captured here while they are still imported.
#
#   the role -- API::Docker::Role::Type is NOT composed here. Composed at
#     import (a BEGIN action) its methods and its two attributes would sit in
#     namespace::clean's snapshot and be stripped with the sugar. So it is
#     composed on the first `docker`/`docker_extends` call instead -- at
#     runtime, after the cleanup, exactly as a `with 'Role'` line in a Moo
#     class body would run. Every generated class issues at least one such
#     call, and the composition lands before any object of the class is built.
my %CLASS_SUGAR;

sub _setup_class {
  my ($class, $target) = @_;
  Moo->import::into($target);
  Types::Standard->import::into($target, qw( Any Bool Int Num Str ));
  $CLASS_SUGAR{$target} = {
    has     => $target->can('has'),
    extends => $target->can('extends'),
  };
  my $stash = Package::Stash->new($target);
  $stash->add_symbol('&docker'         => sub { $class->_docker($target, @_) });
  $stash->add_symbol('&docker_extends' => sub { $class->_docker_extends($target, @_) });
  return;
}

# Compose API::Docker::Role::Type once, on the first DSL call the class makes.
# Runtime, so it outlasts the class's `use namespace::clean`; idempotent, so
# the second and later DSL calls are a cheap flag check.
sub _ensure_role {
  my ($target) = @_;
  return if $CLASS_SUGAR{$target}{role_composed};
  $CLASS_SUGAR{$target}{role_composed} = 1;
  Moo::Role->apply_roles_to_package($target, 'API::Docker::Role::Type');
  return;
}