lib/Promulger/List.pm

   1 package Promulger::List;
   2 use Moo;
   3
   4 use autodie ':all';
   5 use Carp;
   6 use Path::Class;
   7 use Fcntl ':flock';
   8 use Tie::File;
   9 use File::Slurp qw/read_file, write_file/;
  10 use Data::Dumper;
  11 $Data::Dumper::Purity = 1;
  12
  13 use Promulger::Config;
  14
  15 has listname => (
  16   is       => 'ro',
  17   isa      => sub { $_[0] =~ /^\w+$/ or die "listname must be a string" },
  18   required => 1,
  19 );
  20
  21 has active => (
  22   is       => 'rw',
  23   isa      => sub { ($_[0] == 0 || $_[0] == 1) or die "active must be 0 or 1" },
  24   required => 1,
  25   default  => sub { 1 },
  26 );
  27
  28 has subscribers => (
  29   is       => 'rw',
  30   isa      => sub { ref $_[0] eq 'HASH' or die "subscribers must be a hashref" },
  31   required => 1,
  32   default  => sub { {} },
  33 );
  34
  35 sub resolve {
  36   my ($self, $proto) = @_;
  37   $proto =~ s/-request$//;
  38   my $path = find_path_for($proto);
  39   my $maybe_list;
  40   eval {
  41     $maybe_list = __PACKAGE__->load($path->stringify);
  42   };
  43   return $maybe_list;
  44 }
  45
  46 sub subscribe {
  47   my ($self, $new) = @_;
  48   return if $self->subscribers->{$new};
  49   $self->subscribers->{$new} = 1;
  50   $self->store(find_path_for($self->listname)->stringify);
  51   return 1;
  52 }
  53
  54 sub unsubscribe {
  55   my ($self, $ex) = @_;
  56   return unless exists $self->subscribers->{$ex};
  57   delete $self->subscribers->{$ex};
  58   $self->store(find_path_for($self->listname)->stringify);
  59   return 1;
  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 $_ } keys %{$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 $self->resolve($name);
  73   my $path = find_path_for($name);
  74
  75   my $tie = tie my @aliases, 'Tie::File', $config->{aliases};
  76   $tie->flock;
  77   my @list_aliases = ($name, "${name}-request");
  78
  79   for my $list_alias (@list_aliases) {
  80     if(grep { /^${list_alias}:/ } @aliases) {
  81       croak "${list_alias} already in $config->{aliases}";
  82     }
  83     push @aliases,
  84       qq(${list_alias}: "|$config->{bin_root}/pmg msg -c $config->{config_file}"\n);
  85   }
  86
  87   $self->store($path->stringify);
  88 }
  89
  90 sub delete {
  91   my ($self) = @_;
  92   my $config = Promulger::Config->config;
  93   my $name = $self->listname;
  94
  95   my $tie = tie my @aliases, 'Tie::File', $config->{aliases};
  96   $tie->flock;
  97
  98   my @list_aliases = ($name, "${name}-request");
  99   @aliases = grep {
 100     $_ !~ /^$list_aliases[0]:/ &&
 101     $_ !~ /^$list_aliases[1]:/
 102   } @aliases;
 103
 104   unlink find_path_for($self->listname)->stringify;
 105 }
 106
 107 sub find_path_for {
 108   my ($proto) = @_;
 109   my $path = file(Promulger::Config->config->{list_home}, $proto . ".list");
 110   return $path;
 111 }
 112
 113 sub store {
 114   my ($self, $path) = @_;
 115   my $dumped = 'do { my '. Dumper($self) . '; $VAR1; }';
 116   write_file($path, $dumped);
 117 }
 118
 119 sub load {
 120   my ($class, $path) = @_;
 121   return do $path;
 122 }
 123
 124 'http://mitpress.mit.edu/sicp/';