File Coverage

blib/lib/Catmandu/Plugin/Readonly.pm
Criterion Covered Total %
statement 18 19 94.7
branch 3 6 50.0
condition n/a
subroutine 5 5 100.0
pod 0 1 0.0
total 26 31 83.8


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