From: Chris Nehren <apeiron@cpan.org>
Date: Sun, 20 Jun 2010 03:06:58 +0000 (-0400)
Subject: final bits of code to be useful
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9bfd7b606405e9b972e810ac3e2313997ef83e0c;p=p5sagit%2FPromulger.git

final bits of code to be useful
---

diff --git a/lib/App/Promulger/Command.pm b/lib/App/Promulger/Command.pm
index c667539..32f6315 100644
--- a/lib/App/Promulger/Command.pm
+++ b/lib/App/Promulger/Command.pm
@@ -26,8 +26,7 @@ sub validate_args {
     die "Config file $cf not readable\n";
   }
 
-  Promulger::Config->config({ Config::General->new($cf)->getall });
-  Promulger::Config->config->{config}{config_file} = $cf;
+  Promulger::Config->load_config($cf);
 }
 
 1;
diff --git a/lib/App/Promulger/Command/msg.pm b/lib/App/Promulger/Command/msg.pm
index 08a81bd..968a71b 100644
--- a/lib/App/Promulger/Command/msg.pm
+++ b/lib/App/Promulger/Command/msg.pm
@@ -19,4 +19,4 @@ sub run {
   Promulger::Dispatch::dispatch($message);
 }
 
-1;
+'Engage';
diff --git a/lib/App/Promulger/Command/newlist.pm b/lib/App/Promulger/Command/newlist.pm
index d4a386e..d9338fb 100644
--- a/lib/App/Promulger/Command/newlist.pm
+++ b/lib/App/Promulger/Command/newlist.pm
@@ -12,10 +12,12 @@ sub abstract {
 sub run {
   my ($self, $opt, $args) = @_;
   @$args == 1 or die "pmg newlist needs a list name\n";
+  
+  my $listname = $args->[0];
   my $list = Promulger::List->new(
-    listname  => $args->[0],
+    listname  => $listname,
   );
   $list->setup;
 }
 
-1;
+'Make it so';
diff --git a/lib/App/Promulger/Command/rmlist.pm b/lib/App/Promulger/Command/rmlist.pm
new file mode 100644
index 0000000..389bdb2
--- /dev/null
+++ b/lib/App/Promulger/Command/rmlist.pm
@@ -0,0 +1,27 @@
+package App::Promulger::Command::rmlist;
+use strict;
+use warnings;
+
+use App::Promulger -command;
+use Promulger::List;
+
+sub abstract {
+  return "removes a list";
+}
+
+sub run {
+  my ($self, $opt, $args) = @_;
+  @$args == 1 or die "pmg rmlist needs a list name\n";
+
+  my $listname = $args->[0];
+  my $list = Promulger::List->resolve($listname);
+
+  if($list) {
+    $list->delete;
+  } else {
+    die "$listname doesn't exist\n";
+  }
+}
+
+'Make it so';
+
diff --git a/lib/Promulger/Config.pm b/lib/Promulger/Config.pm
index 6c4d73b..28fec99 100644
--- a/lib/Promulger/Config.pm
+++ b/lib/Promulger/Config.pm
@@ -1,12 +1,21 @@
 package Promulger::Config;
+use strict;
+use warnings;
+
+use Config::General;
 
 my $config;
-sub config {
-  my $class = shift;
-  if(my $new = shift) {
-    $config = $new;
-  }
+
+sub load_config {
+  my ($class, $config_file) = @_;
+  $config = { Config::General->new($config_file)->getall };
+  $config->{config_file} = $config_file;
   return $config;
 };
 
+sub config {
+  die "No configuration loaded" unless $config;
+  return $config;
+}
+
 'http://reductivelabs.com/products/puppet/';
diff --git a/lib/Promulger/List.pm b/lib/Promulger/List.pm
index 7c4a96f..eda923c 100644
--- a/lib/Promulger/List.pm
+++ b/lib/Promulger/List.pm
@@ -6,6 +6,7 @@ use autodie ':all';
 use Carp;
 use Path::Class;
 use Fcntl ':flock';
+use Tie::File;
 
 use Promulger::Config;
 
@@ -35,7 +36,7 @@ with Storage (
 );
 
 sub resolve {
-  my($proto) = @_;
+  my ($self, $proto) = @_;
   $proto =~ s/-request$//;
   my $path = find_path_for($proto);
   my $maybe_list;
@@ -46,14 +47,14 @@ sub resolve {
 }
 
 sub subscribe {
-  my($self, $new) = @_;
+  my ($self, $new) = @_;
   return if $self->subscribers->at($new);
   $self->subscribers->put($new, 1);
   $self->store(find_path_for($self->name));
 }
 
 sub unsubscribe {
-  my($self, $ex) = @_;
+  my ($self, $ex) = @_;
   return unless $self->subscribers->at($ex);
   $self->subscribers->delete($ex);
   $self->store(find_path_for($self->name));
@@ -61,38 +62,53 @@ sub unsubscribe {
 
 # XXX implement ACLs and other shinies -- apeiron, 2010-03-13 
 sub accept_posts_from {
-  my($self, $sender) = @_;
+  my ($self, $sender) = @_;
   return grep { $sender eq $_ } @{$self->subscribers};
 }
 
 sub setup {
-  my($self) = @_;
+  my ($self) = @_;
   my $config = Promulger::Config->config;
   my $name = $self->listname;
-  croak "${name} already a known list" if resolve($name);
+  croak "${name} already a known list" if $self->resolve($name);
   my $path = find_path_for($name);
 
-  open my $fh, '+<', $config->{aliases};
-  flock $fh, LOCK_EX;
-  my @current_contents = <$fh>;
-  my @aliases = ($name, "${name}-request");
+  my $tie = tie my @aliases, 'Tie::File', $config->{aliases};
+  $tie->flock;
+  my @list_aliases = ($name, "${name}-request");
 
-  for my $alias (@aliases) {
-    if(grep { /^${alias}:/ } @current_contents) {
-      croak "${alias} already in $config->{aliases}";
+  for my $list_alias (@list_aliases) {
+    if(grep { /^${list_alias}:/ } @aliases) {
+      croak "${list_alias} already in $config->{aliases}";
     }
-    push @current_contents, 
-      qq(${alias}: "|$config->{bin_root}/pmg msg -c $config->{config_file}"\n);
+    push @aliases, 
+      qq(${list_alias}: "|$config->{bin_root}/pmg msg -c $config->{config_file}"\n);
   }
 
   $self->store($path->stringify);
-  print $fh @current_contents;
-  flock $fh, LOCK_UN;
+}
+
+sub delete {
+  my ($self) = @_;
+  my $config = Promulger::Config->config;
+  my $name = $self->listname;
+
+  my $tie = tie my @aliases, 'Tie::File', $config->{aliases};
+  $tie->flock;
+
+  my @list_aliases = ($name, "${name}-request");
+  @aliases = grep {
+    $_ !~ /^$list_aliases[0]:/ &&
+    $_ !~ /^$list_aliases[1]:/
+  } @aliases;
+
+  unlink find_path_for($self->listname);
 }
 
 sub find_path_for {
   my ($proto) = @_;
   my $path = file(Promulger::Config->config->{list_home}, $proto . ".list");
+  return $path;
 }
 
 'http://mitpress.mit.edu/sicp/';