view release on metacpan or  search on metacpan

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

	1;
}

my $COMMENT_MATCH = qr/ \A \s* [#] /xms;
my $SECTION_MATCH = qr/ \A \s* \[ ([^\]]+) \] \s* \z /xms;
my $FIELD_MATCH = qr/ \A \s* ([^=\s]+) (?: \s* = \s* ([^\n]*))? /xms;
sub _mkparser
{
	my($path, $hooks) = @_;
	sub {
		local $_ = shift;
		s/^\s+//; s/\s+$//; # trim whitespace
		return unless(length);

		# Call the appropriate hook for each type of token...
		if(/$COMMENT_MATCH/){
			;
		}elsif(/$SECTION_MATCH/){
			$hooks->{'section'}->($1);
		}elsif(/$FIELD_MATCH/){
			my($name, $val) = ($1, $2);
			if(length $val){
				my $apply = $hooks->{'field'}{$name};
				$apply->($val) if($apply);
			}
		}else{
			die "Invalid line in config file, not a comment, section, or field\n";
		}
	};
}

sub _parse
{
	my($path, $hooks) = @_;

	my $parser = _mkparser($path, $hooks);
	my $line;
	open my $if, '<', $path or die "open $path: $!\n";
	eval {
		while(<$if>){
			chomp;
			$line = $_;
			$parser->($_);
		}
	};
	my $err = $@;
	close $if;
	if($err){
		# Print the offending file and line number along with any errors...
		# (This is why we use dies with newlines, for cascading error msgs)
		die "$@$path:$. $line\n"
	}
	return;
}

## Public methods.

sub new
{
	my($class, $path) = @_;
	bless { 'path' => $path }, $class;
}

sub custom_fields
{
	my($self, %cfields) = @_;
	if(grep { ref $_ ne 'CODE' } values %cfields){
		Carp::croak('Hash argument must have coderefs as values' )
	}
	$self->{'cfields'} = \%cfields;
	return;
}

sub _mlisthooks
{
	my($dbsref, $sectref) = @_;

	# Setup hooks for 'Include'ed file parsers...
	return {
		'section' => sub {
			my $file = shift;
			die q{Section declaration is not allowed in Include-ed file\n($file)\n};
		},
		'field' => {
			'Server' => sub { _addmirror($dbsref, shift, $$sectref) }
		},
	 };
}

my %CFGOPTS = (
	'RootDir' => 'root',
	'DBPath' => 'dbpath',
	'CacheDir' => 'cachedirs',
	'GPGDir' => 'gpgdir',
	'LogFile' => 'logfile',
	'UseSyslog' => 'usesyslog',
	'UseDelta' => 'usedelta',
	'CheckSpace' => 'checkspace',
	'IgnorePkg' => 'ignorepkgs',
	'IgnoreGroup' => 'ignoregrps',
	'NoUpgrade' => 'noupgrades',
	'NoExtract' => 'noextracts',
	'NoPassiveFtp' => 'nopassiveftp',
	'Architecture' => 'arch',
);

sub _confhooks
{
	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;
}