PBib::Config - Configuration for PBib

 use PBib::Config;
 $conf = new PBib::Config();

# --*-Perl-*--
# $Id: Config.pm 18 2004-12-12 07:41:44Z tandler $
#

package PBib::Config;
use 5.006;
use strict;
use warnings;
#use English;

# for debug:
use Data::Dumper;

BEGIN {
	use vars qw($Revision $VERSION);
	my $major = 1; q$Revision: 18 $ =~ /: (\d+)/; my ($minor) = ($1); $VERSION = "$major." . ($minor<10 ? '0' : '') . $minor;
}

# superclass
#use YYYY;
#our @ISA;
#@ISA = qw(YYYY);

# used standard modules
#use FileHandle;
use Getopt::Long;
use Text::ParseWords;
use File::Basename;
use File::Spec;
use Carp;

use FindBin qw($Bin);
# use lib "$Bin/../lib";
 
# used own modules
use PBib::ConfigFile;

# module variables
#our($mmm);

#
#
# constructor
#
#

my %attributes = qw(
	argv 1 env 1 site 1 user 1 default 1 options 1
	);

sub new {
	my $self = shift;
	my $aConfig = {
		argv => 1,
		env => 1,
		site => 1,
		user => 1,
		default => 1,
		options => {},
		};
	my $class = ref($self) || $self;
	$aConfig = bless $aConfig, $class;
	
	# special hack for test scripts to ensure defined configuration
	my %argv = @_;
	my $mode = $ENV{PBIB_CONFIG};
	if( defined $mode ) {
		foreach my $arg (split(/,/, $mode)) {
			my ($attr, $val) = split(/=/, $arg);
			$argv{$attr} = $val;
			#  print STDERR "$attr=$val\n";
		}
	}
	
	# process arguments
	foreach my $attr (keys %argv) {
		if( $attributes{$attr} ) {
			#  print STDERR "set attribute $attr=$argv{$attr}\n";
			$aConfig->{$attr} = $argv{$attr};
		} else {
			#  print STDERR "set option $attr=$argv{$attr}\n";
			$aConfig->option($attr, $argv{$attr});
		}
	}
	#  print Dumper $aConfig;
	
	# load default, user, site, env, argv
	$aConfig->load();
	return $aConfig;
}

#
#
# destructor
#
#

#sub DESTROY ($) {
#  my $self = shift;
#}



#
#
# access methods
#
#

#  sub a { return shift->{'a'}; }
#  sub b { my $self = shift; return $self->{'b'}; }

sub options {
	my ($self) = shift;
	my %args = @_;
	my $options = $self->{'options'} || {};
	my $file = $args{'file'};
	my $dir = $args{'dir'};
	
	# load additional directory's configuration
	if( $dir ) {
		$options = merge_options($options,
			$self->load_configfile("$dir/local.pbib", [$dir]));
	}
	
	# load file configuration
	if( $file ) {
		# check if there's a config file in file's dir
		my $fdir = dirname($file);
		$options = merge_options($options,
			$self->load_configfile("$fdir/local.pbib", [$dir, $fdir]));
		
		$options = merge_options($options,
			$self->load_configfile("$file.pbib", [$dir, $fdir]));
		$file =~ s/\.(\w+)$/\.pbib/;
		$options = merge_options($options,
			$self->load_configfile($file, [$dir, $fdir]));
	}
	
	return $options;
}

sub option {
	my ($self, $name, $new_val) = @_;
	my @path = split(/\./, $name);
	my $options = $self->options();
	my ($opt, $val, $last_opt);
	if( ! @path ) {
		croak("ERROR: No path given in access to $name");
		#  return undef;
	}
	while( $opt = shift @path ) {
		$last_opt = $opt;
		if( defined $options->{$opt} ) {
			$val = $options->{$opt};
			if( @path ) {
				$options = $val;
				if( ref $options ne 'HASH' ) {
					croak("ERROR: Path too short in access to $name at $opt");
					#  return undef;
				}
			}
		} else {
			#  print STDERR "WARNING: Option $opt not found in access to $name\n"; ## if it's undef that's alright!
			$val = undef;
			if( @path ) {
				# create new hash for sub-options ...
				#  print STDERR "Add $opt to option path for $name\n";
				$options = $val = $options->{$opt} = {};
			}
		}
	}
	if( defined $new_val ) {
		#  print "Set option $name(*.$last_opt) to $new_val\n";
		$options->{$last_opt} = $new_val;
	}
	return $val;
}

sub setOptions {
	my ($self, $options) = @_;
	$self->{options} = $options;
	return $options;
}

sub beVerbose {
	my ($self) = @_;
	return $self->option('verbose');
}

sub beQuiet {
	my ($self) = @_;
	return $self->option('quiet');
}


#
#
# methods
#
#

