Fix list creation, add a method to enumerate a list's subscribers.
[p5sagit/Promulger.git] / lib / Promulger / List.pm
CommitLineData
514dce63 1package Promulger::List;
243baf4d 2use Moo;
514dce63 3
f5baca29 4use autodie ':all';
514dce63 5use Carp;
f5baca29 6use Path::Class;
7use Fcntl ':flock';
9bfd7b60 8use Tie::File;
0456162d 9use File::Slurp qw/read_file write_file/;
243baf4d 10use Data::Dumper;
0456162d 11use Try::Tiny;
243baf4d 12$Data::Dumper::Purity = 1;
514dce63 13
21baaef0 14use Promulger::Config;
15
514dce63 16has listname => (
17 is => 'ro',
243baf4d 18 isa => sub { $_[0] =~ /^\w+$/ or die "listname must be a string" },
514dce63 19 required => 1,
20);
21
22has active => (
23 is => 'rw',
243baf4d 24 isa => sub { ($_[0] == 0 || $_[0] == 1) or die "active must be 0 or 1" },
514dce63 25 required => 1,
243baf4d 26 default => sub { 1 },
514dce63 27);
28
21baaef0 29has subscribers => (
30 is => 'rw',
243baf4d 31 isa => sub { ref $_[0] eq 'HASH' or die "subscribers must be a hashref" },
21baaef0 32 required => 1,
33 default => sub { {} },
34);
35
21baaef0 36sub resolve {
9bfd7b60 37 my ($self, $proto) = @_;
21baaef0 38 $proto =~ s/-request$//;
39 my $path = find_path_for($proto);
40 my $maybe_list;
0456162d 41 try {
21baaef0 42 $maybe_list = __PACKAGE__->load($path->stringify);
0456162d 43 } catch {
44 die "oh noes: $_";
21baaef0 45 };
46 return $maybe_list;
47}
f5baca29 48
21baaef0 49sub subscribe {
9bfd7b60 50 my ($self, $new) = @_;
8ad89cb2 51 return if $self->subscribers->{$new};
52 $self->subscribers->{$new} = 1;
53 $self->store(find_path_for($self->listname)->stringify);
54 return 1;
21baaef0 55}
f5baca29 56
21baaef0 57sub unsubscribe {
9bfd7b60 58 my ($self, $ex) = @_;
8ad89cb2 59 return unless exists $self->subscribers->{$ex};
60 delete $self->subscribers->{$ex};
61 $self->store(find_path_for($self->listname)->stringify);
62 return 1;
21baaef0 63}
f5baca29 64
21baaef0 65# XXX implement ACLs and other shinies -- apeiron, 2010-03-13
66sub accept_posts_from {
9bfd7b60 67 my ($self, $sender) = @_;
8ad89cb2 68 return grep { $sender eq $_ } keys %{$self->subscribers};
21baaef0 69}
f5baca29 70
71sub setup {
9bfd7b60 72 my ($self) = @_;
21baaef0 73 my $config = Promulger::Config->config;
514dce63 74 my $name = $self->listname;
9bfd7b60 75 croak "${name} already a known list" if $self->resolve($name);
21baaef0 76 my $path = find_path_for($name);
f5baca29 77
9bfd7b60 78 my $tie = tie my @aliases, 'Tie::File', $config->{aliases};
79 $tie->flock;
80 my @list_aliases = ($name, "${name}-request");
21baaef0 81
9bfd7b60 82 for my $list_alias (@list_aliases) {
83 if(grep { /^${list_alias}:/ } @aliases) {
84 croak "${list_alias} already in $config->{aliases}";
514dce63 85 }
9bfd7b60 86 push @aliases,
87 qq(${list_alias}: "|$config->{bin_root}/pmg msg -c $config->{config_file}"\n);
514dce63 88 }
21baaef0 89
f5baca29 90 $self->store($path->stringify);
9bfd7b60 91}
92
93sub 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
8ad89cb2 107 unlink find_path_for($self->listname)->stringify;
514dce63 108}
109
21baaef0 110sub find_path_for {
111 my ($proto) = @_;
112 my $path = file(Promulger::Config->config->{list_home}, $proto . ".list");
9bfd7b60 113 return $path;
21baaef0 114}
115
243baf4d 116sub store {
117 my ($self, $path) = @_;
118 my $dumped = 'do { my '. Dumper($self) . '; $VAR1; }';
119 write_file($path, $dumped);
120}
121
122sub load {
123 my ($class, $path) = @_;
124 return do $path;
125}
126
0456162d 127sub 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
21baaef0 136'http://mitpress.mit.edu/sicp/';