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 use Tie::File;
  10
  11 use Promulger::Config;
  12
  13 has listname => (
  14   is       => 'ro',
  15   isa      => 'Str',
  16   required => 1,
  17 );
  18
  19 has active => (
  20   is       => 'rw',
  21   isa      => 'Bool',
  22   required => 1,
  23   default  => 1,
  24 );
  25
  26 has subscribers => (
  27   is       => 'rw',
  28   isa      => 'HashRef',
  29   required => 1,
  30   default  => sub { {} },
  31 );
  32
  33 with Storage (
  34   format => 'JSON',
  35   io     => 'File',
  36 );
  37
  38 sub resolve {
  39   my ($self, $proto) = @_;
  40   $proto =~ s/-request$//;
  41   my $path = find_path_for($proto);
  42   my $maybe_list;
  43   eval {
  44     $maybe_list = __PACKAGE__->load($path->stringify);
  45   };
  46   return $maybe_list;
  47 }
  48
  49 sub subscribe {
  50   my ($self, $new) = @_;
  51   return if $self->subscribers->{$new};
  52   $self->subscribers->{$new} = 1;
  53   $self->store(find_path_for($self->listname)->stringify);
  54   return 1;
  55 }
  56
  57 sub unsubscribe {
  58   my ($self, $ex) = @_;
  59   return unless exists $self->subscribers->{$ex};
  60   delete $self->subscribers->{$ex};
  61   $self->store(find_path_for($self->listname)->stringify);
  62   return 1;
  63 }
  64
  65 # XXX implement ACLs and other shinies -- apeiron, 2010-03-13
  66 sub accept_posts_from {
  67   my ($self, $sender) = @_;
  68   return grep { $sender eq $_ } keys %{$self->subscribers};
  69 }
  70
  71 sub setup {
  72   my ($self) = @_;
  73   my $config = Promulger::Config->config;
  74   my $name = $self->listname;
  75   croak "${name} already a known list" if $self->resolve($name);
  76   my $path = find_path_for($name);
  77
  78   my $tie = tie my @aliases, 'Tie::File', $config->{aliases};
  79   $tie->flock;
  80   my @list_aliases = ($name, "${name}-request");
  81
  82   for my $list_alias (@list_aliases) {
  83     if(grep { /^${list_alias}:/ } @aliases) {
  84       croak "${list_alias} already in $config->{aliases}";
  85     }
  86     push @aliases,
  87       qq(${list_alias}: "|$config->{bin_root}/pmg msg -c $config->{config_file}"\n);
  88   }
  89
  90   $self->store($path->stringify);
  91 }
  92
  93 sub delete {
  94   my ($self) = @_;
  95   my $config = Promulger::Config->config;
  96   my $name = $self->listname;
  97
  98   my $tie = tie my @aliases, 'Tie::File', $config->{aliases};
  99   $tie->flock;
 100
 101   my @list_aliases = ($name, "${name}-request");
 102   @aliases = grep {
 103     $_ !~ /^$list_aliases[0]:/ &&
 104     $_ !~ /^$list_aliases[1]:/
 105   } @aliases;
 106
 107   unlink find_path_for($self->listname)->stringify;
 108 }
 109
 110 sub find_path_for {
 111   my ($proto) = @_;
 112   my $path = file(Promulger::Config->config->{list_home}, $proto . ".list");
 113   return $path;
 114 }
 115
 116 'http://mitpress.mit.edu/sicp/';