lib/Promulger/List.pm

   1 package Promulger::List;
   2 use Moose;
   3 use MooseX::Storage;
   4
   5 use autodie ':all';
   6 use Carp;
   7 use Path::Class;
   8 use Fcntl ':flock';
   9
  10 use Promulger::Config;
  11
  12 has listname => (
  13   is       => 'ro',
  14   isa      => 'Str',
  15   required => 1,
  16 );
  17
  18 has active => (
  19   is       => 'rw',
  20   isa      => 'Bool',
  21   required => 1,
  22   default  => 1,
  23 );
  24
  25 has subscribers => (
  26   is       => 'rw',
  27   isa      => 'HashRef',
  28   required => 1,
  29   default  => sub { {} },
  30 );
  31
  32 with Storage (
  33   format => 'JSON',
  34   io     => 'File',
  35 );
  36
  37 sub resolve {
  38   my($proto) = @_;
  39   $proto =~ s/-request$//;
  40   my $path = find_path_for($proto);
  41   my $maybe_list;
  42   eval {
  43     $maybe_list = __PACKAGE__->load($path->stringify);
  44   };
  45   return $maybe_list;
  46 }
  47
  48 sub subscribe {
  49   my($self, $new) = @_;
  50   return if $self->subscribers->at($new);
  51   $self->subscribers->put($new, 1);
  52   $self->store(find_path_for($self->name));
  53 }
  54
  55 sub unsubscribe {
  56   my($self, $ex) = @_;
  57   return unless $self->subscribers->at($ex);
  58   $self->subscribers->delete($ex);
  59   $self->store(find_path_for($self->name));
  60 }
  61
  62 # XXX implement ACLs and other shinies -- apeiron, 2010-03-13
  63 sub accept_posts_from {
  64   my($self, $sender) = @_;
  65   return grep { $sender eq $_ } @{$self->subscribers};
  66 }
  67
  68 sub setup {
  69   my($self) = @_;
  70   my $config = Promulger::Config->config;
  71   my $name = $self->listname;
  72   croak "${name} already a known list" if resolve($name);
  73   my $path = find_path_for($name);
  74
  75   open my $fh, '+<', $config->{aliases};
  76   flock $fh, LOCK_EX;
  77   my @current_contents = <$fh>;
  78   my @aliases = ($name, "${name}-request");
  79
  80   for my $alias (@aliases) {
  81     if(grep { /^${alias}:/ } @current_contents) {
  82       croak "${alias} already in $config->{aliases}";
  83     }
  84     push @current_contents,
  85       qq(${alias}: "|$config->{bin_root}/pmg msg -c $config->{config_file}"\n);
  86   }
  87
  88   $self->store($path->stringify);
  89   print $fh @current_contents;
  90   flock $fh, LOCK_UN;
  91 }
  92
  93 sub find_path_for {
  94   my ($proto) = @_;
  95   my $path = file(Promulger::Config->config->{list_home}, $proto . ".list");
  96 }
  97
  98 'http://mitpress.mit.edu/sicp/';