skeleton config objects and loading

diff --git a/lib/App/Clifton/BridgeConfig.pm b/lib/App/Clifton/BridgeConfig.pm
new file mode 100644 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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";
+};