File Coverage

blib/lib/Starch/Plugin/DisableStore.pm
Criterion Covered Total %
statement 14 14 100.0
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 19 19 100.0


line stmt bran cond sub pod time code
1             package Starch::Plugin::DisableStore;
2 1     1   498 use 5.008001;
  1         5  
3 1     1   7 use strictures 2;
  1         7  
  1         41  
4             our $VERSION = '0.11';
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   246 use Types::Standard -types;
  1         3  
  1         12  
30              
31 1     1   4800 use Moo::Role;
  1         3  
  1         8  
32 1     1   428 use namespace::clean;
  1         2  
  1         8  
33              
34             with qw(
35             Starch::Plugin::ForStore
36             );
37              
38             =head1 OPTIONAL STORE ARGUMENTS
39              
40             These arguments are added to classes which consume the
41             L role.
42              
43             =head2 disable_set
44              
45             Setting this to true makes the C method silently fail.
46              
47             =head2 disable_get
48              
49             Setting this to true makes the C method silently fail and
50             return undef.
51              
52             =head2 disable_remove
53              
54             Setting this to true makes the C method silently fail.
55              
56             =cut
57              
58             foreach my $method (qw( set get remove )) {
59             my $argument = "disable_$method";
60              
61             has $argument => (
62             is => 'ro',
63             isa => Bool,
64             );
65              
66             around $method => sub{
67             my $orig = shift;
68             my $self = shift;
69              
70             return $self->$orig( @_ ) if !$self->$argument();
71              
72             return undef if $method eq 'get';
73             return;
74             };
75             }
76              
77             around sub_store_args => sub{
78             my $orig = shift;
79             my $self = shift;
80              
81             my $args = $self->$orig( @_ );
82              
83             return {
84             disable_set => $self->disable_set(),
85             disable_get => $self->disable_get(),
86             disable_remove => $self->disable_remove(),
87             %$args,
88             };
89             };
90              
91             1;
92             __END__