File: Builder.pm

package info (click to toggle)
libcatmandu-perl 1.2024-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 3,552 kB
  • sloc: perl: 17,037; makefile: 24; sh: 1
file content (54 lines) | stat: -rw-r--r-- 1,068 bytes parent folder | download
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
package Catmandu::Fix::Condition::Builder;

use Catmandu::Sane;

our $VERSION = '1.2024';

use Clone qw(clone);
use Moo::Role;
use namespace::clean;

with 'Catmandu::Fix::Base';

has pass_fixes => (is => 'rw', default => sub {[]});
has fail_fixes => (is => 'rw', default => sub {[]});
has tester     => (is => 'lazy');

sub emit {
    my ($self, $fixer) = @_;
    my $sub_var = $fixer->capture($self->tester);
    $self->_emit_branch(
        $self->_emit_call($sub_var, $fixer->var),
        $fixer->emit_fixes($self->pass_fixes),
        $fixer->emit_fixes($self->fail_fixes),
    );
}

sub import {
    my $target = caller;
    my ($fix, %opts) = @_;

    if (my $sym = $opts{as}) {
        my $sub = sub {
            my $data = shift;
            if ($opts{clone}) {
                $data = clone($data);
            }
            $fix->new(@_)->tester->($data);
        };
        no strict 'refs';
        *{"${target}::$sym"} = $sub;
    }
}

1;

__END__

=pod

=head1 NAME

Catmandu::Fix::Condition::Builder - Helper role to easily write fix conditions

=cut