package Config; use strict; use warnings FATAL => 'all'; use File::Glob qw(:glob); use YAML::Syck(); BEGIN { $YAML::Syck::ImplicitUnicode=1; } use Data::Dumper; =head1 Config; The first time you use() this module, must be used as: use Config '/path/to/config/directory'; In all other packages where you want the config available, just use as: use Config; Always imports the function C() into your package, to allow you to access your configuration. =cut our $Config_Dir = ''; our $Config; =head2 C() Returns a value for the key indicated, or throws an error if it is not defined. print C('namespace[.key1[.keyn]]'[,$config_variable); The second parameter, if passed, is the config variable to search. If not passed, then the Config hash built from the config files will be searched. =cut #========================================== sub C { #========================================== my $path = shift||''; my ($config,$namespace,@keys); if (@_) { $config = $_[0]; $namespace = "PRIVATE"; @keys = split(/\./,$path); } else { ($namespace,@keys) = split(/\./,$path); $namespace||=''; die ("Namespace '$namespace' not defined") unless $namespace && exists $Config->{$namespace}; $config = $Config->{$namespace}; } my $key_path = $namespace; foreach my $key (@keys) { next unless defined $key && length($key); if (ref $config eq 'ARRAY' && $key=~/^[0-9]+/ && exists $config->[$key]) { $config = $config->[$key]; $key_path.='::'.$key; next; } elsif (ref $config && exists $config->{$key}) { $config = $config->{$key}; $key_path.='::'.$key; next; } die ("Invalid key '$key' specified for $key_path : \n" .Dumper($config)); } return wantarray ? ref $config eq 'ARRAY' ? (@$config) : ref $config eq 'HASH' ? (%$config) : $config : ($config); } =head2 copy_C() Works just like C() but returns a ref to a private copy of the data rather than a reference. This means the data can be changed without changing the version stored in Config. This is not exported. =cut #========================================== sub copy_C { #========================================== my $data = C(@_); my $VAR1; return eval(Dumper($data)); } =head2 load_config() Store loaded config in %Config =cut #========================================== sub load_config { #========================================== $Config = _load_config(); } =head2 _load_config() Looks at all files called *.conf in the config directory and its subdirectories and tries to parse them. The configuration in each file gets loaded into its own name space. A direcory name is also considered a name space. Directories are loaded before config files of the same name, so for instance, you can have: confdir: syndication/ --data_types/ --traffic.conf --headlines.conf --data_types.conf syndication.conf The config items in syndication.conf will be added to (or overwrite) the items loaded into the syndication namespace via the subdirectory called syndication. In any sub-directory, you can have a file called local.conf which is used for storing information local to this installation only. This data will be merged with the existing data, but the namespace must be specified in the local file. For instance, if we have: confdir: db.conf local.conf and db.conf has : connections: default_settings: host: localhost table: abc password: 123 And in local.conf: db: connections: default_settings: password: 456 the resulting configuration will look like this: db: connections: default_settings: host: localhost table: abc password: 456 =cut #========================================== sub _load_config { #========================================== my $dir = shift || $Config_Dir; my $config = {}; my @config_files = sort{$a cmp $b} grep {!/\/local.conf$/} glob($dir."*"); foreach my $config_file (@config_files) { my ($data,$name); if (-f $config_file && $config_file=~/\.conf$/) { $data = _load_config_file ($config_file); ($name) = ($config_file=~m|.*/(.*)\.conf$|); } elsif (-d $config_file) { $data = _load_config ($config_file.'/'); ($name) = ($config_file=~m|.*/(.*)$|); } else { next; } if (exists $config->{$name}) { map {$config->{$name}->{$_} = $data->{$_}} keys %$data; } else { $config->{$name} = $data; } } if (-e $dir.'local.conf') { my $data = _load_config_file ($dir.'local.conf'); $config = _merge_local($config,$data); } return $config; } =head2 _merge_local() Used to merge local.conf files into the configuration. =cut #========================================== sub _merge_local { #========================================== my $config = shift; my $local = shift; foreach my $key (keys %$local) { if (ref $local->{$key} eq 'HASH' && exists $config->{$key}) { $config->{$key} = _merge_local ($config->{$key},$local->{$key}); } else { $config->{$key} = $local->{$key} } } return $config; } =head2 _load_config_file() Parses the YAML file and throws an error if it is not correctly formatted =cut #========================================== sub _load_config_file { #========================================== my $config_file = shift; my $data; eval { $data = YAML::Syck::LoadFile($config_file); }; if ($@) { die ("Error loading config file $config_file:\n\n" .$@); }; return $data; } =head2 import() Used to set config directory the first time this module is loaded. The config directory cannot be changed by subsequent uses; Also exports the function C() into the namespace in which it is being used. =cut #========================================== sub import { #========================================== shift; my $callpkg = caller(0); no strict 'refs'; *{$callpkg."::C"} = \&C; use strict; # If we have already loaded this module correctly, do nothing return 1 if $Config_Dir; my $dir = shift; if ($dir && -d $dir && -r _) { $dir=~s|/?$|/|; $Config_Dir = $dir; load_config(); return 1; } my @caller = caller (1); die <