view release on metacpan or  search on metacpan

lib/App/LXC/Container/Setup.pm  view on Meta::CPAN

    my $prefix = _ROOT_DIR_ . '/conf';
    -d $prefix  or  fatal('internal_error__1',
			  'directory missing in _save_configuration');
    $prefix .= '/' .
	substr($self->{name}, 0, 1) . substr($self->{name}, -1, 1) . '-';
    _write_to($prefix . 'CNF-' . $self->{name} . '.master',
	      '# master configuration for container ' . $self->{name},
	      '',
	      'network=' . $self->{network},
	      'x11=' . $self->{x11},
	      'audio=' . $self->{audio},
	      'users=' . join(',', sort @{$self->{users}}));
    _write_to($prefix . 'PKG-' . $self->{name} . '.packages',
	      '# package list for container ' . $self->{name},
	      '# See 30-PKG-default.packages for more explanations.',
	      '',
	      @{$self->{packages}});
    _write_to($prefix . 'MNT-' . $self->{name} . '.mounts',
	      '# mounts for container ' . $self->{name},
	      '# See 40-MNT-default.mounts for more explanations.',
	      '',
	      map { _mark2mount($_) } @{$self->{mounts}});
    _write_to($prefix . 'NOT-' . $self->{name} . '.filter',
	      '# filter for container ' . $self->{name},
	      '# See 50-NOT-default.filter for more explanations.',
	      '',
	      map { _mark2filter($_) } @{$self->{filter}});
}

#########################################################################

=head2 _write_to - write array to file

    _write_to($path, @lines);

=head3 parameters:

    $path               absolute path to file
    @lines              array of output lines

=head3 description:

This function opens the file at the give path and writes the array of output
lines into it.  If the file already exists and is not writable, the function
returns without changing anything.  If anything else goes wrong, the
function aborts the whole script.

=cut

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _write_to($@)
{
    my $path = shift;
    if (-e $path  and  not -w $path)
    {
	warning 'using_existing_protected__1', $path;
	return;
    }
    open my $file, '>', $path  or  fatal 'can_t_open__1__2', $path, $!;
    local $_;
    say $file tabify($_) foreach @_;
    close $file;
}

#########################################################################

1;

#########################################################################
#########################################################################

=head1 SEE ALSO

man pages C<lxc.container.conf>, C<lxc> and C<lxcfs>

LXC documentation on L<https://linuxcontainers.org>

=head1 LICENSE

Copyright (C) Thomas Dorner.

This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.  See LICENSE file for more details.

=head1 AUTHOR

Thomas Dorner E<lt>dorner (at) cpan (dot) orgE<gt>

=head2 Contributors

none so far

=cut