view release on metacpan or  search on metacpan

lib/Container/Buildah/Stage.pm  view on Meta::CPAN

# generate read accessor methods
# note: these parameters are set only in new() - there are no write accessors so none are generated
# private class function
sub generate_read_accessors
{
	# check if accessors have been created
	if ($accessors_created) {
		# skip if already done
		return;
	}

	# create accessor methods
	foreach my $field_name (@auto_accessors) {
		# for read accessor name, prepend get_ to field name
		my $method_name = "get_".$field_name;
		
		# generate accessor method to handle this field
		my $method_sub = sub {
			my $self = shift;
			$self->isa(__PACKAGE__)
				or confess "$method_name method (from generate_read_accessors) expects ".__PACKAGE__." object, got "
					.((defined $self)?((ref $self)?ref $self:"scalar"):"(undef)");
			my $value = $self->stage_config($field_name);
			$self->debug({level => 3, name => __PACKAGE__."::".$method_name},
				(defined $value)?"value=$value":"(undef)");
			return $value;
		};

		# install and call the newly-generated method
		no strict 'refs'; ## no critic (ProhibitNoStrict)
		*{ $method_name } = $method_sub; # install generated method in class symbol table
	}
	$accessors_created = 1; # do this only once
	return;
}

# get container name
# generate it the first time
# public instance method
sub container_name
{
	my $self = shift;

	# derive container name
	if (not exists $self->{container_name}) {
		$self->{container_name} = Container::Buildah->get_config("basename")."_".$self->get_name;
	}
	return $self->{container_name};
}

#
# buildah subcommand front-end functions
# Within Container::Buildah::Stage the object has methods for subcommands which take a container name.
# Each method gets container_name from the object. So it is not passed as a separate parameter.
#
# Other more general subcommands are in Container::Buildah class.
#

# front-end to "buildah add" subcommand
# usage: $self->add( [{[dest => value]. [chown => mode]},] src, [src, ...] )
# public instance method
sub add
{
	my ($self, @in_args) = @_;
	$self->debug({level => 2}, @in_args);
	my $params = {};
	if (ref $in_args[0] eq "HASH") {
		$params = shift @in_args;
	}

	# process parameters
	my ($extract, @args) = process_params({name => 'add',
		extract => [qw(dest)],
		arg_flag => [qw(add-history quiet)],
		arg_str => [qw(chown)]
	}, $params);

	# insert --add-history if corresponding global option set
	# (buildah also does this by $ENV{BUILDAH_HISTORY}='true')
	if (Container::Buildah->get_config(qw(opts add-history)) // 0) {
		unshift @args, "--add-history";
	}

	# get special parameter dest if it exists
	my $dest = $extract->{dest};

	# run command
	my $cb = Container::Buildah->instance();
	$cb->buildah("add", @args, $self->container_name, @in_args, ($dest ? ($dest) : ()));
	return;
}

