From: Chris Nehren <apeiron@cpan.org>
Date: Wed, 30 Dec 2009 06:45:46 +0000 (-0500)
Subject: simple and stupid list creation. sets up aliases, creates the object, stores it.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=514dce6357ac49f714778c90d2fb49ac03eae174;p=p5sagit%2FPromulger.git

simple and stupid list creation. sets up aliases, creates the object, stores it.
and that's it.
---

diff --git a/bin/pmg b/bin/pmg
new file mode 100755
index 0000000..f06884f
--- /dev/null
+++ b/bin/pmg
@@ -0,0 +1,11 @@
+#!/usr/bin/perl
+
+eval 'exec /usr/local/bin/perl -w -S $0 ${1+"$@"}'
+    if 0; # not running under some shell
+
+use strict;
+use warnings;
+
+use App::Promulger;
+
+App::Promulger->run;
diff --git a/lib/App/Promulger.pm b/lib/App/Promulger.pm
new file mode 100644
index 0000000..545f962
--- /dev/null
+++ b/lib/App/Promulger.pm
@@ -0,0 +1,7 @@
+package App::Promulger;
+use strict;
+use warnings;
+
+use App::Cmd::Setup -app;
+
+1;
diff --git a/lib/App/Promulger/Command/newlist.pm b/lib/App/Promulger/Command/newlist.pm
new file mode 100644
index 0000000..aa4393a
--- /dev/null
+++ b/lib/App/Promulger/Command/newlist.pm
@@ -0,0 +1,49 @@
+package App::Promulger::Command::newlist;
+use strict;
+use warnings;
+
+use App::Promulger -command;
+use Promulger::Schema;
+use Promulger::List;
+
+use Config::General;
+
+sub abstract {
+  return "creates a new list";
+}
+
+sub opt_spec {
+  return (
+    [ "config|c=s", "configuration file", { required => 1 } ],
+  );
+}
+
+sub validate_args {
+  my ($self, $opt, $args) = @_;
+  my $cf = $opt->{config};
+
+  unless(-e $cf) {
+    die "Config file $cf doesn't exist\n";
+  }
+  unless(-f $cf) {
+    die "Config file $cf not a file\n";
+  }
+  unless(-r $cf) {
+    die "Config file $cf not readable\n";
+  }
+
+  $self->{config} = { Config::General->new($cf)->getall };
+  @$args == 1 or die "pmg newlist needs a list name\n";
+}
+
+sub run {
+  my ($self, $opt, $args) = @_;
+  Promulger::Schema->connect($self->{config}{store});
+  my $list = Promulger::List->new(
+    listname  => $args->[0],
+  );
+  $list->setup_aliases_at($self->{config});
+  Promulger::Schema->store($list);
+}
+
+1;
diff --git a/lib/Promulger/List.pm b/lib/Promulger/List.pm
new file mode 100644
index 0000000..401b619
--- /dev/null
+++ b/lib/Promulger/List.pm
@@ -0,0 +1,35 @@
+package Promulger::List;
+use Moose;
+
+use Carp;
+use Dir::Self;
+use File::Slurp qw/read_file write_file/;
+
+has listname => (
+  is       => 'ro',
+  isa      => 'Str',
+  required => 1,
+);
+
+has active => (
+  is       => 'rw',
+  isa      => 'Bool',
+  required => 1,
+  default  => 1,
+);
+
+sub setup_aliases_at {
+  my($self, $config) = @_;
+  my $name = $self->listname;
+  my @current_contents = read_file $config->{aliases};
+  my @aliases = ($name, "${name}-request");
+  for my $alias (@aliases) {
+    if(grep { $_ =~ /^${alias}:/ } @current_contents) {
+      croak "${alias} already in $config->{aliases}";
+    }
+    push @current_contents, qq(${alias}: "|$config->{bin_root}/pmg msg"\n);
+  }
+  write_file $config->{aliases}, @current_contents;
+}
+
+1;
diff --git a/lib/Promulger/Schema.pm b/lib/Promulger/Schema.pm
new file mode 100644
index 0000000..cd68c17
--- /dev/null
+++ b/lib/Promulger/Schema.pm
@@ -0,0 +1,24 @@
+package Promulger::Schema;
+use strict;
+use warnings;
+
+use KiokuDB;
+
+my $kdb;
+my $scope;
+
+sub connect {
+  my($self, $dsn) = @_;
+  $kdb = KiokuDB->connect(
+    $dsn,
+    create => 1,
+  );
+  $scope = $kdb->new_scope;
+}
+
+sub store {
+  my($self, $obj) = @_;
+  $kdb->store($obj);
+}
+
+1;