view release on metacpan or  search on metacpan

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

  my ($info, $value) = @_;
  local $@;
  my $coerced = $info->{coerce} ? eval { $info->{coerce}->($value) } : $value;
  return (0) if $@;
  return (0) if $info->{isa} && !$info->{isa}->check($coerced);
  return (1, $coerced);
}


sub from_json {
  my ($class, $json) = @_;
  return $class->from_data(JSON::MaybeXS->new(utf8 => 1)->decode($json));
}


sub TO_JSON {
  my ($self) = @_;
  my %out = %{ $self->unknown_fields };
  my $reg = $self->_docker_attr_registry;
  for my $attr (@{ $self->_docker_attr_order }) {
    my $value = $self->$attr;
    next unless defined $value;
    $out{ $reg->{$attr}{wire} }
      = API::Docker::Type::_encode_value($reg->{$attr}{type}, $value);
  }
  return \%out;
}


sub to_json {
  my ($self) = @_;
  return JSON::MaybeXS->new(utf8 => 1, canonical => 1, convert_blessed => 1)
    ->encode($self->TO_JSON);
}


sub docker_attributes { return $_[0]->_docker_attr_registry }


sub docker_attribute_order { return $_[0]->_docker_attr_order }

# --- attributes that are not the daemon's ----------------------------------
#
# API::Docker::Role::Entity puts `client` on a generated class so the
# convenience methods have something to delegate through. It arrives at the
# same constructor as the daemon's fields, and without being named here it is
# neither a registry entry nor a wire name, so BUILDARGS would file it under
# unknown_fields -- where TO_JSON would faithfully offer the client object to
# the engine and JSON::MaybeXS would die trying to encode it. A class that
# composes such a role answers _entity_attributes with their names.

sub _entity_attribute_index {
  my $class = ref($_[0]) || $_[0];
  return $ENTITY_CACHE{$class} //= do {
    my %mine = $class->can('_entity_attributes')
      ? (map { ($_ => 1) } $class->_entity_attributes)
      : ();
    my $reg  = _docker_attr_registry($class);
    my $wire = _docker_wire_index($class);
    # Both sets reach the same constructor, so a name in both is an ambiguity
    # nobody can resolve at runtime -- say so instead of picking one.
    for my $name (sort keys %mine) {
      croak __PACKAGE__ . ": $class has '$name' as an entity attribute and as "
        . 'a daemon field; one of the two has to be renamed'
        if $reg->{$name} || defined $wire->{$name};
    }
    \%mine;
  };
}

# --- merged views over @ISA ------------------------------------------------
#
# A generated class that resolves an `allOf` inherits its parent's fields
# (see API::Docker::Type), so every lookup below is the class's own registry
# entry merged with its ancestors'. Nearest declaration wins.

sub _docker_attr_registry {
  my $class = ref($_[0]) || $_[0];
  return $ATTR_CACHE{$class} //= _merge_registry($class);
}

sub _merge_registry {
  my ($class) = @_;
  my %info = %{ $API::Docker::Type::REGISTRY{$class} // {} };
  no strict 'refs';
  for my $parent (@{"${class}::ISA"}) {
    my $up = _merge_registry($parent);
    $info{$_} //= $up->{$_} for keys %$up;
  }
  return \%info;
}

sub _docker_attr_order {
  my $class = ref($_[0]) || $_[0];
  return $ORDER_CACHE{$class} //= _merge_order($class);
}

sub _merge_order {
  my ($class) = @_;
  my (@order, %seen);
  _append_order($class, \@order, \%seen);
  return \@order;
}

sub _append_order {
  my ($class, $order, $seen) = @_;
  no strict 'refs';
  # Parents first: the swagger lists the inherited `$ref` ahead of the
  # class's own properties, and this keeps TO_JSON in that order.
  _append_order($_, $order, $seen) for @{"${class}::ISA"};
  for my $attr (@{"${class}::_docker_attr_order"}) {
    next if $seen->{$attr}++;
    push @$order, $attr;
  }
  return;
}

sub _docker_wire_index {
  my $class = ref($_[0]) || $_[0];
  return $WIRE_CACHE{$class} //= do {
    my $reg = _docker_attr_registry($class);