# front-end to "buildah commit" subcommand
# usage: $self->commit( [{param => value, ...}], image-name )
# public instance method
sub commit
{
	my ($self, @in_args) = @_;
	$self->debug({level => 2}, @in_args);
	my $params = {};
	if (ref $in_args[0] eq "HASH") {
		$params = shift @in_args;
	}
	my $image_name = shift @in_args;

	# process parameters
	my ($extract, @args) = process_params({name => 'commit',
		arg_flag => [qw(disable-compression omit-timestamp quiet rm squash tls-verify)],
		arg_int => [qw(timestamp)],
		arg_str => [qw(authfile blob-cache cert-dir creds encryption-key format iidfile
			reference-time sign-by signature-policy tls-verify omit-timestamp)],
		arg_array => [qw(encrypt-layer)],
	}, $params);

	# do commit
	my $cb = Container::Buildah->instance();
	$cb->buildah("commit", @args, $self->container_name, ($image_name // ()));
	return;
}


# front-end to "buildah config" subcommand
# usage: $self->config({ param => value, ...})
# Note: this is for the container's configuration, not to be confused with configuration data of this module
# public instance method
sub config
{
	my ($self, @in_args) = @_;
	$self->debug({level => 2}, @in_args);
	my $params = {};
	if (ref $in_args[0] eq "HASH") {
		$params = shift @in_args;
	}

	# process parameters
	my ($extract, @args) = process_params({name => 'config',
		arg_flag => [qw(add-history)],
		arg_str => [qw(arch author cmd comment created-by domainname healthcheck healthcheck-interval
			healthcheck-retries healthcheck-start-period healthcheck-timeout history-comment hostname
			os shell stop-signal user workingdir)],
		arg_array => [qw(annotation env label onbuild port volume)],
		arg_list => [qw(entrypoint)],
	}, $params);

	# insert --add-history if corresponding global option set
	# (buildah also does this by $ENV{BUILDAH_HISTORY}='true')
	if (Container::Buildah->get_config(qw(opts add-history)) // 0) {
		unshift @args, "--add-history";
	}

	# run command
	my $cb = Container::Buildah->instance();
	$cb->buildah("config", @args, $self->container_name);
	return;
}

# front-end to "buildah copy" subcommand
# usage: $self->copy( [{dest => value},] src, [src, ...] )
# public instance method
sub copy
{
	my ($self, @in_args) = @_;
	$self->debug({level => 2}, @in_args);
	my $params = {};
	if (ref $in_args[0] eq "HASH") {
		$params = shift @in_args;
	}

	# process parameters
	my ($extract, @args) = process_params({name => 'copy',
		extract => [qw(dest)],
		arg_flag => [qw(add-history quiet)],
		arg_str => [qw(chown)]
	}, $params);

	# insert --add-history if corresponding global option set
	# (buildah also does this by $ENV{BUILDAH_HISTORY}='true')
	if (Container::Buildah->get_config(qw(opts add-history)) // 0) {
		unshift @args, "--add-history";
	}

	# get special parameter dest if it exists
	my $dest = $extract->{dest};

	# run command
	my $cb = Container::Buildah->instance();
	$cb->buildah("copy", @args, $self->container_name, @in_args, ($dest ? ($dest) : ()));
	return;
}

# front-end to "buildah run" subcommand
# usage: $self->run( [{param => value, ...}], [command], ... )
# Command parameter can be an array of strings for one command, or array of arrays of strings for multiple commands.
# This applies the same command-line arguments (from %params) to each command. To change parameters for a command,
# make a separate call to the function.
# public instance method
sub run
{
	my ($self, @in_args) = @_;
	$self->debug({level => 2}, @in_args);
	my $params = {};
	if (ref $in_args[0] eq "HASH") {
		$params = shift @in_args;
	}

	# process parameters
	my ($extract, @args) = process_params({name => 'run',
		arg_flag => [qw(add-history no-pivot terminal)],
		arg_str => [qw(cni-config-dir cni-plugin-path hostname ipc isolation network pid runtime
			user uts)],
		arg_array => [qw(cap-add cap-drop mount runtime-flag security-opt volume)],
	}, $params);

	# insert --add-history if corresponding global option set
	# (buildah also does this by $ENV{BUILDAH_HISTORY}='true')
	if (Container::Buildah->get_config(qw(opts add-history)) // 0) {
		unshift @args, "--add-history";
	}

	# loop through provided commands
	# build outer array if only one command was provided
	my @commands = ref $in_args[0] ? @in_args : [@in_args];
	foreach my $command (@commands) {
		# if any entries are not arrays, temporarily make them into one
		if (not ref $command) {
			$command = [$command];
		} elsif (ref $command ne "ARRAY") {
			confess "run: command must be a scalar or array, got ".ref $command;
		}

		# run command
		my $cb = Container::Buildah->instance();
		$cb->buildah("run", @args, $self->container_name, '--', @$command);