1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
package Catmandu::Plugin::Readonly;
our $VERSION = '1.2024';
use Moo::Role;
use MooX::Aliases;
use Package::Stash;
use namespace::clean;
sub BUILD {
my ($self) = @_;
if ($self->store->does('Catmandu::Droppable')) {
Role::Tiny->apply_roles_to_object($self->store,
qw(Catmandu::Plugin::Readonly::Droppable));
}
if ($self->does('Catmandu::Droppable')) {
Role::Tiny->apply_roles_to_object($self,
qw(Catmandu::Plugin::Readonly::Droppable));
}
if ($self->does('Catmandu::Searchable')) {
Role::Tiny->apply_roles_to_object($self,
qw(Catmandu::Plugin::Readonly::Searchable));
}
}
around add => sub {
my ($orig, $self, $data) = @_;
my $pkg = ref($self);
$self->log->warn("trying to add to readonly store");
my $err = Catmandu::NotImplemented->new("$pkg is readonly");
return undef, $err;
};
around delete => sub {
my ($orig, $self) = @_;
my $pkg = ref($self);
$self->log->warn("trying to delete from readonly store");
my $err = Catmandu::NotImplemented->new("$pkg is readonly");
return undef, $err;
};
around delete_all => sub {
my ($orig, $self) = @_;
my $pkg = ref($self);
$self->log->warn("trying to delete_all on readonly store");
my $err = Catmandu::NotImplemented->new("$pkg is readonly");
return undef, $err;
};
1;
__END__
=pod
=head1 NAME
Catmandu::Plugin::Readonly - Make stores or bags read-only
=head1 SYNOPSIS
$ cat catmandu.yml
---
store:
test:
package: MongoDB
options:
default_plugins: [ 'Readonly']
=head1 DESCRIPTION
The Catmandu::Plugin::Readonly will transform a Catmandu::Store or a Catmandu::Bag
in read-only mode: all writes, deletes and drops will be ignored.
This command will work on L<Catmandu::Store>
implementations.
=head1 SEE ALSO
L<Catmandu::Store>, L<Catmandu::Bag>
=cut
|
