This file is indexed.

/usr/share/perl5/Catmandu/Plugin/Readonly.pm is in libcatmandu-perl 1.0700-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  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
 93
 94
 95
 96
 97
 98
 99
100
package Catmandu::Plugin::Readonly;

our $VERSION = '1.07';

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: File::Simple
    options:
      default_plugins: [ 'Readonly']
      root: t/data

 # This will  fail, no files can be added to the 'test' store
 $ catmandu stream myfile.txt to test --bag 1 -id myfile.txt

 # This command will succeed only if the 'test' database contains
 # the 'sample.txt' file
 # catmandu stream test --bag 3 --id sample.txt

=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> and L<Catmandu::FileStore>
implementations.

=head1 SEE ALSO

L<Catmandu::Store>, L<Catmandu::Bag>

=cut