lib/Promulger/List.pm

   1 package Promulger::List;
   2 use Moo;
   3 use autodie;
   4
   5 use autodie ':all';
   6 use Carp;
   7 use Path::Class;
   8 use Fcntl ':flock';
   9 use Tie::File;
  10 use File::Slurp qw/read_file write_file/;
  11 use Data::Dumper;
  12 use Try::Tiny;
  13 use FindBin qw($Bin);
  14 $Data::Dumper::Purity = 1;
  15
  16 use Promulger::Config;
  17
  18 has listname => (
  19   is       => 'ro',
  20   isa      => sub { $_[0] =~ /^\w+$/ or die "listname must be a string" },
  21   required => 1,
  22 );
  23
  24 has active => (
  25   is       => 'rw',
  26   isa      => sub { ($_[0] == 0 || $_[0] == 1) or die "active must be 0 or 1" },
  27   required => 1,
  28   default  => sub { 1 },
  29 );
  30
  31 has subscribers => (
  32   is       => 'rw',
  33   isa      => sub { ref $_[0] eq 'HASH' or die "subscribers must be a hashref" },
  34   required => 1,
  35   default  => sub { {} },
  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   try {
  44     $maybe_list = __PACKAGE__->load($path->stringify);
  45   } catch {
  46     die "oh noes: $_";
  47   };
  48   return $maybe_list;
  49 }
  50
  51 sub subscribe {
  52   my ($self, $new) = @_;
  53   return if $self->subscribers->{$new};
  54   $self->subscribers->{$new} = 1;
  55   $self->store(find_path_for($self->listname)->stringify);
  56   return 1;
  57 }
  58
  59 sub unsubscribe {
  60   my ($self, $ex) = @_;
  61   return unless exists $self->subscribers->{$ex};
  62   delete $self->subscribers->{$ex};
  63   $self->store(find_path_for($self->listname)->stringify);
  64   return 1;
  65 }
  66
  67 # XXX implement ACLs and other shinies -- apeiron, 2010-03-13
  68 sub accept_posts_from {
  69   my ($self, $sender) = @_;
  70   return grep { $sender eq $_ } keys %{$self->subscribers};
  71 }
  72
  73 sub setup {
  74   my ($self) = @_;
  75   my $config = Promulger::Config->config;
  76   my $name = $self->listname;
  77   croak "${name} already a known list" if $self->resolve($name);
  78   my $path = find_path_for($name);
  79
  80   my $tie = tie my @aliases, 'Tie::File', $config->{aliases}
  81     or die "cannot tie " . $config->{aliases} . ": $!";
  82   $tie->flock;
  83   my @list_aliases = ($name, "${name}-request");
  84
  85   for my $list_alias (@list_aliases) {
  86     if(grep { /^${list_alias}:/ } @aliases) {
  87       croak "${list_alias} already in $config->{aliases}";
  88     }
  89     push @aliases,
  90       qq(${list_alias}: "|$Bin msg -c $config->{config_file}"\n);
  91   }
  92
  93   $self->store($path->stringify);
  94 }
  95
  96 sub delete {
  97   my ($self) = @_;
  98   my $config = Promulger::Config->config;
  99   my $name = $self->listname;
 100
 101   my $tie = tie my @aliases, 'Tie::File', $config->{aliases};
 102   $tie->flock;
 103
 104   my @list_aliases = ($name, "${name}-request");
 105   @aliases = grep {
 106     $_ !~ /^$list_aliases[0]:/ &&
 107     $_ !~ /^$list_aliases[1]:/
 108   } @aliases;
 109
 110   unlink find_path_for($self->listname)->stringify;
 111 }
 112
 113 sub find_path_for {
 114   my ($proto) = @_;
 115   my $path = file(Promulger::Config->config->{list_home}, $proto . ".list");
 116   return $path;
 117 }
 118
 119 sub store {
 120   my ($self, $path) = @_;
 121   my $dumped = 'do { my '. Dumper($self) . '; $VAR1; }';
 122   write_file($path, $dumped);
 123 }
 124
 125 sub load {
 126   my ($class, $path) = @_;
 127   return do $path;
 128 }
 129
 130 sub get_lists {
 131   my ($self) = @_;
 132   my $config = Promulger::Config->config;
 133   my @lists = map { $_->basename}
 134               grep { -f } dir($config->{list_home})->children;
 135   s/\.list//g for @lists;
 136   return @lists;
 137 }
 138
 139 'http://mitpress.mit.edu/sicp/';