59
59
60
60
$rel_attrs -> {alias } ||= $f_rel ;
61
61
62
+
62
63
my $rs_meth_name = join ' ::' , $class , $rs_meth ;
63
64
*$rs_meth_name = subname $rs_meth_name , sub {
64
- my $self = shift ;
65
- my $attrs = @_ > 1 && ref $_ [$#_ ] eq ' HASH' ? pop (@_ ) : {};
66
- my $rs = $self -> search_related($rel )-> search_related(
67
- $f_rel , @_ > 0 ? @_ : undef , { %{$rel_attrs ||{}}, %$attrs }
68
- );
69
- return $rs ;
65
+
66
+ # this little horror is there replicating a deprecation from
67
+ # within search_rs() itself
68
+ shift -> search_related_rs($rel )
69
+ -> search_related_rs(
70
+ $f_rel ,
71
+ undef ,
72
+ ( @_ > 1 and ref $_ [-1] eq ' HASH' )
73
+ ? { %$rel_attrs , %{ pop @_ } }
74
+ : $rel_attrs
75
+ )-> search_rs(@_ )
76
+ ;
77
+
70
78
};
71
79
80
+
72
81
my $meth_name = join ' ::' , $class , $meth ;
73
82
*$meth_name = subname $meth_name , sub {
83
+
74
84
DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_WANTARRAY and my $sog = fail_on_internal_wantarray;
75
- my $self = shift ;
76
- my $rs = $self -> $rs_meth ( @_ );
77
- return (wantarray ? $rs -> all : $rs );
85
+
86
+ my $rs = shift -> $rs_meth ( @_ );
87
+
88
+ wantarray ? $rs -> all : $rs ;
89
+
78
90
};
79
91
92
+
80
93
my $add_meth_name = join ' ::' , $class , $add_meth ;
81
94
*$add_meth_name = subname $add_meth_name , sub {
82
- my $self = shift ;
83
- @_ or $self -> throw_exception(
84
- " ${add_meth} needs an object or hashref"
85
- );
86
95
87
- my $link = $self -> new_related( $rel ,
88
- ( @_ > 1 && ref $_ [-1] eq ' HASH' )
89
- ? pop
90
- : {}
96
+ ( @_ >= 2 and @_ <= 3 ) or $_ [0]-> throw_exception(
97
+ " '$add_meth ' expects an object or hashref to link to, and an optional hashref of link data"
91
98
);
92
99
93
- my $far_obj = defined blessed $_ [0]
94
- ? $_ [0]
95
- : $self -> result_source
96
- -> related_source( $rel )
97
- -> related_source( $f_rel )
98
- -> resultset-> search_rs( {}, $rel_attrs ||{} )
99
- -> find_or_create( ref $_ [0] eq ' HASH' ? $_ [0] : {@_ } )
100
- ;
100
+ $_ [0]-> throw_exception(
101
+ " The optional link data supplied to '$add_meth ' is not a hashref (it was previously ignored)"
102
+ ) if $_ [2] and ref $_ [2] ne ' HASH' ;
101
103
102
- $link -> set_from_related($f_rel , $far_obj );
104
+ my ( $self , $far_obj ) = @_ ;
105
+
106
+ my $guard ;
107
+
108
+ # the API needs is always expected to return the far object, possibly
109
+ # creating it in the process
110
+ if ( not defined blessed $far_obj ) {
111
+
112
+ $guard = $self -> result_source-> schema-> storage-> txn_scope_guard;
113
+
114
+ # reify the hash into an actual object
115
+ $far_obj = $self -> result_source
116
+ -> related_source( $rel )
117
+ -> related_source( $f_rel )
118
+ -> resultset
119
+ -> search_rs( undef , $rel_attrs )
120
+ -> find_or_create( $far_obj );
121
+ }
122
+
123
+ my $link = $self -> new_related(
124
+ $rel ,
125
+ $_ [2] || {},
126
+ );
127
+
128
+ $link -> set_from_related( $f_rel , $far_obj );
103
129
104
130
$link -> insert();
105
131
106
- return $far_obj ;
132
+ $guard -> commit if $guard ;
133
+
134
+ $far_obj ;
107
135
};
108
136
137
+
109
138
my $set_meth_name = join ' ::' , $class , $set_meth ;
110
139
*$set_meth_name = subname $set_meth_name , sub {
111
140
@@ -132,37 +161,43 @@ EOW
132
161
( @_ and ref $_ [0] ne ' HASH' )
133
162
);
134
163
135
- my $guard = $self -> result_source-> schema-> storage-> txn_scope_guard;
164
+ my $guard ;
165
+
166
+ # there will only be a single delete() op, unless we have what to set to
167
+ $guard = $self -> result_source-> schema-> storage-> txn_scope_guard
168
+ if @$set_to ;
136
169
137
170
# if there is a where clause in the attributes, ensure we only delete
138
171
# rows that are within the where restriction
172
+ $self -> search_related(
173
+ $rel ,
174
+ ( $rel_attrs -> {where }
175
+ ? ( $rel_attrs -> {where }, { join => $f_rel } )
176
+ : ()
177
+ )
178
+ )-> delete ;
139
179
140
- if ($rel_attrs && $rel_attrs -> {where }) {
141
- $self -> search_related( $rel , $rel_attrs -> {where },{join => $f_rel })-> delete ;
142
- } else {
143
- $self -> search_related( $rel , {} )-> delete ;
144
- }
145
180
# add in the set rel objects
146
181
$self -> $add_meth (
147
182
$_ ,
148
183
@_ , # at this point @_ is either empty or contains a lone link-data hash
149
184
) for @$set_to ;
150
185
151
- $guard -> commit;
186
+ $guard -> commit if $guard ;
152
187
};
153
188
189
+
154
190
my $remove_meth_name = join ' ::' , $class , $remove_meth ;
155
191
*$remove_meth_name = subname $remove_meth_name , sub {
156
- my ($self , $obj ) = @_ ;
157
192
158
- $self -> throw_exception(" ${ remove_meth} needs an object" )
159
- unless blessed ( $obj ) ;
193
+ $_ [0] -> throw_exception(" ' $ remove_meth' expects an object" )
194
+ unless defined blessed $_ [1] ;
160
195
161
- $self -> search_related_rs($rel )-> search_rs(
162
- $obj -> ident_condition( $f_rel ),
163
- { join => $f_rel },
164
- )-> delete ;
196
+ $_ [0]-> search_related_rs( $rel )
197
+ -> search_rs( $_ [1]-> ident_condition( $f_rel ), { join => $f_rel } )
198
+ -> delete ;
165
199
};
200
+
166
201
}
167
202
}
168
203
0 commit comments