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
|
package Reaction::InterfaceModel::Action::DBIC::Role::CheckUniques;
use Reaction::Role;
role CheckUniques which {
# requires qw(target_model
# parameter_hashref
# parameter_attributes
# );
has _unique_constraint_results =>
(
isa => 'HashRef',
is => 'rw',
required => 1,
default => sub { {} },
metaclass => 'Reaction::Meta::Attribute'
);
implements check_all_uniques => as {
my ($self) = @_;
my $source = $self->target_model->result_source;
my %uniques = $source->unique_constraints;
my $proto = ($self->target_model->isa('DBIx::Class::ResultSet')
? $self->target_model->new_result({})
: $self->target_model);
my $param_hr = $self->parameter_hashref;
my %proto_hash = (
map {
my @ret;
my $attr = $proto->meta->get_attribute($_->name);
if ($attr) {
my $reader = $attr->get_read_method;
if ($reader) {
my $value = $proto->$reader;
if (defined($value)) {
@ret = ($_->name => $value);
}
}
}
@ret;
} $self->parameter_attributes
);
my %merged = (
%proto_hash,
(map {
(defined $param_hr->{$_} ? ($_ => $param_hr->{$_}) : ());
} keys %$param_hr),
);
my %ident = %{$proto->ident_condition};
my %clashes;
my $rs = $source->resultset;
foreach my $unique (keys %uniques) {
my %pass;
my @attrs = @{$uniques{$unique}};
next if grep { !exists $merged{$_} } @attrs;
# skip PK before insertion if auto-inc etc. etc.
@pass{@attrs} = @merged{@attrs};
if (my $obj = $rs->find(\%pass, { key => $unique })) {
my $found_ident = $obj->ident_condition;
#warn join(', ', %$found_ident, %ident);
if (!$proto->in_storage
|| (grep { $found_ident->{$_} ne $ident{$_} } keys %ident)) {
# if in storage and no ident conditions are different the found
# obj is *us* :)
$clashes{$_} = 1 for @attrs;
}
}
}
$self->_unique_constraint_results(\%clashes);
};
after sync_all => sub { shift->check_all_uniques; };
override error_for_attribute => sub {
my ($self, $attr) = @_;
if ($self->_unique_constraint_results->{$attr->name}) {
return "Already taken, please try an alternative";
}
return super();
};
override can_apply => sub {
my ($self) = @_;
return 0 if keys %{$self->_unique_constraint_results};
return super();
};
};
1;
=head1 NAME
Reaction::InterfaceModel::Action::DBIC::Role::CheckUniques
=head1 DESCRIPTION
=head2 check_all_uniques
=head2 error_for_attribute
=head2 meta
=head1 AUTHORS
See L<Reaction::Class> for authors.
=head1 LICENSE
See L<Reaction::Class> for the license.
=cut
|
