package Promulger::List;
-use Moose;
-use MooseX::Storage;
+use Moo;
use autodie ':all';
use Carp;
use Path::Class;
use Fcntl ':flock';
use Tie::File;
+use File::Slurp qw/read_file, write_file/;
+use Data::Dumper;
+$Data::Dumper::Purity = 1;
use Promulger::Config;
has listname => (
is => 'ro',
- isa => 'Str',
+ isa => sub { $_[0] =~ /^\w+$/ or die "listname must be a string" },
required => 1,
);
has active => (
is => 'rw',
- isa => 'Bool',
+ isa => sub { ($_[0] == 0 || $_[0] == 1) or die "active must be 0 or 1" },
required => 1,
- default => 1,
+ default => sub { 1 },
);
has subscribers => (
is => 'rw',
- isa => 'HashRef',
+ isa => sub { ref $_[0] eq 'HASH' or die "subscribers must be a hashref" },
required => 1,
default => sub { {} },
);
-with Storage (
- format => 'JSON',
- io => 'File',
-);
-
sub resolve {
my ($self, $proto) = @_;
$proto =~ s/-request$//;
sub subscribe {
my ($self, $new) = @_;
- return if $self->subscribers->at($new);
- $self->subscribers->put($new, 1);
- $self->store(find_path_for($self->name));
+ return if $self->subscribers->{$new};
+ $self->subscribers->{$new} = 1;
+ $self->store(find_path_for($self->listname)->stringify);
+ return 1;
}
sub unsubscribe {
my ($self, $ex) = @_;
- return unless $self->subscribers->at($ex);
- $self->subscribers->delete($ex);
- $self->store(find_path_for($self->name));
+ return unless exists $self->subscribers->{$ex};
+ delete $self->subscribers->{$ex};
+ $self->store(find_path_for($self->listname)->stringify);
+ return 1;
}
# XXX implement ACLs and other shinies -- apeiron, 2010-03-13
sub accept_posts_from {
my ($self, $sender) = @_;
- return grep { $sender eq $_ } @{$self->subscribers};
+ return grep { $sender eq $_ } keys %{$self->subscribers};
}
sub setup {
$_ !~ /^$list_aliases[1]:/
} @aliases;
- unlink find_path_for($self->listname);
+ unlink find_path_for($self->listname)->stringify;
}
sub find_path_for {
return $path;
}
+sub store {
+ my ($self, $path) = @_;
+ my $dumped = 'do { my '. Dumper($self) . '; $VAR1; }';
+ write_file($path, $dumped);
+}
+
+sub load {
+ my ($class, $path) = @_;
+ return do $path;
+}
+
'http://mitpress.mit.edu/sicp/';