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
84
85
86
87
88
89
90
91
92
|
package Catmandu::Plugin::Readonly;
our $VERSION = '1.2012';
use Moo::Role;
use MooX::Aliases;
use Package::Stash;
use namespace::clean;
sub BUILD {
my ($self) = @_;
my $name = ref($self->store);
if ($self->store->does('Catmandu::Droppable')) {
# Overwrite the drop method of the Catmandu::Store implementation
my $stash = Package::Stash->new($name);
$stash->add_symbol(
'&drop' => sub {
$self->log->warn("trying to drop a readonly store");
my $err = Catmandu::NotImplemented->new("$name is readonly");
return undef, $err;
}
);
}
}
around add => sub {
my ($orig, $self, $data) = @_;
my $name = ref($self);
$self->log->warn("trying to add to readonly store");
my $err = Catmandu::NotImplemented->new("$name is readonly");
return undef, $err;
};
around delete => sub {
my ($orig, $self) = @_;
my $name = ref($self);
$self->log->warn("trying to delete from readonly store");
my $err = Catmandu::NotImplemented->new("$name is readonly");
return undef, $err;
};
around delete_all => sub {
my ($orig, $self) = @_;
my $name = ref($self);
$self->log->warn("trying to delete_all on readonly store");
my $err = Catmandu::NotImplemented->new("$name is readonly");
return undef, $err;
};
around drop => sub {
my ($orig, $self) = @_;
my $name = ref($self);
$self->log->warn("trying to drop a readonly store");
my $err = Catmandu::NotImplemented->new("$name 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
|
