--- timezone: Australia/Melbourne demo_url: http://someapponline.co.uk?logout=1&_client=8 support_url: /?_action=support::support some_root_id: 1272 # someapp_db: adaptor: mysql database: some_database host: localhost username: some_username password: some_password # otherapp_db: adaptor: mysql database: some_database host: localhost username: some_username password: some_password # about: host: somehost.com.au: about: server_root: /home/snoopy/merge/www_someapp: &1 prod_level: devl client_root: /var/www/devl/someapp someapp_url: http://devl.someapp.com.au demo_url: http://devl.someapp.com.au?logout=1&_client=14 otherapp_url: http://someapp.dowork.com.au /home/david/doitall: *1 someotherhost.com: about: server_root: # /home/wwwbaz/public_html: prod_level: prod otherapp_url: http://someapp.com.au/otherapp someapp_url: http://someapp.com.au demo_url: http://someapp.com.au?logout=1&_client=14 client_root: /home/wwwbaz/public_html # /home/wwwbazuk/public_html: prod_level: prod otherapp_url: http://mywebsite.com/otherapp someapp_url: http://mywebsite.com client_root: /home/wwwfoobar/public_html someapp_db: adaptor: mysql database: yet_another_database host: localhost username: yet_another_username password: yet_aother_password #### package SomeApp::Config; use warnings; use strict; use YAML; use Cwd; use Config::Auto; use Class::Autouse qw/Sys::Hostname/; our $Config; our $Host; our $Cwd; use Class::Struct ('Database' => { adaptor => '$', database => '$', host => '$', username => '$', password => '$', }); use Class::Struct ( client_root => '$', demo_url => '$', host => '$', someapp_db => 'Database', someapp_url => '$', prod_level => '$', server_root => '$', root_id => '$', support_url => '$', timezone => '$', otherapp_db => 'Database', otherapp_url => '$', ); { my $config = Config::Auto::parse('someapp.ini', format => 'yaml'); my @config = _load_config($config); $Config = __PACKAGE__->new( @config ); } sub _load_config { my $ config = shift; my @config = (); my $about = delete $config->{about}; push(@config, map{$_ => $config->{$_}} (keys %$config)); $Host ||= Sys::Hostname::hostname(); $Cwd ||= cwd(); if ($about) { die "malformed 'about' clause in config file" unless (ref $about eq 'HASH'); foreach (keys %$about) { if ($_ eq 'host') { my $about_hosts = $about->{'host'}; if (my $about_this_host = $about_hosts->{$Host}) { push (@config, _load_config ($about_this_host)); } } elsif ($_ eq 'server_root') { my $about_cwds = $about->{'server_root'}; foreach (sort keys %$about_cwds) { if (substr($Cwd, 0, length($_)) eq $_) { my $about_this_cwd = $about_cwds->{$_}; push (@config, _load_config ($about_this_cwd)); } } } else { die "don't know anything 'about' $_"; } } } push (@config, 'host', $Host); push (@config, 'server_root', $Cwd); return (@config); } sub config { return $Config; }; 1;