view release on metacpan or  search on metacpan

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

package API::Docker::Role::Type;
# ABSTRACT: Instance behaviour of a generated API::Docker::Type class
our $VERSION = '0.004';
use Moo::Role;
use Carp qw( croak );
use JSON::MaybeXS ();
use namespace::clean;


# The merged views are rebuilt whenever API::Docker::Type registers a new
# attribute (it calls _invalidate_docker_cache), so they can be cached. Keyed
# by class name, one entry each.
my %ATTR_CACHE;    # class -> { perl_name => info }
my %ORDER_CACHE;   # class -> [ perl_name, ... ]
my %WIRE_CACHE;    # class -> { wire_name => perl_name }
my %ENTITY_CACHE;  # class -> { perl_name => 1 }  (not daemon fields)


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


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

# True while `from_data` is inflating a decoded engine response, so that the
# hashref coercion in API::Docker::Type reads a nested literal the same way
# the outermost one was read. Dynamically scoped: `local`ised around the
# whole construction, which is what a nested from_data sees.
our $RESPONSE = 0;


# Constructor-side name resolution for `new`, and one of the two places
# unknown fields are collected. A key is taken as a Perl attribute name
# first and as a wire name second, because `new` assembles a REQUEST out of
# what a caller wrote and both spellings are the caller's to choose. The
# response path does not come through here -- see L</from_data>.
#
# Two keys resolving to one attribute is refused rather than decided by hash
# order, and refused whether or not the two values agree: values that happen
# to match are not the same thing as an unambiguous call, and the caller
# should see the mistake instead of the luck (karr k85).
#
# Idempotent on purpose: where one generated class extends another (the
# `allOf` shape, see API::Docker::Type) the role is composed into both, so
# this modifier runs twice on the same arguments. The second pass sees every
# key already resolved and merges an empty set into unknown_fields.
around BUILDARGS => sub {
  my ($orig, $class, @args) = @_;
  my $args = $class->$orig(@args);
  my $known = $class->_docker_attr_registry;
  my $wire  = $class->_docker_wire_index;
  my $mine  = $class->_entity_attribute_index;
  my %unknown  = %{ delete($args->{unknown_fields})  || {} };
  my %rejected = %{ delete($args->{rejected_fields}) || {} };
  my (%out, %from);
  for my $key (keys %$args) {
    my $attr = $known->{$key}           ? $key
             : defined $wire->{$key}    ? $wire->{$key}
             : $mine->{$key}            ? $key
             :                            undef;
    unless (defined $attr) { $unknown{$key} = $args->{$key}; next }
    croak __PACKAGE__ . ": $class got '"
      . join("' and '", sort($from{$attr}, $key))
      . "' for the same field '$attr'; pass one spelling, not both"
      if exists $out{$attr};
    $out{$attr}  = $args->{$key};
    $from{$attr} = $key;
  }
  $out{unknown_fields}  = \%unknown;
  $out{rejected_fields} = \%rejected;
  return \%out;
};


sub from_data {
  my ($class, $data, %extra) = @_;
  $class = ref($class) if ref($class);
  croak __PACKAGE__ . '->from_data needs a HashRef'
    unless ref $data eq 'HASH';
  my $reg  = $class->_docker_attr_registry;
  my $wire = $class->_docker_wire_index;
  # Lifted out of the loop rather than handled in it, so that what the loop