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