Commit | Line | Data |
514dce63 |
1 | package Promulger::List; |
2 | use Moose; |
f5baca29 |
3 | use MooseX::Storage; |
514dce63 |
4 | |
f5baca29 |
5 | use autodie ':all'; |
514dce63 |
6 | use Carp; |
f5baca29 |
7 | use Path::Class; |
8 | use Fcntl ':flock'; |
9bfd7b60 |
9 | use Tie::File; |
514dce63 |
10 | |
21baaef0 |
11 | use Promulger::Config; |
12 | |
514dce63 |
13 | has listname => ( |
14 | is => 'ro', |
15 | isa => 'Str', |
16 | required => 1, |
17 | ); |
18 | |
19 | has active => ( |
20 | is => 'rw', |
21 | isa => 'Bool', |
22 | required => 1, |
23 | default => 1, |
24 | ); |
25 | |
21baaef0 |
26 | has subscribers => ( |
27 | is => 'rw', |
28 | isa => 'HashRef', |
29 | required => 1, |
30 | default => sub { {} }, |
31 | ); |
32 | |
f5baca29 |
33 | with Storage ( |
34 | format => 'JSON', |
35 | io => 'File', |
36 | ); |
37 | |
21baaef0 |
38 | sub resolve { |
9bfd7b60 |
39 | my ($self, $proto) = @_; |
21baaef0 |
40 | $proto =~ s/-request$//; |
41 | my $path = find_path_for($proto); |
42 | my $maybe_list; |
43 | eval { |
44 | $maybe_list = __PACKAGE__->load($path->stringify); |
45 | }; |
46 | return $maybe_list; |
47 | } |
f5baca29 |
48 | |
21baaef0 |
49 | sub subscribe { |
9bfd7b60 |
50 | my ($self, $new) = @_; |
21baaef0 |
51 | return if $self->subscribers->at($new); |
52 | $self->subscribers->put($new, 1); |
53 | $self->store(find_path_for($self->name)); |
54 | } |
f5baca29 |
55 | |
21baaef0 |
56 | sub unsubscribe { |
9bfd7b60 |
57 | my ($self, $ex) = @_; |
21baaef0 |
58 | return unless $self->subscribers->at($ex); |
59 | $self->subscribers->delete($ex); |
60 | $self->store(find_path_for($self->name)); |
61 | } |
f5baca29 |
62 | |
21baaef0 |
63 | # XXX implement ACLs and other shinies -- apeiron, 2010-03-13 |
64 | sub accept_posts_from { |
9bfd7b60 |
65 | my ($self, $sender) = @_; |
21baaef0 |
66 | return grep { $sender eq $_ } @{$self->subscribers}; |
67 | } |
f5baca29 |
68 | |
69 | sub setup { |
9bfd7b60 |
70 | my ($self) = @_; |
21baaef0 |
71 | my $config = Promulger::Config->config; |
514dce63 |
72 | my $name = $self->listname; |
9bfd7b60 |
73 | croak "${name} already a known list" if $self->resolve($name); |
21baaef0 |
74 | my $path = find_path_for($name); |
f5baca29 |
75 | |
9bfd7b60 |
76 | my $tie = tie my @aliases, 'Tie::File', $config->{aliases}; |
77 | $tie->flock; |
78 | my @list_aliases = ($name, "${name}-request"); |
21baaef0 |
79 | |
9bfd7b60 |
80 | for my $list_alias (@list_aliases) { |
81 | if(grep { /^${list_alias}:/ } @aliases) { |
82 | croak "${list_alias} already in $config->{aliases}"; |
514dce63 |
83 | } |
9bfd7b60 |
84 | push @aliases, |
85 | qq(${list_alias}: "|$config->{bin_root}/pmg msg -c $config->{config_file}"\n); |
514dce63 |
86 | } |
21baaef0 |
87 | |
f5baca29 |
88 | $self->store($path->stringify); |
9bfd7b60 |
89 | } |
90 | |
91 | sub delete { |
92 | my ($self) = @_; |
93 | my $config = Promulger::Config->config; |
94 | my $name = $self->listname; |
95 | |
96 | my $tie = tie my @aliases, 'Tie::File', $config->{aliases}; |
97 | $tie->flock; |
98 | |
99 | my @list_aliases = ($name, "${name}-request"); |
100 | @aliases = grep { |
101 | $_ !~ /^$list_aliases[0]:/ && |
102 | $_ !~ /^$list_aliases[1]:/ |
103 | } @aliases; |
104 | |
105 | unlink find_path_for($self->listname); |
514dce63 |
106 | } |
107 | |
21baaef0 |
108 | sub find_path_for { |
109 | my ($proto) = @_; |
110 | my $path = file(Promulger::Config->config->{list_home}, $proto . ".list"); |
9bfd7b60 |
111 | return $path; |
21baaef0 |
112 | } |
113 | |
114 | 'http://mitpress.mit.edu/sicp/'; |