The Perl Toolchain Summit 2025 Needs You: You can help 🙏 Learn more

KARUPA / Aniki-1.06 / lib / Aniki / Filter.pm 

            

              
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
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169

              
package Aniki::Filter;
use 5.014002;
use namespace::autoclean;
use Mouse v2.4.5;
has global_inflators => (
    is      => 'ro',
    default => sub { [] },
);
has global_deflators => (
    is      => 'ro',
    default => sub { [] },
);
has global_triggers => (
    is      => 'ro',
    default => sub { +{} },
);
has table_inflators => (
    is      => 'ro',
    default => sub { +{} },
);
has table_deflators => (
    is      => 'ro',
    default => sub { +{} },
);
has table_triggers => (
    is      => 'ro',
    default => sub { +{} },
);
sub _identity { $_[0] }
sub _normalize_column2rx { ref $_[0] eq 'Regexp' ? $_[0] : qr/\A\Q$_[0]\E\z/m }
sub add_global_inflator {
    my ($self, $column, $code) = @_;
    my $rx = _normalize_column2rx($column);
    push @{ $self->global_inflators } => [$rx, $code];
}
sub add_global_deflator {
    my ($self, $column, $code) = @_;
    my $rx = _normalize_column2rx($column);
    push @{ $self->global_deflators } => [$rx, $code];
}
sub add_global_trigger {
    my ($self, $event, $code) = @_;
    push @{ $self->global_triggers->{$event} } => $code;
}
sub add_table_inflator {
    my ($self, $table_name, $column, $code) = @_;
    my $rx = _normalize_column2rx($column);
    push @{ $self->table_inflators->{$table_name} } => [$rx, $code];
}
sub add_table_deflator {
    my ($self, $table_name, $column, $code) = @_;
    my $rx = _normalize_column2rx($column);
    push @{ $self->table_deflators->{$table_name} } => [$rx, $code];
}
sub add_table_trigger {
    my ($self, $table_name, $event, $code) = @_;
    push @{ $self->table_triggers->{$table_name}->{$event} } => $code;
}
sub inflate_column {
    my ($self, $table_name, $column, $data) = @_;
    my $code = $self->get_inflate_callback($table_name, $column);
    return $data unless defined $code;
    return $code->($data);
}
sub deflate_column {
    my ($self, $table_name, $column, $data) = @_;
    my $code = $self->get_deflate_callback($table_name, $column);
    return $data unless defined $code;
    return $code->($data);
}
sub inflate_row {
    my ($self, $table_name, $row) = @_;
    my %row = %$row;
    for my $column (keys %row) {
        $row{$column} = $self->inflate_column($table_name, $column, $row{$column});
    }
    return \%row;
}
sub deflate_row {
    my ($self, $table_name, $row) = @_;
    my %row = %$row;
    for my $column (keys %row) {
        $row{$column} = $self->deflate_column($table_name, $column, $row{$column});
    }
    return \%row;
}
sub apply_trigger {
    my ($self, $event, $table_name, $row) = @_;
    my %row = %$row;
    my $trigger = $self->get_trigger_callback($event, $table_name);
    return $trigger->(\%row);
}
sub get_inflate_callback {
    my ($self, $table_name, $column) = @_;
    unless (exists $self->{__inflate_callbacks_cache}->{$table_name}->{$column}) {
        my $callback;
        for my $pair (@{ $self->global_inflators }) {
            my ($rx, $code) = @$pair;
            $callback = $code if $column =~ $rx;
        }
        for my $pair (@{ $self->table_inflators->{$table_name} }) {
            my ($rx, $code) = @$pair;
            $callback = $code if $column =~ $rx;
        }
        $self->{__inflate_callbacks_cache}->{$table_name}->{$column} = $callback;
    }
    return $self->{__inflate_callbacks_cache}->{$table_name}->{$column};
}
sub get_deflate_callback {
    my ($self, $table_name, $column) = @_;
    unless (exists $self->{__deflate_callbacks_cache}->{$table_name}->{$column}) {
        my $callback;
        for my $pair (@{ $self->global_deflators }) {
            my ($rx, $code) = @$pair;
            $callback = $code if $column =~ $rx;
        }
        for my $pair (@{ $self->table_deflators->{$table_name} }) {
            my ($rx, $code) = @$pair;
            $callback = $code if $column =~ $rx;
        }
        $self->{__deflate_callbacks_cache}->{$table_name}->{$column} = $callback;
    }
    return $self->{__deflate_callbacks_cache}->{$table_name}->{$column};
}
sub get_trigger_callback {
    my ($self, $event, $table_name) = @_;
    unless (exists $self->{__trigger_callback_cache}->{$table_name}->{$event}) {
        my @triggers = (
            @{ $self->table_triggers->{$table_name}->{$event} || [] },
            @{ $self->global_triggers->{$event} || [] },
        );
        my $trigger = \&_identity;
        for my $cb (reverse @triggers) {
            my $next = $trigger;
            $trigger = sub { $cb->($_[0], $next) };
        }
        $self->{__trigger_callback_cache}->{$table_name}->{$event} = $trigger;
    }
    return $self->{__trigger_callback_cache}->{$table_name}->{$event};
}
__PACKAGE__->meta->make_immutable();
__END__