From: Matt S Trout Date: Wed, 5 Jan 2011 06:07:16 +0000 (+0000) Subject: skeleton config objects and loading X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=73ebcfa821d6f8240aff4fe54c699732b026a7c4;p=scpubgit%2FClifton.git skeleton config objects and loading --- 73ebcfa821d6f8240aff4fe54c699732b026a7c4 diff --git a/lib/App/Clifton/BridgeConfig.pm b/lib/App/Clifton/BridgeConfig.pm new file mode 100644 index 0000000..abe0727 --- /dev/null +++ b/lib/App/Clifton/BridgeConfig.pm @@ -0,0 +1,16 @@ +package App::Clifton::BridgeConfig; + +use App::Clifton::Types qw(object_of_class); +use aliased 'App::Clifton::BridgeConfig::Jabber' => 'BridgeConfig_Jabber'; +use aliased 'App::Clifton::BridgeConfig::IRC' => 'BridgeConfig_IRC'; +use Moo; + +has jabber => ( + is => 'ro', required => 1, isa => object_of_class(BridgeConfig_Jabber) +); + +has irc => ( + is => 'ro', required => 1, isa => object_of_class(BridgeConfig_IRC) +); + +1; diff --git a/lib/App/Clifton/BridgeConfig/IRC.pm b/lib/App/Clifton/BridgeConfig/IRC.pm new file mode 100644 index 0000000..45603ac --- /dev/null +++ b/lib/App/Clifton/BridgeConfig/IRC.pm @@ -0,0 +1,8 @@ +package App::Clifton::BridgeConfig::IRC; + +use Moo; + +has $_ => (is => 'ro', required => 1) + for qw(server channel); + +1; diff --git a/lib/App/Clifton/BridgeConfig/Jabber.pm b/lib/App/Clifton/BridgeConfig/Jabber.pm new file mode 100644 index 0000000..71f6df3 --- /dev/null +++ b/lib/App/Clifton/BridgeConfig/Jabber.pm @@ -0,0 +1,8 @@ +package App::Clifton::BridgeConfig::Jabber; + +use Moo; + +has $_ => (is => 'ro', required => 1) + for qw(server user pass); + +1; diff --git a/lib/App/Clifton/BridgeConfigSet.pm b/lib/App/Clifton/BridgeConfigSet.pm new file mode 100644 index 0000000..a6c8e51 --- /dev/null +++ b/lib/App/Clifton/BridgeConfigSet.pm @@ -0,0 +1,21 @@ +package App::Clifton::BridgeConfigSet; + +use aliased 'App::Clifton::BridgeConfig'; +use aliased 'App::Clifton::BridgeConfig::Jabber' => 'BridgeConfig_Jabber'; +use aliased 'App::Clifton::BridgeConfig::IRC' => 'BridgeConfig_IRC'; +use Moo; + +with 'App::Clifton::Set'; + +sub _set_of_class { BridgeConfig } +sub _set_over { 'name' } + +sub _spec_to_constructor_args { + my ($self, $spec) = @_; + +{ + jabber => BridgeConfig_Jabber->new($spec->{jabber}), + irc => BridgeConfig_IRC->new($spec->{irc}), + } +} + +1; diff --git a/lib/App/Clifton/Config.pm b/lib/App/Clifton/Config.pm new file mode 100644 index 0000000..bf1c072 --- /dev/null +++ b/lib/App/Clifton/Config.pm @@ -0,0 +1,16 @@ +package App::Clifton::Config; + +use strictures 1; +use aliased 'App::Clifton::BridgeConfigSet'; +use aliased 'App::Clifton::UserConfigSet'; +use Moo; + +has $_ => ( + is => 'ro', + is => 'lazy' +) for qw(bridges users); + +sub _build_bridges { BridgeConfigSet->new } +sub _build_users { UserConfigSet->new } + +1; diff --git a/lib/App/Clifton/ConfigLoader.pm b/lib/App/Clifton/ConfigLoader.pm new file mode 100644 index 0000000..4e9c7a5 --- /dev/null +++ b/lib/App/Clifton/ConfigLoader.pm @@ -0,0 +1,33 @@ +package App::Clifton::ConfigLoader; + +use aliased 'App::Clifton::Config'; +use aliased 'App::Clifton::UserConfig'; +use Config::Settings; +use Moo; + +has _cs => (is => 'lazy', handles => { '_parse_file' => 'parse_file' }); + +sub _build__cs { + Config::Settings->new +} + +sub _new_config { Config->new } + +sub config_from_file { + my ($self, $file) = @_; + my $data = $self->_parse_file($file); + my $config = $self->_new_config; + foreach my $name (keys %{$data->{bridge}}) { + $config->bridges->add({ + name => $name, + %{$data->{bridge}{$name}} + }); + } + foreach my $name (keys %{$data->{user}}) { + $config->users->add({ + name => $name, + %{$data->{user}{$name}} + }); + } + return $config; +} diff --git a/lib/App/Clifton/Set.pm b/lib/App/Clifton/Set.pm new file mode 100644 index 0000000..d938189 --- /dev/null +++ b/lib/App/Clifton/Set.pm @@ -0,0 +1,47 @@ +package App::Clifton::Set; + +use Scalar::Util qw(blessed); +use Moo::Role; + +requires '_set_of_class'; +requires '_set_over'; + +has _set => (is => 'ro', default => sub { {} }); + +sub add { + my ($self, $spec) = @_; + $self->_set->{$self->_spec_to_key($spec)} = $self->_spec_to_object($spec); +} + +sub get { + my ($self, $spec) = @_; + $self->_set->{$self->_spec_to_key($spec)}; +} + +sub _spec_to_object { + my ($self, $spec) = @_; + if (blessed($spec) && $spec->isa($self->_set_of_class)) { + $spec; + } else { + $self->_new_member($self->_spec_to_constructor_args($spec)); + } +} + +sub _new_member { + my ($self, $args) = @_; + $self->_set_of_class->new($args); +} + +sub _spec_to_constructor_args { + my ($self, $spec) = @_; + $spec; +} + +sub _spec_to_key { + my ($self, $spec) = @_; + my $key = $self->_set_over; + die "key ${key} is required" unless $spec->{$key}; + $spec->{$key}; +} + +1; diff --git a/lib/App/Clifton/Types.pm b/lib/App/Clifton/Types.pm new file mode 100644 index 0000000..afd1a5c --- /dev/null +++ b/lib/App/Clifton/Types.pm @@ -0,0 +1,17 @@ +package App::Clifton::Types; + +use strictures 1; +use base qw(Exporter); +use Scalar::Util qw(blessed); + +our @EXPORT_OK = qw(object_of_class); + +sub object_of_class { + my ($name) = @_; + sub { + my ($test) = @_; + blessed($test) && $test->isa($name) || die "$test !isa $name"; + }; +} + +1; diff --git a/lib/App/Clifton/UserConfig.pm b/lib/App/Clifton/UserConfig.pm new file mode 100644 index 0000000..0b82954 --- /dev/null +++ b/lib/App/Clifton/UserConfig.pm @@ -0,0 +1,8 @@ +package App::Clifton::UserConfig; + +use Moo; + +has allow => (is => 'ro', required => 1); +has irc_nick => (is => 'ro', required => 1); + +1; diff --git a/lib/App/Clifton/UserConfigSet.pm b/lib/App/Clifton/UserConfigSet.pm new file mode 100644 index 0000000..b21fe93 --- /dev/null +++ b/lib/App/Clifton/UserConfigSet.pm @@ -0,0 +1,11 @@ +package App::Clifton::UserConfigSet; + +use aliased 'App::Clifton::UserConfig'; +use Moo; + +with 'App::Clifton::Set'; + +sub _set_of_class { UserConfig } +sub _set_over { 'name' } + +1; diff --git a/t/load_config.t b/t/load_config.t new file mode 100644 index 0000000..0a66c5b --- /dev/null +++ b/t/load_config.t @@ -0,0 +1,10 @@ +use strictures 1; +use Test::More; + +use App::Clifton::ConfigLoader; + +my $cl = App::Clifton::ConfigLoader->new; + +use Devel::Dwarn; + +Dwarn($cl->config_from_file('t/test.conf')); diff --git a/t/test.conf b/t/test.conf new file mode 100644 index 0000000..d2c205a --- /dev/null +++ b/t/test.conf @@ -0,0 +1,16 @@ +bridge "example" { + jabber { + server "example.org"; + user "user@example.org"; + pass "redacted"; + }; + irc { + server "irc.example.org"; + channel "#example"; + } +}; + +user "mst@example.org" { + allow [ "example" ]; + irc_nick "mst_clifton"; +};