File Coverage

blib/lib/Starch/Plugin/DisableStore.pm
Criterion Covered Total %
statement 12 12 100.0
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 16 16 100.0


line stmt bran cond sub pod time code
1             package Starch::Plugin::DisableStore;
2             our $VERSION = '0.14';
3              
4             =encoding utf8
5              
6             =head1 NAME
7              
8             Starch::Plugin::DisableStore - Disable store read and/or write operations.
9              
10             =head1 SYNOPSIS
11              
12             my $starch = Starch->new(
13             plugins => ['::DisableStore'],
14             store => {
15             class => ...,
16             disable_set => 1,
17             },
18             );
19              
20             =head1 DESCRIPTION
21              
22             This plugin provides the ability to make stores silently fail
23             read and write operations. This can be useful for migrating
24             from one store to another where it doesn't make sense to write
25             to the old store, only read.
26              
27             =cut
28              
29 1     1   470 use Types::Standard -types;
  1         1  
  1         15  
30              
31 1     1   3739 use Moo::Role;
  1         2  
  1         8  
32 1     1   410 use strictures 2;
  1         8  
  1         37  
33 1     1   186 use namespace::clean;
  1         1  
  1         8  
34              
35             with 'Starch::Plugin::ForStore';
36              
37             =head1 OPTIONAL STORE ARGUMENTS
38              
39             These arguments are added to classes which consume the
40             L role.
41              
42             =head2 disable_set
43              
44             Setting this to true makes the C method silently fail.
45              
46             =head2 disable_get
47              
48             Setting this to true makes the C method silently fail and
49             return undef.
50              
51             =head2 disable_remove
52              
53             Setting this to true makes the C method silently fail.
54              
55             =cut
56              
57             foreach my $method (qw( set get remove )) {
58             my $argument = "disable_$method";
59              
60             has $argument => (
61             is => 'ro',
62             isa => Bool,
63             );
64              
65             around $method => sub{
66             my $orig = shift;
67             my $self = shift;
68              
69             return $self->$orig( @_ ) if !$self->$argument();
70              
71             return undef if $method eq 'get';
72             return;
73             };
74             }
75              
76             around sub_store_args => sub{
77             my $orig = shift;
78             my $self = shift;
79              
80             my $args = $self->$orig( @_ );
81              
82             return {
83             disable_set => $self->disable_set(),
84             disable_get => $self->disable_get(),
85             disable_remove => $self->disable_remove(),
86             %$args,
87             };
88             };
89              
90             1;
91             __END__