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 use Try::Tiny;
  12 $Data::Dumper::Purity = 1;
  13
  14 use Promulger::Config;
  15
  16 has listname => (
  17   is       => 'ro',
  18   isa      => sub { $_[0] =~ /^\w+$/ or die "listname must be a string" },
  19   required => 1,
  20 );
  21
  22 has active => (
  23   is       => 'rw',
  24   isa      => sub { ($_[0] == 0 || $_[0] == 1) or die "active must be 0 or 1" },
  25   required => 1,
  26   default  => sub { 1 },
  27 );
  28
  29 has subscribers => (
  30   is       => 'rw',
  31   isa      => sub { ref $_[0] eq 'HASH' or die "subscribers must be a hashref" },
  32   required => 1,
  33   default  => sub { {} },
  34 );
  35
  36 sub resolve {
  37   my ($self, $proto) = @_;
  38   $proto =~ s/-request$//;
  39   my $path = find_path_for($proto);
  40   my $maybe_list;
  41   try {
  42     $maybe_list = __PACKAGE__->load($path->stringify);
  43   } catch {
  44     die "oh noes: $_";
  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 sub store {
 117   my ($self, $path) = @_;
 118   my $dumped = 'do { my '. Dumper($self) . '; $VAR1; }';
 119   write_file($path, $dumped);
 120 }
 121
 122 sub load {
 123   my ($class, $path) = @_;
 124   return do $path;
 125 }
 126
 127 sub get_lists {
 128   my ($self) = @_;
 129   my $config = Promulger::Config->config;
 130   my @lists = map { $_->basename}
 131               grep { -f } dir($config->{list_home})->children;
 132   s/\.list//g for @lists;
 133   return @lists;
 134 }
 135
 136 'http://mitpress.mit.edu/sicp/';