view release on metacpan or  search on metacpan

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

	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
{
	my($opts, $dbs) = @_;
	my($root, $dbpath) = delete @{$opts}{'root', 'dbpath'};

	unless($root){
		$root = '/';
		unless($dbpath){
			$dbpath = "$root/var/lib/pacman";
			$dbpath =~ tr{/}{/}s;
		}
	}

	my $alpm = ALPM->new($root, $dbpath);

	_setarch($opts);
	while(my ($opt, $val) = each %$opts){
		# The SetOption type in typemap croaks on error, no need to check.
		_setopt($alpm, $opt, $val);
	}

	my $usesl = grep { /signatures/ } $alpm->caps;
	for my $db (@$dbs){
		my($r, $sl, $mirs) = @{$db}{'name', 'siglvl', 'mirrors'};
		next if(!@$mirs);

		_expurls($mirs, $opts->{'arch'}, $r);
		$sl = 'default' if(!$usesl);
		my $x = $alpm->register($r, $sl)
			or die "Failed to register $r database: " . $alpm->strerror;
		$x->add_server($_) for(@$mirs);
	}
	return $alpm;
}

sub parse
{
	my($self) = @_;

	my (%opts, @dbs, $currsect, $defsiglvl);
	my %fldhooks = (
		_confhooks(\%opts, \$currsect),
		_nullhooks(@NULL_OPTS),
		'Server'  => sub { _addmirror(\@dbs, shift, $currsect) },
		'Include' => sub {
			die "Cannot have an Include directive in the [options] section\n"
				if($currsect eq 'options');

			# An include directive spawns its own little parser...
			_parse(shift, _mlisthooks(\@dbs, \$currsect));
		},
		'SigLevel' => sub {
			if($currsect eq 'options'){
				$defsiglvl = _parse_siglvl(shift);
			}else{
				_setsiglvl(\@dbs, $currsect, _parse_siglvl(shift));
			}
		},
		($self->{'cfields'} ? %{$self->{'cfields'}} : ()),
	);

	my %hooks = (
		'field' => \%fldhooks,
		'section' => sub { $currsect = shift; }
	);

	_parse($self->{'path'}, \%hooks);
	return _applyopts(\%opts, \@dbs);
}

## Import magic used for quick scripting.
# e.g: perl -MALPM::Conf=/etc/pacman.conf -le 'print $alpm->root'

sub import
{
	my($pkg, $path) = @_;
	my($dest) = caller;
	return unless($path);

	my $conf = $pkg->new($path);
	my $alpm = $conf->parse;
	no strict 'refs';
	*{"${dest}::alpm"} = \$alpm;
	return;
}

1;