API-Docker
view release on metacpan or search on metacpan
received the program in object code or executable form alone.)
Source code for a work means the preferred form of the work for making
modifications to it. For an executable file, complete source code means
all the source code for all modules it contains; but, as a special
exception, it need not include source code for modules which are standard
libraries that accompany the operating system on which the executable
file runs, or for standard header files or definitions files that
accompany that operating system.
4. You may not copy, modify, sublicense, distribute or transfer the
Program except as expressly provided under this General Public License.
Any attempt otherwise to copy, modify, sublicense, distribute or transfer
the Program is void, and will automatically terminate your rights to use
the Program under this License. However, parties who have received
copies, or rights to use copies, from you under this General Public
License will not have their licenses terminated so long as such parties
remain in full compliance.
5. By copying, distributing or modifying the Program (or any work based
on the Program) you indicate your acceptance of this license to do so,
and all its terms and conditions.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the original
licensor to copy, distribute or modify the Program subject to these
terms and conditions. You may not impose any further restrictions on the
recipients' exercise of the rights granted herein.
7. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of the license which applies to it and "any
under the copyright of this Package, but belong to whoever generated
them, and may be sold commercially, and may be aggregated with this
Package. If such scripts or library files are aggregated with this
Package via the so-called "undump" or "unexec" methods of producing a
binary executable image, then distribution of such an image shall
neither be construed as a distribution of this Package nor shall it
fall under the restrictions of Paragraphs 3 and 4, provided that you do
not represent such an executable image as a Standard Version of this
Package.
7. C subroutines (or comparably compiled subroutines in other
languages) supplied by you and linked into this Package in order to
emulate subroutines and variables of the language defined by this
Package shall not be considered part of this Package, but are the
equivalent of input as in Paragraph 6, provided these subroutines do
not change the language in any way that would cause it to fail the
regression tests for the language.
8. Aggregation of this Package with a commercial distribution is always
permitted provided that the use of this Package is embedded; that is,
when no overt attempt is made to make this Package's interfaces visible
to the end user of the commercial distribution. Such use shall not be
construed as a distribution of this Package.
9. The name of the Copyright Holder may not be used to endorse or promote
requires 'Moo';
requires 'JSON::MaybeXS';
requires 'MIME::Base64';
requires 'IO::Socket::UNIX';
requires 'URI';
requires 'namespace::clean';
requires 'Log::Any';
on test => sub {
requires 'Test::More';
requires 'Path::Tiny';
};
lib/API/Docker.pm view on Meta::CPAN
use API::Docker::API::System;
use API::Docker::API::Containers;
use API::Docker::API::Images;
use API::Docker::API::Networks;
use API::Docker::API::Volumes;
use API::Docker::API::Exec;
has host => (
is => 'ro',
default => sub { $ENV{DOCKER_HOST} // 'unix:///var/run/docker.sock' },
);
has api_version => (
is => 'rwp',
default => undef,
);
has tls => (
is => 'ro',
default => 0,
);
has cert_path => (
is => 'ro',
default => sub { $ENV{DOCKER_CERT_PATH} },
);
has _version_negotiated => (
is => 'rw',
default => 0,
);
with 'API::Docker::Role::HTTP';
has system => (
is => 'lazy',
builder => sub { API::Docker::API::System->new(client => $_[0]) },
);
has containers => (
is => 'lazy',
builder => sub { API::Docker::API::Containers->new(client => $_[0]) },
);
has images => (
is => 'lazy',
builder => sub { API::Docker::API::Images->new(client => $_[0]) },
);
has networks => (
is => 'lazy',
builder => sub { API::Docker::API::Networks->new(client => $_[0]) },
);
has volumes => (
is => 'lazy',
builder => sub { API::Docker::API::Volumes->new(client => $_[0]) },
);
has exec => (
is => 'lazy',
builder => sub { API::Docker::API::Exec->new(client => $_[0]) },
);
sub negotiate_version {
my ($self) = @_;
return if $self->_version_negotiated;
return if defined $self->api_version;
$log->debug("Auto-negotiating API version");
my $version_info = $self->_request('GET', '/version');
if ($version_info && $version_info->{ApiVersion}) {
$self->_set_api_version($version_info->{ApiVersion});
$log->debugf("Negotiated API version: %s", $version_info->{ApiVersion});
}
$self->_version_negotiated(1);
}
around _request => sub {
my ($orig, $self, $method, $path, %opts) = @_;
# Auto-negotiate before any versioned request, but not for /version itself
if ($path ne '/version' && !defined $self->api_version && !$self->_version_negotiated) {
$self->negotiate_version;
}
return $self->$orig($method, $path, %opts);
};
lib/API/Docker.pm view on Meta::CPAN
=head1 SUPPORT
=head2 Issues
Please report bugs and feature requests on GitHub at
L<https://github.com/Getty/p5-api-docker/issues>.
=head1 CONTRIBUTING
Contributions are welcome! Please fork the repository and submit a pull request.
=head1 AUTHOR
Torsten Raudssus <getty@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2026 by Torsten Raudssus <torsten@raudssus.de> L<https://raudssus.de/>.
This is free software; you can redistribute it and/or modify it under
lib/API/Docker/API/Containers.pm view on Meta::CPAN
use namespace::clean;
has client => (
is => 'ro',
required => 1,
weak_ref => 1,
);
sub _wrap {
my ($self, $data) = @_;
return API::Docker::Container->new(
client => $self->client,
%$data,
);
}
sub _wrap_list {
my ($self, $list) = @_;
return [ map { $self->_wrap($_) } @$list ];
}
sub list {
my ($self, %opts) = @_;
my %params;
$params{all} = $opts{all} ? 1 : 0 if defined $opts{all};
$params{limit} = $opts{limit} if defined $opts{limit};
$params{size} = $opts{size} ? 1 : 0 if defined $opts{size};
$params{filters} = $opts{filters} if defined $opts{filters};
my $result = $self->client->get('/containers/json', params => \%params);
return $self->_wrap_list($result // []);
}
sub create {
my ($self, %config) = @_;
my %params;
$params{name} = delete $config{name} if defined $config{name};
my $result = $self->client->post('/containers/create', \%config, params => \%params);
return $result;
}
sub inspect {
my ($self, $id) = @_;
croak "Container ID required" unless $id;
my $result = $self->client->get("/containers/$id/json");
return $self->_wrap($result);
}
sub start {
my ($self, $id) = @_;
croak "Container ID required" unless $id;
return $self->client->post("/containers/$id/start", undef);
}
sub stop {
my ($self, $id, %opts) = @_;
croak "Container ID required" unless $id;
my %params;
$params{t} = $opts{timeout} if defined $opts{timeout};
$params{signal} = $opts{signal} if defined $opts{signal};
return $self->client->post("/containers/$id/stop", undef, params => \%params);
}
sub restart {
my ($self, $id, %opts) = @_;
croak "Container ID required" unless $id;
my %params;
$params{t} = $opts{timeout} if defined $opts{timeout};
return $self->client->post("/containers/$id/restart", undef, params => \%params);
}
sub kill {
my ($self, $id, %opts) = @_;
croak "Container ID required" unless $id;
my %params;
$params{signal} = $opts{signal} if defined $opts{signal};
return $self->client->post("/containers/$id/kill", undef, params => \%params);
}
sub remove {
my ($self, $id, %opts) = @_;
croak "Container ID required" unless $id;
my %params;
$params{v} = $opts{volumes} ? 1 : 0 if defined $opts{volumes};
$params{force} = $opts{force} ? 1 : 0 if defined $opts{force};
$params{link} = $opts{link} ? 1 : 0 if defined $opts{link};
return $self->client->delete_request("/containers/$id", params => \%params);
}
sub logs {
my ($self, $id, %opts) = @_;
croak "Container ID required" unless $id;
my %params;
$params{stdout} = defined $opts{stdout} ? ($opts{stdout} ? 1 : 0) : 1;
$params{stderr} = defined $opts{stderr} ? ($opts{stderr} ? 1 : 0) : 1;
$params{since} = $opts{since} if defined $opts{since};
$params{until} = $opts{until} if defined $opts{until};
$params{timestamps} = $opts{timestamps} ? 1 : 0 if defined $opts{timestamps};
$params{tail} = $opts{tail} if defined $opts{tail};
return $self->client->get("/containers/$id/logs", params => \%params);
}
sub top {
my ($self, $id, %opts) = @_;
croak "Container ID required" unless $id;
my %params;
$params{ps_args} = $opts{ps_args} if defined $opts{ps_args};
return $self->client->get("/containers/$id/top", params => \%params);
}
sub stats {
my ($self, $id, %opts) = @_;
croak "Container ID required" unless $id;
my %params;
$params{stream} = 0;
$params{'one-shot'} = 1;
return $self->client->get("/containers/$id/stats", params => \%params);
}
sub wait {
my ($self, $id, %opts) = @_;
croak "Container ID required" unless $id;
my %params;
$params{condition} = $opts{condition} if defined $opts{condition};
return $self->client->post("/containers/$id/wait", undef, params => \%params);
}
sub pause {
my ($self, $id) = @_;
croak "Container ID required" unless $id;
return $self->client->post("/containers/$id/pause", undef);
}
sub unpause {
my ($self, $id) = @_;
croak "Container ID required" unless $id;
return $self->client->post("/containers/$id/unpause", undef);
}
sub rename {
my ($self, $id, $name) = @_;
croak "Container ID required" unless $id;
croak "New name required" unless $name;
return $self->client->post("/containers/$id/rename", undef, params => { name => $name });
}
sub update {
my ($self, $id, %config) = @_;
croak "Container ID required" unless $id;
return $self->client->post("/containers/$id/update", \%config);
}
sub prune {
my ($self, %opts) = @_;
my %params;
$params{filters} = $opts{filters} if defined $opts{filters};
return $self->client->post('/containers/prune', undef, params => \%params);
}
1;
lib/API/Docker/API/Containers.pm view on Meta::CPAN
=head1 SUPPORT
=head2 Issues
Please report bugs and feature requests on GitHub at
L<https://github.com/Getty/p5-api-docker/issues>.
=head1 CONTRIBUTING
Contributions are welcome! Please fork the repository and submit a pull request.
=head1 AUTHOR
Torsten Raudssus <getty@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2026 by Torsten Raudssus <torsten@raudssus.de> L<https://raudssus.de/>.
This is free software; you can redistribute it and/or modify it under
lib/API/Docker/API/Exec.pm view on Meta::CPAN
use namespace::clean;
has client => (
is => 'ro',
required => 1,
weak_ref => 1,
);
sub create {
my ($self, $container_id, %config) = @_;
croak "Container ID required" unless $container_id;
croak "Cmd required" unless $config{Cmd};
return $self->client->post("/containers/$container_id/exec", \%config);
}
sub start {
my ($self, $exec_id, %opts) = @_;
croak "Exec ID required" unless $exec_id;
my $body = {
Detach => $opts{Detach} ? \1 : \0,
Tty => $opts{Tty} ? \1 : \0,
};
return $self->client->post("/exec/$exec_id/start", $body);
}
sub resize {
my ($self, $exec_id, %opts) = @_;
croak "Exec ID required" unless $exec_id;
my %params;
$params{h} = $opts{h} if defined $opts{h};
$params{w} = $opts{w} if defined $opts{w};
return $self->client->post("/exec/$exec_id/resize", undef, params => \%params);
}
sub inspect {
my ($self, $exec_id) = @_;
croak "Exec ID required" unless $exec_id;
return $self->client->get("/exec/$exec_id/json");
}
1;
__END__
lib/API/Docker/API/Exec.pm view on Meta::CPAN
=head1 SUPPORT
=head2 Issues
Please report bugs and feature requests on GitHub at
L<https://github.com/Getty/p5-api-docker/issues>.
=head1 CONTRIBUTING
Contributions are welcome! Please fork the repository and submit a pull request.
=head1 AUTHOR
Torsten Raudssus <getty@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2026 by Torsten Raudssus <torsten@raudssus.de> L<https://raudssus.de/>.
This is free software; you can redistribute it and/or modify it under
lib/API/Docker/API/Images.pm view on Meta::CPAN
use namespace::clean;
has client => (
is => 'ro',
required => 1,
weak_ref => 1,
);
sub _wrap {
my ($self, $data) = @_;
return API::Docker::Image->new(
client => $self->client,
%$data,
);
}
sub _wrap_list {
my ($self, $list) = @_;
return [ map { $self->_wrap($_) } @$list ];
}
sub list {
my ($self, %opts) = @_;
my %params;
$params{all} = $opts{all} ? 1 : 0 if defined $opts{all};
$params{digests} = $opts{digests} ? 1 : 0 if defined $opts{digests};
$params{filters} = $opts{filters} if defined $opts{filters};
my $result = $self->client->get('/images/json', params => \%params);
return $self->_wrap_list($result // []);
}
sub build {
my ($self, %opts) = @_;
my $context = delete $opts{context};
croak "Build context required (tar archive as scalar ref or raw bytes)" unless defined $context;
my %params;
$params{dockerfile} = $opts{dockerfile} if defined $opts{dockerfile};
$params{t} = $opts{t} if defined $opts{t};
$params{q} = $opts{q} ? 1 : 0 if defined $opts{q};
$params{nocache} = $opts{nocache} ? 1 : 0 if defined $opts{nocache};
$params{pull} = $opts{pull} if defined $opts{pull};
lib/API/Docker/API/Images.pm view on Meta::CPAN
my $raw = ref $context eq 'SCALAR' ? $$context : $context;
return $self->client->_request('POST', '/build',
raw_body => $raw,
content_type => 'application/x-tar',
params => \%params,
);
}
sub pull {
my ($self, %opts) = @_;
croak "fromImage required" unless $opts{fromImage};
my %params;
$params{fromImage} = $opts{fromImage};
$params{tag} = $opts{tag} // 'latest';
return $self->client->post('/images/create', undef, params => \%params);
}
sub inspect {
my ($self, $name) = @_;
croak "Image name required" unless $name;
my $result = $self->client->get("/images/$name/json");
return $self->_wrap($result);
}
sub history {
my ($self, $name) = @_;
croak "Image name required" unless $name;
return $self->client->get("/images/$name/history");
}
sub push {
my ($self, $name, %opts) = @_;
croak "Image name required" unless $name;
my %params;
$params{tag} = $opts{tag} if defined $opts{tag};
my $auth_header = _build_registry_auth_header($opts{auth});
return $self->client->post(
"/images/$name/push",
undef,
params => \%params,
headers => { 'X-Registry-Auth' => $auth_header },
);
}
sub _build_registry_auth_header {
my ($auth) = @_;
# The Docker Engine requires an X-Registry-Auth header on every push,
# even for anonymous attempts. Encoding is base64url of a JSON object.
require JSON::MaybeXS;
require MIME::Base64;
my $payload;
if (!defined $auth) {
$payload = '{}';
lib/API/Docker/API/Images.pm view on Meta::CPAN
$payload = $auth;
}
my $b64 = MIME::Base64::encode_base64($payload, '');
$b64 =~ tr{+/}{-_};
$b64 =~ s/=+$//;
return $b64;
}
sub tag {
my ($self, $name, %opts) = @_;
croak "Image name required" unless $name;
my %params;
$params{repo} = $opts{repo} if defined $opts{repo};
$params{tag} = $opts{tag} if defined $opts{tag};
return $self->client->post("/images/$name/tag", undef, params => \%params);
}
sub remove {
my ($self, $name, %opts) = @_;
croak "Image name required" unless $name;
my %params;
$params{force} = $opts{force} ? 1 : 0 if defined $opts{force};
$params{noprune} = $opts{noprune} ? 1 : 0 if defined $opts{noprune};
return $self->client->delete_request("/images/$name", params => \%params);
}
sub search {
my ($self, $term, %opts) = @_;
croak "Search term required" unless $term;
my %params;
$params{term} = $term;
$params{limit} = $opts{limit} if defined $opts{limit};
$params{filters} = $opts{filters} if defined $opts{filters};
return $self->client->get('/images/search', params => \%params);
}
sub prune {
my ($self, %opts) = @_;
my %params;
$params{filters} = $opts{filters} if defined $opts{filters};
return $self->client->post('/images/prune', undef, params => \%params);
}
1;
lib/API/Docker/API/Images.pm view on Meta::CPAN
=head1 SUPPORT
=head2 Issues
Please report bugs and feature requests on GitHub at
L<https://github.com/Getty/p5-api-docker/issues>.
=head1 CONTRIBUTING
Contributions are welcome! Please fork the repository and submit a pull request.
=head1 AUTHOR
Torsten Raudssus <getty@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2026 by Torsten Raudssus <torsten@raudssus.de> L<https://raudssus.de/>.
This is free software; you can redistribute it and/or modify it under
lib/API/Docker/API/Networks.pm view on Meta::CPAN
use namespace::clean;
has client => (
is => 'ro',
required => 1,
weak_ref => 1,
);
sub _wrap {
my ($self, $data) = @_;
return API::Docker::Network->new(
client => $self->client,
%$data,
);
}
sub _wrap_list {
my ($self, $list) = @_;
return [ map { $self->_wrap($_) } @$list ];
}
sub list {
my ($self, %opts) = @_;
my %params;
$params{filters} = $opts{filters} if defined $opts{filters};
my $result = $self->client->get('/networks', params => \%params);
return $self->_wrap_list($result // []);
}
sub inspect {
my ($self, $id) = @_;
croak "Network ID required" unless $id;
my $result = $self->client->get("/networks/$id");
return $self->_wrap($result);
}
sub create {
my ($self, %config) = @_;
croak "Network name required" unless $config{Name};
my $result = $self->client->post('/networks/create', \%config);
return $result;
}
sub remove {
my ($self, $id) = @_;
croak "Network ID required" unless $id;
return $self->client->delete_request("/networks/$id");
}
sub connect {
my ($self, $id, %opts) = @_;
croak "Network ID required" unless $id;
croak "Container required" unless $opts{Container};
return $self->client->post("/networks/$id/connect", \%opts);
}
sub disconnect {
my ($self, $id, %opts) = @_;
croak "Network ID required" unless $id;
croak "Container required" unless $opts{Container};
return $self->client->post("/networks/$id/disconnect", \%opts);
}
sub prune {
my ($self, %opts) = @_;
my %params;
$params{filters} = $opts{filters} if defined $opts{filters};
return $self->client->post('/networks/prune', undef, params => \%params);
}
1;
lib/API/Docker/API/Networks.pm view on Meta::CPAN
=head1 SUPPORT
=head2 Issues
Please report bugs and feature requests on GitHub at
L<https://github.com/Getty/p5-api-docker/issues>.
=head1 CONTRIBUTING
Contributions are welcome! Please fork the repository and submit a pull request.
=head1 AUTHOR
Torsten Raudssus <getty@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2026 by Torsten Raudssus <torsten@raudssus.de> L<https://raudssus.de/>.
This is free software; you can redistribute it and/or modify it under
lib/API/Docker/API/System.pm view on Meta::CPAN
use namespace::clean;
has client => (
is => 'ro',
required => 1,
weak_ref => 1,
);
sub info {
my ($self) = @_;
return $self->client->get('/info');
}
sub version {
my ($self) = @_;
return $self->client->get('/version');
}
sub ping {
my ($self) = @_;
return $self->client->get('/_ping');
}
sub events {
my ($self, %opts) = @_;
my %params;
$params{since} = $opts{since} if defined $opts{since};
$params{until} = $opts{until} if defined $opts{until};
$params{filters} = $opts{filters} if defined $opts{filters};
return $self->client->get('/events', params => \%params);
}
sub df {
my ($self) = @_;
return $self->client->get('/system/df');
}
1;
__END__
lib/API/Docker/API/System.pm view on Meta::CPAN
=head1 SUPPORT
=head2 Issues
Please report bugs and feature requests on GitHub at
L<https://github.com/Getty/p5-api-docker/issues>.
=head1 CONTRIBUTING
Contributions are welcome! Please fork the repository and submit a pull request.
=head1 AUTHOR
Torsten Raudssus <getty@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2026 by Torsten Raudssus <torsten@raudssus.de> L<https://raudssus.de/>.
This is free software; you can redistribute it and/or modify it under
lib/API/Docker/API/Volumes.pm view on Meta::CPAN
use namespace::clean;
has client => (
is => 'ro',
required => 1,
weak_ref => 1,
);
sub _wrap {
my ($self, $data) = @_;
return API::Docker::Volume->new(
client => $self->client,
%$data,
);
}
sub _wrap_list {
my ($self, $list) = @_;
return [ map { $self->_wrap($_) } @$list ];
}
sub list {
my ($self, %opts) = @_;
my %params;
$params{filters} = $opts{filters} if defined $opts{filters};
my $result = $self->client->get('/volumes', params => \%params);
return $self->_wrap_list($result->{Volumes} // []);
}
sub create {
my ($self, %config) = @_;
my $result = $self->client->post('/volumes/create', \%config);
return $self->_wrap($result);
}
sub inspect {
my ($self, $name) = @_;
croak "Volume name required" unless $name;
my $result = $self->client->get("/volumes/$name");
return $self->_wrap($result);
}
sub remove {
my ($self, $name, %opts) = @_;
croak "Volume name required" unless $name;
my %params;
$params{force} = $opts{force} ? 1 : 0 if defined $opts{force};
return $self->client->delete_request("/volumes/$name", params => \%params);
}
sub prune {
my ($self, %opts) = @_;
my %params;
$params{filters} = $opts{filters} if defined $opts{filters};
return $self->client->post('/volumes/prune', undef, params => \%params);
}
1;
lib/API/Docker/API/Volumes.pm view on Meta::CPAN
=head1 SUPPORT
=head2 Issues
Please report bugs and feature requests on GitHub at
L<https://github.com/Getty/p5-api-docker/issues>.
=head1 CONTRIBUTING
Contributions are welcome! Please fork the repository and submit a pull request.
=head1 AUTHOR
Torsten Raudssus <getty@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2026 by Torsten Raudssus <torsten@raudssus.de> L<https://raudssus.de/>.
This is free software; you can redistribute it and/or modify it under
lib/API/Docker/Container.pm view on Meta::CPAN
has Name => (is => 'ro');
has RestartCount => (is => 'ro');
has Driver => (is => 'ro');
has Platform => (is => 'ro');
has Path => (is => 'ro');
has Args => (is => 'ro');
has Config => (is => 'ro');
sub start {
my ($self) = @_;
return $self->client->containers->start($self->Id);
}
sub stop {
my ($self, %opts) = @_;
return $self->client->containers->stop($self->Id, %opts);
}
sub restart {
my ($self, %opts) = @_;
return $self->client->containers->restart($self->Id, %opts);
}
sub kill {
my ($self, %opts) = @_;
return $self->client->containers->kill($self->Id, %opts);
}
sub remove {
my ($self, %opts) = @_;
return $self->client->containers->remove($self->Id, %opts);
}
sub logs {
my ($self, %opts) = @_;
return $self->client->containers->logs($self->Id, %opts);
}
sub inspect {
my ($self) = @_;
return $self->client->containers->inspect($self->Id);
}
sub pause {
my ($self) = @_;
return $self->client->containers->pause($self->Id);
}
sub unpause {
my ($self) = @_;
return $self->client->containers->unpause($self->Id);
}
sub top {
my ($self, %opts) = @_;
return $self->client->containers->top($self->Id, %opts);
}
sub stats {
my ($self, %opts) = @_;
return $self->client->containers->stats($self->Id, %opts);
}
sub is_running {
my ($self) = @_;
my $state = $self->State;
return 0 unless defined $state;
if (ref $state eq 'HASH') {
return $state->{Running} ? 1 : 0;
}
return lc($state) eq 'running' ? 1 : 0;
}
lib/API/Docker/Container.pm view on Meta::CPAN
=head1 SUPPORT
=head2 Issues
Please report bugs and feature requests on GitHub at
L<https://github.com/Getty/p5-api-docker/issues>.
=head1 CONTRIBUTING
Contributions are welcome! Please fork the repository and submit a pull request.
=head1 AUTHOR
Torsten Raudssus <getty@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2026 by Torsten Raudssus <torsten@raudssus.de> L<https://raudssus.de/>.
This is free software; you can redistribute it and/or modify it under
lib/API/Docker/Image.pm view on Meta::CPAN
has VirtualSize => (is => 'ro');
has Labels => (is => 'ro');
has Containers => (is => 'ro');
has Architecture => (is => 'ro');
has Os => (is => 'ro');
has Config => (is => 'ro');
has RootFS => (is => 'ro');
has Metadata => (is => 'ro');
sub inspect {
my ($self) = @_;
return $self->client->images->inspect($self->Id);
}
sub history {
my ($self) = @_;
return $self->client->images->history($self->Id);
}
sub tag {
my ($self, %opts) = @_;
return $self->client->images->tag($self->Id, %opts);
}
sub remove {
my ($self, %opts) = @_;
return $self->client->images->remove($self->Id, %opts);
}
1;
__END__
lib/API/Docker/Image.pm view on Meta::CPAN
=head1 SUPPORT
=head2 Issues
Please report bugs and feature requests on GitHub at
L<https://github.com/Getty/p5-api-docker/issues>.
=head1 CONTRIBUTING
Contributions are welcome! Please fork the repository and submit a pull request.
=head1 AUTHOR
Torsten Raudssus <getty@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2026 by Torsten Raudssus <torsten@raudssus.de> L<https://raudssus.de/>.
This is free software; you can redistribute it and/or modify it under
lib/API/Docker/Network.pm view on Meta::CPAN
has IPAM => (is => 'ro');
has Internal => (is => 'ro');
has Attachable => (is => 'ro');
has Ingress => (is => 'ro');
has Options => (is => 'ro');
has Labels => (is => 'ro');
has Containers => (is => 'ro');
has ConfigFrom => (is => 'ro');
has ConfigOnly => (is => 'ro');
sub inspect {
my ($self) = @_;
return $self->client->networks->inspect($self->Id);
}
sub remove {
my ($self) = @_;
return $self->client->networks->remove($self->Id);
}
sub connect {
my ($self, %opts) = @_;
return $self->client->networks->connect($self->Id, %opts);
}
sub disconnect {
my ($self, %opts) = @_;
return $self->client->networks->disconnect($self->Id, %opts);
}
1;
__END__
lib/API/Docker/Network.pm view on Meta::CPAN
=head1 SUPPORT
=head2 Issues
Please report bugs and feature requests on GitHub at
L<https://github.com/Getty/p5-api-docker/issues>.
=head1 CONTRIBUTING
Contributions are welcome! Please fork the repository and submit a pull request.
=head1 AUTHOR
Torsten Raudssus <getty@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2026 by Torsten Raudssus <torsten@raudssus.de> L<https://raudssus.de/>.
This is free software; you can redistribute it and/or modify it under
lib/API/Docker/Role/HTTP.pm view on Meta::CPAN
requires 'host';
requires 'api_version';
has _socket => (
is => 'lazy',
clearer => '_clear_socket',
);
sub _build__socket {
my ($self) = @_;
my $host = $self->host;
if ($host =~ m{^unix://(.+)$}) {
my $path = $1;
$log->debugf("Connecting to Unix socket: %s", $path);
my $sock = IO::Socket::UNIX->new(
Peer => $path,
Type => SOCK_STREAM,
);
lib/API/Docker/Role/HTTP.pm view on Meta::CPAN
Proto => 'tcp',
);
croak "Cannot connect to $addr:$port: $!" unless $sock;
return $sock;
}
else {
croak "Unsupported host format: $host (expected unix:// or tcp://)";
}
}
sub _reconnect {
my ($self) = @_;
$self->_clear_socket;
return $self->_socket;
}
sub _request {
my ($self, $method, $path, %opts) = @_;
my $version = $self->api_version;
my $url_path = defined $version ? "/v$version$path" : $path;
my $body_content = '';
my $content_type = 'application/json';
if ($opts{raw_body}) {
$body_content = $opts{raw_body};
$content_type = $opts{content_type} // 'application/x-tar';
lib/API/Docker/Role/HTTP.pm view on Meta::CPAN
next unless $line =~ /\S/;
my $obj = eval { decode_json($line) };
push @objects, $obj if defined $obj;
}
return \@objects if @objects;
}
return $body;
}
sub _read_response {
my ($self, $sock) = @_;
my $status_line = <$sock>;
croak "No response from Docker daemon" unless defined $status_line;
$status_line =~ s/\r?\n$//;
my ($proto, $status_code, $status_text) = split /\s+/, $status_line, 3;
my %headers;
while (my $line = <$sock>) {
lib/API/Docker/Role/HTTP.pm view on Meta::CPAN
}
}
else {
local $/;
$body = <$sock> // '';
}
return [$status_code, $status_text, \%headers, $body];
}
sub _read_chunked {
my ($self, $sock) = @_;
my $body = '';
while (1) {
my $chunk_header = <$sock>;
last unless defined $chunk_header;
$chunk_header =~ s/\r?\n$//;
my $chunk_size = hex($chunk_header);
last if $chunk_size == 0;
lib/API/Docker/Role/HTTP.pm view on Meta::CPAN
}
$body .= $chunk;
# Read trailing \r\n after chunk data
<$sock>;
}
return $body;
}
sub _uri_encode {
my ($str) = @_;
$str =~ s/([^A-Za-z0-9\-_.~:\/])/sprintf("%%%02X", ord($1))/ge;
return $str;
}
sub get {
my ($self, $path, %opts) = @_;
return $self->_request('GET', $path, %opts);
}
sub post {
my ($self, $path, $body, %opts) = @_;
$opts{body} = $body if defined $body;
return $self->_request('POST', $path, %opts);
}
sub put {
my ($self, $path, $body, %opts) = @_;
$opts{body} = $body if defined $body;
return $self->_request('PUT', $path, %opts);
}
sub delete_request {
my ($self, $path, %opts) = @_;
return $self->_request('DELETE', $path, %opts);
}
1;
__END__
lib/API/Docker/Role/HTTP.pm view on Meta::CPAN
=head1 SUPPORT
=head2 Issues
Please report bugs and feature requests on GitHub at
L<https://github.com/Getty/p5-api-docker/issues>.
=head1 CONTRIBUTING
Contributions are welcome! Please fork the repository and submit a pull request.
=head1 AUTHOR
Torsten Raudssus <getty@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2026 by Torsten Raudssus <torsten@raudssus.de> L<https://raudssus.de/>.
This is free software; you can redistribute it and/or modify it under
lib/API/Docker/Volume.pm view on Meta::CPAN
has Mountpoint => (is => 'ro');
has CreatedAt => (is => 'ro');
has Status => (is => 'ro');
has Labels => (is => 'ro');
has Scope => (is => 'ro');
has Options => (is => 'ro');
has UsageData => (is => 'ro');
sub inspect {
my ($self) = @_;
return $self->client->volumes->inspect($self->Name);
}
sub remove {
my ($self, %opts) = @_;
return $self->client->volumes->remove($self->Name, %opts);
}
1;
__END__
lib/API/Docker/Volume.pm view on Meta::CPAN
=head1 SUPPORT
=head2 Issues
Please report bugs and feature requests on GitHub at
L<https://github.com/Getty/p5-api-docker/issues>.
=head1 CONTRIBUTING
Contributions are welcome! Please fork the repository and submit a pull request.
=head1 AUTHOR
Torsten Raudssus <getty@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2026 by Torsten Raudssus <torsten@raudssus.de> L<https://raudssus.de/>.
This is free software; you can redistribute it and/or modify it under
t/containers.t view on Meta::CPAN
use strict;
use warnings;
use Test::More;
use lib 't/lib';
use Test::API::Docker::Mock;
check_live_access();
# --- Read Tests (always run) ---
subtest 'list containers' => sub {
my $docker = test_docker(
'GET /containers/json' => load_fixture('containers_list'),
);
my $containers = $docker->containers->list(all => 1);
is(ref $containers, 'ARRAY', 'returns array');
if (@$containers) {
isa_ok($containers->[0], 'API::Docker::Container');
ok($containers->[0]->Id, 'has Id');
t/containers.t view on Meta::CPAN
my $second = $containers->[1];
is($second->Id, 'def789ghi012', 'second container id');
is($second->State, 'exited', 'second container state');
ok(!$second->is_running, 'is_running returns false for exited container');
}
};
# --- Write Tests (mock always, live only with WRITE) ---
subtest 'container lifecycle' => sub {
skip_unless_write();
my $docker = test_docker(
'POST /containers/create' => { Id => 'mock123', Warnings => [] },
'POST /containers/mock123/start' => undef,
'GET /containers/mock123/json' => load_fixture('container_inspect'),
'GET /containers/mock123/top' => {
Titles => ['UID', 'PID', 'PPID', 'C', 'STIME', 'TTY', 'TIME', 'CMD'],
Processes => [
['root', '12345', '1', '0', '08:00', '?', '00:00:00', 'sleep'],
t/containers.t view on Meta::CPAN
my $name = 'api-docker-test-' . $$;
my $created = $docker->containers->create(
name => $name,
Image => 'alpine:latest',
Cmd => ['sleep', '10'],
);
ok($created->{Id}, 'created container has Id');
my $id = is_live() ? $created->{Id} : 'mock123';
register_cleanup(sub { $docker->containers->remove($id, force => 1) }) if is_live();
$docker->containers->start($id);
pass('container started');
my $container = $docker->containers->inspect($id);
isa_ok($container, 'API::Docker::Container');
ok($container->is_running, 'container is running');
my $top = $docker->containers->top($id);
is(ref $top->{Processes}, 'ARRAY', 'top has processes');
t/containers.t view on Meta::CPAN
$docker->containers->stop($id, timeout => 3);
pass('container stopped');
$docker->containers->remove($id);
pass('container removed');
};
# --- Validation Tests (always run, no Docker needed) ---
subtest 'container ID required' => sub {
my $docker = test_docker();
eval { $docker->containers->inspect(undef) };
like($@, qr/Container ID required/, 'croak on missing ID for inspect');
eval { $docker->containers->start(undef) };
like($@, qr/Container ID required/, 'croak on missing ID for start');
eval { $docker->containers->stop(undef) };
like($@, qr/Container ID required/, 'croak on missing ID for stop');
use strict;
use warnings;
use Test::More;
use lib 't/lib';
use Test::API::Docker::Mock;
check_live_access();
# --- Read Tests (always run) ---
subtest 'list images' => sub {
my $docker = test_docker(
'GET /images/json' => load_fixture('images_list'),
);
my $images = $docker->images->list;
is(ref $images, 'ARRAY', 'returns array');
if (@$images) {
isa_ok($images->[0], 'API::Docker::Image');
ok($images->[0]->Id, 'has Id');
is(scalar @$images, 2, 'two images');
my $first = $images->[0];
like($first->Id, qr/^sha256:abc123/, 'image id');
is_deeply($first->RepoTags, ['nginx:latest', 'nginx:1.25'], 'repo tags');
is($first->Size, 187654321, 'image size');
is($first->Containers, 2, 'container count');
}
};
subtest 'inspect image' => sub {
my $docker = test_docker(
'GET /images/nginx:latest/json' => {
Id => 'sha256:abc123',
RepoTags => ['nginx:latest'],
Architecture => 'amd64',
Os => 'linux',
Size => 187654321,
Config => {
Cmd => ['nginx', '-g', 'daemon off;'],
},
isa_ok($image, 'API::Docker::Image');
ok($image->Id, 'has Id');
unless (is_live()) {
is($image->Id, 'sha256:abc123', 'image id');
is($image->Architecture, 'amd64', 'architecture');
is($image->Os, 'linux', 'os');
}
};
subtest 'image history' => sub {
my $docker = test_docker(
'GET /images/nginx:latest/history' => [
{
Id => 'sha256:abc123',
Created => 1705300000,
CreatedBy => '/bin/sh -c #(nop) CMD ["nginx" "-g" "daemon off;"]',
Size => 0,
},
{
Id => 'sha256:def456',
$history = $docker->images->history('nginx:latest');
}
is(ref $history, 'ARRAY', 'history is array');
unless (is_live()) {
is(scalar @$history, 2, 'two history entries');
}
};
subtest 'search images' => sub {
my $docker = test_docker(
'GET /images/search' => [
{
name => 'nginx',
description => 'Official nginx image',
star_count => 19000,
is_official => 1,
is_automated => 0,
},
],
is(ref $results, 'ARRAY', 'search returns array');
unless (is_live()) {
is($results->[0]{name}, 'nginx', 'found nginx');
}
};
# --- Write Tests (mock always, live only with WRITE) ---
subtest 'image build and pull lifecycle' => sub {
skip_unless_write();
my $docker = test_docker(
'POST /build' => sub {
my ($method, $path, %opts) = @_;
ok(defined $opts{raw_body}, 'raw_body present in request');
is($opts{content_type}, 'application/x-tar', 'content type is tar');
return { stream => 'Successfully built abc123def456' };
},
'POST /images/create' => sub {
my ($method, $path, %opts) = @_;
return '';
},
'POST /images/nginx:latest/tag' => undef,
'DELETE /images/nginx:latest' => [
{ Untagged => 'nginx:latest' },
{ Deleted => 'sha256:abc123' },
],
);
$header .= pack('a6', 'ustar');
$header .= pack('a2', '00');
$header .= pack('a32', '');
$header .= pack('a32', '');
$header .= pack('a8', '');
$header .= pack('a8', '');
$header .= pack('a155', '');
$header .= "\0" x (512 - length($header));
my $checksum = 0;
$checksum += ord(substr($header, $_, 1)) for 0..511;
substr($header, 148, 8, sprintf('%06o', $checksum) . "\0 ");
my $tar = $header;
$tar .= $dockerfile;
$tar .= "\0" x (512 - ($size % 512)) if $size % 512;
$tar .= "\0" x 1024;
my $tag = 'api-docker-test-build:latest';
my $result = $docker->images->build(context => $tar, t => $tag, q => 1);
ok($result, 'build returned result');
register_cleanup(sub { eval { $docker->images->remove($tag, force => 1) } });
} else {
my $result = $docker->images->build(
context => 'fake-tar-data',
t => 'myapp:latest',
dockerfile => 'Dockerfile',
);
ok($result, 'build returned a result');
like($result->{stream}, qr/Successfully built/, 'build output contains success');
$docker->images->pull(fromImage => 'nginx', tag => 'latest');
$docker->images->tag('nginx:latest', repo => 'myrepo/nginx', tag => 'v1');
pass('tag completed');
my $removed = $docker->images->remove('nginx:latest');
is(ref $removed, 'ARRAY', 'remove returns array of actions');
}
};
# --- Validation Tests (always run, no Docker needed) ---
subtest 'build requires context' => sub {
my $docker = test_docker();
eval { $docker->images->build(t => 'myapp:latest') };
like($@, qr/Build context required/, 'croak on missing context');
};
subtest 'image name required' => sub {
my $docker = test_docker();
eval { $docker->images->inspect(undef) };
like($@, qr/Image name required/, 'croak on missing name for inspect');
eval { $docker->images->remove(undef) };
like($@, qr/Image name required/, 'croak on missing name for remove');
};
done_testing;
t/images_push_auth.t view on Meta::CPAN
use strict;
use warnings;
use Test::More;
use JSON::MaybeXS qw( decode_json );
use MIME::Base64 qw( decode_base64 decode_base64url );
use API::Docker::API::Images;
sub b64url_decode {
my ($s) = @_;
$s =~ tr{-_}{+/};
my $pad = (4 - length($s) % 4) % 4;
$s .= '=' x $pad;
return decode_base64($s);
}
subtest 'empty/undef auth -> base64url("{}")' => sub {
my $hdr = API::Docker::API::Images::_build_registry_auth_header(undef);
ok length($hdr), 'header is non-empty for undef';
is_deeply(decode_json(b64url_decode($hdr)), {},
'decodes to empty JSON object');
};
subtest 'hashref auth -> JSON-encoded credentials' => sub {
my $auth = {
username => 'me',
password => 'secret',
serveraddress => 'https://index.docker.io/v1/',
};
my $hdr = API::Docker::API::Images::_build_registry_auth_header($auth);
is_deeply(decode_json(b64url_decode($hdr)), $auth,
'header roundtrips through base64url + JSON');
};
subtest 'identitytoken auth' => sub {
my $auth = { identitytoken => 'tok-123', serveraddress => 'ghcr.io' };
my $hdr = API::Docker::API::Images::_build_registry_auth_header($auth);
is_deeply(decode_json(b64url_decode($hdr)), $auth,
'identitytoken roundtrips');
};
subtest 'pre-encoded base64-like string passes through' => sub {
my $pre = 'eyJ1IjoibWUifQ';
is API::Docker::API::Images::_build_registry_auth_header($pre), $pre,
'string passed through unchanged';
};
subtest 'push() sends X-Registry-Auth via _request' => sub {
require API::Docker;
my $docker = API::Docker->new(
host => 'unix:///dev/null',
api_version => '1.47',
);
my $captured;
my $mock = sub {
my ($self, $method, $path, %opts) = @_;
$captured = { method => $method, path => $path, %opts };
return [];
};
no warnings 'redefine';
local *API::Docker::_request = $mock;
$docker->images->push(
'raudssus/karr:user',
t/lib/Test/API/Docker/Mock.pm view on Meta::CPAN
can_write
skip_unless_write
check_live_access
register_cleanup
);
my $FIXTURES_DIR = path(__FILE__)->parent->parent->parent->parent->parent->child('fixtures');
my @_cleanups;
sub load_fixture {
my ($name) = @_;
my $file = $FIXTURES_DIR->child("$name.json");
croak "Fixture not found: $file" unless $file->exists;
return decode_json($file->slurp_utf8);
}
sub is_live {
return !!$ENV{API_DOCKER_TEST_HOST};
}
sub can_write {
return is_live() && !!$ENV{API_DOCKER_TEST_WRITE};
}
sub skip_unless_write {
if (is_live() && !can_write()) {
plan skip_all => 'Write tests skipped (set API_DOCKER_TEST_WRITE=1 to enable)';
}
}
sub check_live_access {
return unless is_live();
my $host = $ENV{API_DOCKER_TEST_HOST};
if ($host =~ m{^unix://(.+)$}) {
unless (-S $1) {
plan skip_all => "Docker socket $1 not available";
}
}
eval {
require API::Docker;
my $docker = API::Docker->new(host => $host);
my $result = $docker->system->ping;
die "ping failed" unless $result eq 'OK';
};
if ($@) {
plan skip_all => "Docker daemon not reachable at $host: $@";
}
}
sub register_cleanup {
my ($code) = @_;
push @_cleanups, $code;
}
sub _run_cleanups {
for my $cleanup (reverse @_cleanups) {
eval { $cleanup->() };
warn "Cleanup failed: $@" if $@;
}
@_cleanups = ();
}
sub test_docker {
my (%routes) = @_;
if (is_live()) {
require API::Docker;
return API::Docker->new(host => $ENV{API_DOCKER_TEST_HOST});
}
return _mock_docker(%routes);
}
sub _mock_docker {
my (%routes) = @_;
unless (grep { /version/ } keys %routes) {
$routes{'GET /version'} = load_fixture('system_version');
}
require API::Docker;
my $docker = API::Docker->new(
host => 'unix:///var/run/docker.sock',
api_version => '1.47',
);
my $mock_request = sub {
my ($self, $method, $path, %opts) = @_;
my $clean_path = $path;
$clean_path =~ s{^/v[\d.]+}{};
my $key = "$method $clean_path";
if (exists $routes{$key}) {
my $handler = $routes{$key};
if (ref $handler eq 'CODE') {
t/networks.t view on Meta::CPAN
use strict;
use warnings;
use Test::More;
use lib 't/lib';
use Test::API::Docker::Mock;
check_live_access();
# --- Read Tests (always run) ---
subtest 'list networks' => sub {
my $docker = test_docker(
'GET /networks' => load_fixture('networks_list'),
);
my $networks = $docker->networks->list;
is(ref $networks, 'ARRAY', 'returns array');
if (@$networks) {
isa_ok($networks->[0], 'API::Docker::Network');
ok($networks->[0]->Name, 'has Name');
t/networks.t view on Meta::CPAN
my $first = $networks->[0];
is($first->Name, 'bridge', 'network name');
is($first->Driver, 'bridge', 'network driver');
is($first->Scope, 'local', 'network scope');
ok(!$first->Internal, 'not internal');
}
};
# --- Write Tests (mock always, live only with WRITE) ---
subtest 'network lifecycle' => sub {
skip_unless_write();
my $docker = test_docker(
'POST /networks/create' => sub {
my ($method, $path, %opts) = @_;
is($opts{body}{Name}, 'test-net', 'network name in body') unless is_live();
return { Id => 'mock-net-123', Warning => '' };
},
'GET /networks/mock-net-123' => {
Name => 'test-net',
Id => 'mock-net-123',
Driver => 'bridge',
Scope => 'local',
Labels => {},
t/networks.t view on Meta::CPAN
);
my $name = 'api-docker-test-net-' . $$;
my $result = $docker->networks->create(
Name => is_live() ? $name : 'test-net',
Driver => 'bridge',
);
ok($result->{Id}, 'created network has Id');
my $id = is_live() ? $result->{Id} : 'mock-net-123';
register_cleanup(sub { eval { $docker->networks->remove($id) } }) if is_live();
my $network = $docker->networks->inspect($id);
isa_ok($network, 'API::Docker::Network');
ok($network->Name, 'has Name');
unless (is_live()) {
$docker->networks->connect($id, Container => 'abc123');
pass('connect completed');
$docker->networks->disconnect($id, Container => 'abc123');
pass('disconnect completed');
}
$docker->networks->remove($id);
pass('network removed');
};
# --- Validation Tests (always run, no Docker needed) ---
subtest 'network ID required' => sub {
my $docker = test_docker();
eval { $docker->networks->inspect(undef) };
like($@, qr/Network ID required/, 'croak on missing ID for inspect');
eval { $docker->networks->remove(undef) };
like($@, qr/Network ID required/, 'croak on missing ID for remove');
};
subtest 'connect requires container' => sub {
my $docker = test_docker();
eval { $docker->networks->connect('net1') };
like($@, qr/Container required/, 'croak on missing container for connect');
};
done_testing;
t/release-changes_has_content.t view on Meta::CPAN
SKIP: {
ok(-e $changes_file, "$changes_file file exists")
or skip 'Changes is missing', 1;
ok(_get_changes($newver), "$changes_file has content for $newver");
}
done_testing;
sub _get_changes
{
my $newver = shift;
# parse changelog to find commit message
open(my $fh, '<', $changes_file) or die "cannot open $changes_file: $!";
my $changelog = join('', <$fh>);
if ($encoding) {
require Encode;
$changelog = Encode::decode($encoding, $changelog, Encode::FB_CROAK());
}
use strict;
use warnings;
use Test::More;
use lib 't/lib';
use Test::API::Docker::Mock;
check_live_access();
subtest 'system info' => sub {
my $docker = test_docker(
'GET /info' => load_fixture('system_info'),
);
my $info = $docker->system->info;
ok(defined $info->{Containers}, 'has Containers');
ok(defined $info->{Images}, 'has Images');
ok($info->{ServerVersion}, 'has ServerVersion');
ok($info->{OperatingSystem}, 'has OperatingSystem');
is($info->{Images}, 25, 'image count');
is($info->{Driver}, 'overlay2', 'storage driver');
is($info->{Name}, 'test-host', 'hostname');
is($info->{ServerVersion}, '27.4.1', 'server version');
is($info->{OperatingSystem}, 'Debian GNU/Linux 12 (bookworm)', 'os');
is($info->{Architecture}, 'x86_64', 'architecture');
is($info->{NCPU}, 4, 'cpu count');
}
};
subtest 'system version' => sub {
my $docker = test_docker(
'GET /version' => load_fixture('system_version'),
);
my $version = $docker->system->version;
ok($version->{Version}, 'has Version');
ok($version->{ApiVersion}, 'has ApiVersion');
ok($version->{Os}, 'has Os');
ok($version->{Arch}, 'has Arch');
unless (is_live()) {
is($version->{Version}, '27.4.1', 'docker version');
is($version->{ApiVersion}, '1.47', 'api version');
is($version->{MinAPIVersion}, '1.24', 'min api version');
is($version->{Os}, 'linux', 'os');
is($version->{Arch}, 'amd64', 'arch');
}
};
subtest 'ping' => sub {
my $docker = test_docker(
'GET /_ping' => 'OK',
);
my $result = $docker->system->ping;
is($result, 'OK', 'ping returns OK');
};
subtest 'system df' => sub {
my $docker = test_docker(
'GET /system/df' => {
LayersSize => 1000000000,
Images => [
{ Id => 'sha256:abc', Size => 500000000, SharedSize => 200000000 },
],
Containers => [
{ Id => 'abc123', SizeRw => 10000, SizeRootFs => 500000000 },
],
Volumes => [
is(ref $df->{Volumes}, 'ARRAY', 'has Volumes array');
unless (is_live()) {
is($df->{LayersSize}, 1000000000, 'layers size');
is(scalar @{$df->{Images}}, 1, 'one image');
is(scalar @{$df->{Containers}}, 1, 'one container');
is(scalar @{$df->{Volumes}}, 1, 'one volume');
}
};
subtest 'events' => sub {
my $docker = test_docker(
'GET /events' => [
{
Type => 'container',
Action => 'start',
Actor => { ID => 'abc123' },
time => 1705300000,
},
],
);
t/version.t view on Meta::CPAN
use strict;
use warnings;
use Test::More;
use lib 't/lib';
use Test::API::Docker::Mock;
check_live_access();
subtest 'version info' => sub {
my $docker = test_docker(
'GET /version' => load_fixture('system_version'),
);
my $version = $docker->system->version;
ok($version->{ApiVersion}, 'has ApiVersion');
ok($version->{Version}, 'has Version');
ok($version->{Os}, 'has Os');
ok($version->{Arch}, 'has Arch');
t/version.t view on Meta::CPAN
unless (is_live()) {
is($version->{ApiVersion}, '1.47', 'ApiVersion correct');
is($version->{Version}, '27.4.1', 'Version correct');
is($version->{Os}, 'linux', 'Os correct');
is($version->{Arch}, 'amd64', 'Arch correct');
is($version->{GoVersion}, 'go1.22.10', 'GoVersion correct');
is($version->{MinAPIVersion}, '1.24', 'MinAPIVersion correct');
}
};
subtest 'explicit version skips negotiation' => sub {
my $docker = API::Docker->new(api_version => '1.45');
is($docker->api_version, '1.45', 'explicit version preserved');
};
subtest 'auto-negotiate version' => sub {
if (is_live()) {
my $docker = API::Docker->new(host => $ENV{API_DOCKER_TEST_HOST});
$docker->negotiate_version;
ok(defined $docker->api_version, 'api_version negotiated');
like($docker->api_version, qr/^\d+\.\d+$/, 'version looks valid');
} else {
my $docker = test_docker(
'GET /version' => load_fixture('system_version'),
);
is($docker->api_version, '1.47', 'api_version matches fixture');
t/volumes.t view on Meta::CPAN
use strict;
use warnings;
use Test::More;
use lib 't/lib';
use Test::API::Docker::Mock;
check_live_access();
# --- Read Tests (always run) ---
subtest 'list volumes' => sub {
my $docker = test_docker(
'GET /volumes' => load_fixture('volumes_list'),
);
my $volumes = $docker->volumes->list;
is(ref $volumes, 'ARRAY', 'returns array');
if (@$volumes) {
isa_ok($volumes->[0], 'API::Docker::Volume');
ok($volumes->[0]->Name, 'has Name');
t/volumes.t view on Meta::CPAN
is($first->Name, 'my-data', 'volume name');
is($first->Driver, 'local', 'volume driver');
is($first->Scope, 'local', 'volume scope');
is_deeply($first->Labels, { project => 'test' }, 'volume labels');
like($first->Mountpoint, qr{/var/lib/docker/volumes/my-data}, 'mountpoint');
}
};
# --- Write Tests (mock always, live only with WRITE) ---
subtest 'volume lifecycle' => sub {
skip_unless_write();
my $docker = test_docker(
'POST /volumes/create' => sub {
my ($method, $path, %opts) = @_;
is($opts{body}{Name}, 'test-vol', 'volume name in body') unless is_live();
return {
Name => 'test-vol',
Driver => 'local',
Mountpoint => '/var/lib/docker/volumes/test-vol/_data',
CreatedAt => '2025-01-15T12:00:00Z',
Labels => {},
Scope => 'local',
Options => {},
t/volumes.t view on Meta::CPAN
Options => {},
},
'DELETE /volumes/test-vol' => undef,
);
my $name = is_live() ? 'api-docker-test-vol-' . $$ : 'test-vol';
my $volume = $docker->volumes->create(Name => $name);
isa_ok($volume, 'API::Docker::Volume');
ok($volume->Name, 'created volume has Name');
register_cleanup(sub { eval { $docker->volumes->remove($name, force => 1) } }) if is_live();
my $inspected = $docker->volumes->inspect($name);
isa_ok($inspected, 'API::Docker::Volume');
is($inspected->Driver, 'local', 'volume driver is local');
$docker->volumes->remove($name);
pass('volume removed');
};
# --- Validation Tests (always run, no Docker needed) ---
subtest 'volume name required' => sub {
my $docker = test_docker();
eval { $docker->volumes->inspect(undef) };
like($@, qr/Volume name required/, 'croak on missing name for inspect');
eval { $docker->volumes->remove(undef) };
like($@, qr/Volume name required/, 'croak on missing name for remove');
};
done_testing;
( run in 0.721 second using v1.01-cache-2.11-cpan-13bb782fe5a )