view release on metacpan or  search on metacpan

lib/ALPM/Conf.pm  view on Meta::CPAN

{
	my($optsref, $sectref) = @_;
	my %hooks;
	while(my($fld, $opt) = each %CFGOPTS){
		$hooks{$fld} = sub { 
			my $val = shift;
			die qq{$fld can only be set in the [options] section\n}
				unless($$sectref eq 'options');
			$optsref->{$opt} = $val;
		};
	 }
	return %hooks;
}

sub _nullhooks
{
	map { ($_ => \&_null) } @_
}

sub _getdb
{
	my($dbs, $name) = @_;

	# The order databases are added must be preserved as must the order of URLs.
	for my $db (@$dbs){
		return $db if($db->{'name'} eq $name);
	}
	my $new = { 'name' => $name };
	push @$dbs, $new;
	return $new;
}

sub _setsiglvl
{
	my($dbs, $sect, $siglvl) = @_;
	my $db = _getdb($dbs, $sect);
	$db->{'siglvl'} = $siglvl;
	return;
}

sub _parse_siglvl
{
	my($str) = @_;
	my $siglvl;

	my $opt;
	for(split /\s+/, $str){
		my @types = qw/pkg db/;

		if(s/^Package//){
			@types = qw/pkg/;
		}elsif(s/^Database//){
			@types = qw/db/;
		}

		if(/^Never$/){
			$opt->{$_} = 'never' for(@types);
		}elsif(/^Optional$/){
			$opt->{$_} = 'optional' for(@types);
		}elsif(/^Required$/){
			$opt->{$_} = 'required' for(@types);
		}elsif(/^TrustedOnly$/){
			;
		}elsif(/^TrustAll$/){
			for my $t (@types){
				$opt->{$t} = 'optional' unless(defined $opt->{$t});
				$opt->{$t} .= ' trustall';
			}
		}else{
			die "Unknown SigLevel option: $_\n";
		}
	}

	# Check for a blank SigLevel
	unless(defined $opt){
		die "SigLevel was empty\n";
	}
	return $opt;
}

sub _addmirror
{
	my($dbs, $url, $sect) = @_;
	die "Section has not previously been declared, cannot set URL\n" unless($sect);

	my $db = _getdb($dbs, $sect);
	push @{$db->{'mirrors'}}, $url;
	return;
}


sub _setopt
{
	my($alpm, $opt, $valstr) = @_;
	no strict 'refs';
	my $meth = *{"ALPM::set_$opt"}{'CODE'};
	die "The ALPM::set_$opt method is missing" unless($meth);

	my @val = ($opt =~ /s$/ ? map { split } $valstr : $valstr);
	return $meth->($alpm, @val);
}

sub _setarch
{
	my($opts) = @_;
	if(!$opts->{'arch'} || $opts->{'arch'} eq 'auto'){
		chomp ($opts->{'arch'} = `uname -m`);
	}
}

sub _expurls
{
	my($urls, $arch, $repo) = @_;
	for(@$urls){
		s/\$arch/$arch/g;
		s/\$repo/$repo/g;
	}
}

sub _applyopts
{