view release on metacpan or  search on metacpan

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

=head3 description:

This function translates an entry of the filter listbox in the UI into the
output for the corresponding meta-configuration file.

=head3 returns:

configuration line for passed string

=cut

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _mark2filter($)
{
    my ($conf_str) = @_;
    my $mark = substr($conf_str, 0, 2);
    my $file = substr($conf_str, 3);
    my %translate =
	(CP => 'copy', EM => 'empty', IG => 'ignore', NM => 'nomerge');
    local $_ = $file;
    if (defined $translate{$mark})
    {	$_ = sprintf("%-39s %s", $_, $translate{$mark});   }
    else
    {	fatal 'internal_error__1', "bad mark '$mark' in _mark2filter";   }
    return $_;
}

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

=head2 B<_mark2mount> - translate UI file string into configuration line

    $output = _mark2mount($conf_str);

=head3 parameters:

    $conf_str           files configuration string from UI

=head3 description:

This function translates an entry of the files listbox in the UI into the
output for the corresponding meta-configuration file.

=head3 returns:

configuration line for passed string

=cut

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _mark2mount($)
{
    my ($conf_str) = @_;
    my $mark = substr($conf_str, 0, 2);
    my $file = substr($conf_str, 3);
    local $_ = $file;
    if ($mark eq '  ')
    {}
    elsif ($mark eq 'RW')
    {
	$_ = sprintf("%-39s create=%s,rw,bind%s",
		     $_,
		     (-d $_ ? 'dir' : 'file'),
		     # relaxed bind-mounting for /dev and /var items:
		     (m!^/(?:dev|var)/!) ? ',optional' : '');
    }
    elsif ($mark eq 'OV')
    {
	$_ = sprintf("%-39s create=%s,rw\t\t%s",
		     $_, (-d $_ ? 'dir' : 'file'), 'tmpfs');
    }
    else
    {	fatal 'internal_error__1', "bad mark '$mark' in _mark2mount";   }
    return $_;
}

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

=head2 _modify_entry - modify an entry of a listbox

    $self->_modify_entry($title, $listbox, @alternatives);

=head3 example:

    $self->_modify_entry($title, $listbox,
                         '   ' => txt('__'),
                         'OV ' => txt('OV'),
                         'RW ' => txt('RW'));

=head3 parameters:

    $title              string with title of the file-selection dialog
    $listbox            reference to UI element of the listbox
    @alternatives       list of alternatives for the radio buttons

=head3 description:

This method opens a dialog with some radio buttons to modify the mode of the
selected file or directory in the given listbox.

=cut

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _modify_entry($$$@)
{
    my $self = shift;
    my $title = shift;
    my $ui_listbox = shift;
    debug(3, __PACKAGE__, '::($self, "', $title, '", $ui_listbox, "',
	  join('", "', @_), '")');
    4 <= @_  and  0 == @_ % 2  or
	fatal 'internal_error__1', 'uneven list in _modify_entry';

    my $entry = $ui_listbox->selected();
    defined $entry  or  return;
    my $text = $ui_listbox->texts->[$entry];
    my $radio = substr($text, 0, 3);
    my @radio = ();
    while (@_)
    {
	my $key = shift;
	my $description = shift;
	push @radio, $key, $key . $description;
    }

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

    debug(2, __PACKAGE__, '::_parse_master($self)');
    my $path = _ROOT_DIR_ . '/conf/'
	. substr($self->{name}, 0, 1) . substr($self->{name}, -1, 1)
	. '-CNF-' . $self->{name} . '.master';
    -f $path  or  return;

    open my $file, '<', $path  or  fatal 'can_t_open__1__2', $path, $!;
    local $_;
    while (<$file>)
    {
	next if m/^\s*(?:#|$)/;
	if (m/^\s*network\s*=\s*([0-2])\s*(?:#|$)/)
	{   $self->{network} = $1;   }
	elsif (m/^\s*x11\s*=\s*([0-1])\s*(?:#|$)/)
	{   $self->{x11} = $1;   }
	elsif (m/^\s*audio\s*=\s*([0-1])\s*(?:#|$)/)
	{   $self->{audio} = $1;   }
	elsif (m/^\s*users\s*=\s*(?:([-a-z_A-Z.0-9:, ]+)\s*)?(?:#|$)/)
	{   $self->{users} = [ $1 ? split(' *, *', $1) : () ];   }
	else
	{   error 'ignoring_unknown_item_in__1__2', $path, $.;   }
    }
    close $file;
}

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

=head2 B<_parse_mounts> - parse existing mounts configuration file

    $self->_parse_mounts();

=head3 description:

This method checks if the current container already has a mounts
meta-configuration file and parses its content into the object representing
the container.

=cut

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _parse_mounts($)
{
    my $self = shift;
    debug(2, __PACKAGE__, '::_parse_mounts($self)');
    my $path = _ROOT_DIR_ . '/conf/'
	. substr($self->{name}, 0, 1) . substr($self->{name}, -1, 1)
	. '-MNT-' . $self->{name} . '.mounts';
    -f $path  or  return;

    open my $file, '<', $path  or  fatal 'can_t_open__1__2', $path, $!;
    $self->{mounts} = [];
    local $_;
    while (<$file>)
    {
	next if m/^\s*(?:#|$)/;
	s/\s*#.*$//;
	if (m|^\s*(\S+)(\s+\S.*)?$|)
	{
	    my ($path, $special) = ($1, $2);
	    $_ = (! defined $special ? '  '
		  : $special =~ m/rw,bind/ ? 'RW' : 'OV') . ' ' . $path;
	    push @{$self->{mounts}}, $_;
	}
	else
	{   error 'ignoring_unknown_item_in__1__2', $path, $.;   }
    }
    close $file;
}

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

=head2 B<_parse_packages> - parse existing packages configuration file

    $self->_parse_packages();

=head3 description:

This method checks if the current container already has a packages
meta-configuration file and parses its content into the object representing
the container.

=cut

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _parse_packages($)
{
    my $self = shift;
    debug(2, __PACKAGE__, '::_parse_packages($self)');
    my $path = _ROOT_DIR_ . '/conf/'
	. substr($self->{name}, 0, 1) . substr($self->{name}, -1, 1)
	. '-PKG-' . $self->{name} . '.packages';
    -f $path  or  return;

    open my $file, '<', $path  or  fatal 'can_t_open__1__2', $path, $!;
    $self->{packages} = [];
    local $_;
    while (<$file>)
    {
	next if m/^\s*(?:#|$)/;
	if (m/^\s*(\S+)\s*(?:#|$)/)
	{   push @{$self->{packages}}, $1;   }
	else
	{   error 'ignoring_unknown_item_in__1__2', $path, $.;   }
    }
    close $file;
}

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

=head2 B<_save_configuration> - save currnent meta-configuration

    $self->_save_configuration();

=head3 description:

This method saves the current meta-configuration.

=cut

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _save_configuration($)