sub load {
	my ($self) = @_;
	my $options = $self->{options};
	
	# load defaults
	if( $self->{default} ) {
		# note: the default options have lower prio than args to 
		# the constructor
		$options = merge_options(
			$self->load_file("default.pbib"),
			$options);
	}
	
	# load site configuration
	if( $self->{site} ) {
		$options = merge_options($options,
			$self->load_file("local.pbib"));
	}
	
	# load user configuration
	if( $self->{user} ) {
		$options = merge_options($options,
			$self->load_file("user.pbib"));
	}
	
	# check environment
	if( $self->{env} ) {
		$options = merge_options($options,
			$self->load_env());
	}
	
	# parse ARGV
	if( $self->{argv} ) {
		$options = merge_options($options,
			$self->load_argv());
	}
	
	$self->{options} = $options;
	return $options;
}

sub load_argv {
	my ($self) = @_;
	return {};
}

sub load_env {
	my ($self) = @_;
	# check environment
	#  if( defined $ENV{$pbib_env} ) {
		#  unshift(@ARGV, Text::ParseWords::shellwords($ENV{$pbib_env}));
	#  }
	return {};
}

our $PBIB_BIN = $ENV{'PBIBDIR'} || $Bin;
our @PBIB_PATH = split( /;/, $ENV{'PBIBPATH'} || 
		'/etc/pbib/styles;/etc/pbib/conf;/etc/pbib;/etc' );
our @CONFIG_PATH = grep { defined($_) } (
	'.',
	$ENV{HOME} ? (		# for personal settings
		"$ENV{HOME}/.pbib/styles",
		"$ENV{HOME}/.pbib/conf",
		"$ENV{HOME}/.pbib",
		$ENV{HOME},
		) : (),
	split( /;/, $ENV{'PBIBSTYLES'} || ''),
	split( /;/, $ENV{'PBIBCONFIG'} || ''),
	@PBIB_PATH,
	$ENV{APPDATA} ? (		# for Windows XP
		"$ENV{APPDATA}/PBib/styles",
		"$ENV{APPDATA}/PBib/conf",
		"$ENV{APPDATA}/PBib",
		) : (),
	"$PBIB_BIN/../styles",	# when run from bin dir (e.g. uninstalled version)
	"$PBIB_BIN/../conf",
	$PBIB_BIN,
	map("$_/PBib/styles", @INC),
	map("$_/PBib/conf", @INC),
	);

sub load_file {
	my ($self, $filename, $path) = @_;
	return unless $filename;
	my $options = {};
	my @config_path = ( ($path ? @$path : ()), @CONFIG_PATH );
	@config_path = grep { defined($_) } @config_path; # remove undef from list
	print STDERR "looking for $filename in path: @config_path\n" if $self->beVerbose();
	foreach my $dir (@config_path) {
#  print STDERR "$dir -->\n";
		my $file = File::Spec->catfile($dir,$filename);
#  print STDERR "$file ...?\n";
		if( -r $file ) {
			$options = merge_options($options,
				$self->load_configfile($file, \@config_path));
		}
	}
	return $options;
}

sub load_configfile {
# the filename should be absolute, don't search for it.
	my ($self, $filename, $path) = @_;

	unless( -r $filename ) {
		print STDERR "no config file $filename\n" if $self->beVerbose();
		return;
	}
	print STDERR "read config from $filename\n" if $self->beVerbose();
	
	my @config_path = @CONFIG_PATH;
#  print STDERR Dumper $path;
	@config_path = (@$path, @config_path) if $path;
	@config_path = grep { defined($_) } @config_path;
#  print STDERR Dumper \@config_path;
	
	my $c = new PBib::ConfigFile(
		-UseApacheInclude => 1,
		-IncludeRelative => 1,
		-AutoTrue => 1,
		-ConfigFile => $filename,
		-ConfigPath => \@config_path,
			# caution: pass a copy to path to PBib::ConfigFile, it can be modified!
		);
	my %options = $c->getall();
	$options{loaded_config_files} = [] unless $options{loaded_config_files};
	push @{$options{loaded_config_files}}, $filename;

	# if includes are used, the options have to be merged. hm.
	return compress_options(\%options);
}

sub merge {
	my ($self, $options) = @_;
	return $self->{'options'} = merge_options($self->{'options'}, $options);
}


#
#
# class methods
#
#

sub merge_options {
	my $result = {};
	my ($k, $v, $rv);
	
	foreach my $conf (@_) {
		#print Dumper $conf;
		next unless ref $conf eq 'HASH';
		while( ($k, $v) = each %$conf) {
#			print "$k\n";
			$rv = $result->{$k};
			if( defined $rv ) {
				if( ref $v eq 'HASH' &&
				    ref $rv eq 'HASH' ) {
					$v = merge_options($rv, $v);
				}
			}
			$result->{$k} = $v;
		}
	}
	return $result;
}


# internal method that is used if includes are used in
# config files
# merge all sub-configs, if an options points to a ref containing hashs only.

sub compress_options {
	my ($conf) = @_;
	foreach my $opt (keys %$conf) {
		my $val = $conf->{$opt};
		if( ref($val) eq 'ARRAY' &&
				@$val &&
				ref($val->[0]) eq 'HASH' ) {
			$conf->{$opt} = merge_options(@$val);
		}
		if( ref($val) eq 'HASH' ) {
			$conf->{$opt} = compress_options($val);
		}
	}
	return $conf;
}

1;