work towards s/Moose/Moo/g

[p5sagit/Promulger.git] / lib / Promulger / List.pm

diff --git a/lib/Promulger/List.pm b/lib/Promulger/List.pm
index 401b619..9e0e969 100644 (file)
--- a/lib/Promulger/List.pm
+++ b/lib/Promulger/List.pm
@@ -1,35 +1,124 @@
 package Promulger::List;
-use Moose;
+use Moo;
 
+use autodie ':all';
 use Carp;
-use Dir::Self;
-use File::Slurp qw/read_file write_file/;
+use Path::Class;
+use Fcntl ':flock';
+use Tie::File;
+use File::Slurp qw/read_file, write_file/;
+use Data::Dumper;
+$Data::Dumper::Purity = 1;
+
+use Promulger::Config;
 
 has listname => (
   is       => 'ro',
-  isa      => 'Str',
+  isa      => sub { $_[0] =~ /^\w+$/ or die "listname must be a string" },
   required => 1,
 );
 
 has active => (
   is       => 'rw',
-  isa      => 'Bool',
+  isa      => sub { ($_[0] == 0 || $_[0] == 1) or die "active must be 0 or 1" },
   required => 1,
-  default  => 1,
+  default  => sub { 1 },
 );
 
-sub setup_aliases_at {
-  my($self, $config) = @_;
+has subscribers => (
+  is       => 'rw',
+  isa      => sub { ref $_[0] eq 'HASH' or die "subscribers must be a hashref" },
+  required => 1,
+  default  => sub { {} },
+);
+
+sub resolve {
+  my ($self, $proto) = @_;
+  $proto =~ s/-request$//;
+  my $path = find_path_for($proto);
+  my $maybe_list;
+  eval {
+    $maybe_list = __PACKAGE__->load($path->stringify);
+  };
+  return $maybe_list;
+}
+
+sub subscribe {
+  my ($self, $new) = @_;
+  return if $self->subscribers->{$new};
+  $self->subscribers->{$new} = 1;
+  $self->store(find_path_for($self->listname)->stringify);
+  return 1;
+}
+
+sub unsubscribe {
+  my ($self, $ex) = @_;
+  return unless exists $self->subscribers->{$ex};
+  delete $self->subscribers->{$ex};
+  $self->store(find_path_for($self->listname)->stringify);
+  return 1;
+}
+
+# XXX implement ACLs and other shinies -- apeiron, 2010-03-13 
+sub accept_posts_from {
+  my ($self, $sender) = @_;
+  return grep { $sender eq $_ } keys %{$self->subscribers};
+}
+
+sub setup {
+  my ($self) = @_;
+  my $config = Promulger::Config->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}";
+  croak "${name} already a known list" if $self->resolve($name);
+  my $path = find_path_for($name);
+
+  my $tie = tie my @aliases, 'Tie::File', $config->{aliases};
+  $tie->flock;
+  my @list_aliases = ($name, "${name}-request");
+
+  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"\n);
+    push @aliases, 
+      qq(${list_alias}: "|$config->{bin_root}/pmg msg -c $config->{config_file}"\n);
   }
-  write_file $config->{aliases}, @current_contents;
+
+  $self->store($path->stringify);
+}
+
+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)->stringify;
+}
+
+sub find_path_for {
+  my ($proto) = @_;
+  my $path = file(Promulger::Config->config->{list_home}, $proto . ".list");
+  return $path;
+}
+
+sub store {
+  my ($self, $path) = @_;
+  my $dumped = 'do { my '. Dumper($self) . '; $VAR1; }';
+  write_file($path, $dumped);
+}
+
+sub load {
+  my ($class, $path) = @_;
+  return do $path;
 }
 
-1;
+'http://mitpress.mit.edu/sicp/';