/usr/share/perl5/Catmandu/Addable.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 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 | package Catmandu::Addable;
use Catmandu::Sane;
our $VERSION = '1.07';
use Catmandu::Util qw(:is :check);
use Moo::Role;
use namespace::clean;
with 'Catmandu::Fixable';
requires 'add';
has autocommit => (is => 'ro', default => sub {0});
has _commit => (is => 'rw', default => sub {0});
around add => sub {
my ($orig, $self, $data) = @_;
return unless defined $data;
$data = $self->_fixer->fix($data) if $self->_fixer;
$orig->($self, $data) if defined $data;
$data;
};
around commit => sub {
my ($orig, $self) = @_;
my (@res) = $orig->($self);
$self->_commit(1);
@res;
};
sub add_many {
my ($self, $many) = @_;
if (is_hash_ref($many)) {
$self->add($many);
return 1;
}
if (is_array_ref($many)) {
$self->add($_) for @$many;
return scalar @$many;
}
if (is_invocant($many)) {
$many = check_able($many, 'generator')->generator;
}
check_code_ref($many);
my $data;
my $n = 0;
while (defined($data = $many->())) {
$self->add($data);
$n++;
}
$n;
}
sub commit { }
sub DESTROY {
my ($self) = shift;
$self->commit if $self->autocommit && !$self->_commit;
}
1;
__END__
=pod
=head1 NAME
Catmandu::Addable - Base class for all Catmandu modules need to implement add
=head1 SYNOPSIS
package My::Adder;
use Moo;
use Data::Dumper;
with 'Catmandu::Addable';
sub add {
my ($self,$object) = @_;
print "So you want to add:\n";
print Dumper($object);
1;
}
sub commit {
my $self = shift;
print "And now you are done?\n";
}
package main;
my $adder = My::Adder->new(fix => ['upcase(foo)']);
# prints foo => BAR
$adder->add({ foo => 'bar' });
# prints:
# foo => BAR
# foo => BAR
$adder->add_many([ { foo => 'bar' } , { foo => 'bar' }]);
# prints a commit statement
$adder->commit;
=head1 OPTIONS
=over
=item autocommit
Autocommit when the exporter gets out of scope. Default 0.
=back
=head1 METHODS
=head2 add($hash)
Receives a Perl hash and should return true or false.
=head2 commit
This method is usually called at the end of many add or add_many operations.
=head1 INHERIT
If you provide an 'add' method, then automatically your package gets a add_many
method, plus a fix attribute which transforms all Perl hashes provided to the
add method.
=head1 SEE ALSO
L<Catmandu::Fixable>, L<Catmandu::Exporter> , L<Catmandu::Store>
=cut
|