]>
Commit | Line | Data |
---|---|---|
84fb5b46 MKG |
1 | # BEGIN BPS TAGGED BLOCK {{{ |
2 | # | |
3 | # COPYRIGHT: | |
4 | # | |
3ffc5f4f | 5 | # This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC |
84fb5b46 MKG |
6 | # <sales@bestpractical.com> |
7 | # | |
8 | # (Except where explicitly superseded by other copyright notices) | |
9 | # | |
10 | # | |
11 | # LICENSE: | |
12 | # | |
13 | # This work is made available to you under the terms of Version 2 of | |
14 | # the GNU General Public License. A copy of that license should have | |
15 | # been provided with this software, but in any event can be snarfed | |
16 | # from www.gnu.org. | |
17 | # | |
18 | # This work is distributed in the hope that it will be useful, but | |
19 | # WITHOUT ANY WARRANTY; without even the implied warranty of | |
20 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
21 | # General Public License for more details. | |
22 | # | |
23 | # You should have received a copy of the GNU General Public License | |
24 | # along with this program; if not, write to the Free Software | |
25 | # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA | |
26 | # 02110-1301 or visit their web page on the internet at | |
27 | # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. | |
28 | # | |
29 | # | |
30 | # CONTRIBUTION SUBMISSION POLICY: | |
31 | # | |
32 | # (The following paragraph is not intended to limit the rights granted | |
33 | # to you to modify and distribute this software under the terms of | |
34 | # the GNU General Public License and is only of importance to you if | |
35 | # you choose to contribute your changes and enhancements to the | |
36 | # community by submitting them to Best Practical Solutions, LLC.) | |
37 | # | |
38 | # By intentionally submitting any modifications, corrections or | |
39 | # derivatives to this work, or any other work intended for use with | |
40 | # Request Tracker, to Best Practical Solutions, LLC, you confirm that | |
41 | # you are the copyright holder for those contributions and you grant | |
42 | # Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, | |
43 | # royalty-free, perpetual, license to use, copy, create derivative | |
44 | # works based on those contributions, and sublicense and distribute | |
45 | # those contributions and any derivatives thereof. | |
46 | # | |
47 | # END BPS TAGGED BLOCK }}} | |
48 | ||
49 | =head1 NAME | |
50 | ||
51 | RT::Record - Base class for RT record objects | |
52 | ||
53 | =head1 SYNOPSIS | |
54 | ||
55 | ||
56 | =head1 DESCRIPTION | |
57 | ||
58 | ||
59 | ||
60 | =head1 METHODS | |
61 | ||
62 | =cut | |
63 | ||
64 | package RT::Record; | |
65 | ||
66 | use strict; | |
67 | use warnings; | |
68 | ||
3ffc5f4f MKG |
69 | use RT; |
70 | use base RT->Config->Get('RecordBaseClass'); | |
71 | use base 'RT::Base'; | |
84fb5b46 | 72 | |
3ffc5f4f MKG |
73 | require RT::Date; |
74 | require RT::User; | |
75 | require RT::Attributes; | |
76 | require RT::Transactions; | |
77 | require RT::Link; | |
84fb5b46 MKG |
78 | |
79 | our $_TABLE_ATTR = { }; | |
84fb5b46 MKG |
80 | |
81 | ||
82 | sub _Init { | |
83 | my $self = shift; | |
84 | $self->_BuildTableAttributes unless ($_TABLE_ATTR->{ref($self)}); | |
85 | $self->CurrentUser(@_); | |
86 | } | |
87 | ||
88 | ||
89 | ||
90 | =head2 _PrimaryKeys | |
91 | ||
92 | The primary keys for RT classes is 'id' | |
93 | ||
94 | =cut | |
95 | ||
96 | sub _PrimaryKeys { return ['id'] } | |
97 | # short circuit many, many thousands of calls from searchbuilder | |
98 | sub _PrimaryKey { 'id' } | |
99 | ||
100 | =head2 Id | |
101 | ||
102 | Override L<DBIx::SearchBuilder/Id> to avoid a few lookups RT doesn't do | |
103 | on a very common codepath | |
104 | ||
105 | C<id> is an alias to C<Id> and is the preferred way to call this method. | |
106 | ||
107 | =cut | |
108 | ||
109 | sub Id { | |
110 | return shift->{'values'}->{id}; | |
111 | } | |
112 | ||
113 | *id = \&Id; | |
114 | ||
115 | =head2 Delete | |
116 | ||
117 | Delete this record object from the database. | |
118 | ||
119 | =cut | |
120 | ||
121 | sub Delete { | |
122 | my $self = shift; | |
123 | my ($rv) = $self->SUPER::Delete; | |
124 | if ($rv) { | |
125 | return ($rv, $self->loc("Object deleted")); | |
126 | } else { | |
127 | ||
128 | return(0, $self->loc("Object could not be deleted")) | |
129 | } | |
130 | } | |
131 | ||
3ffc5f4f | 132 | =head2 RecordType |
84fb5b46 | 133 | |
3ffc5f4f MKG |
134 | Returns a string which is this record's type. It's not localized and by |
135 | default last part (everything after last ::) of class name is returned. | |
84fb5b46 | 136 | |
3ffc5f4f MKG |
137 | =cut |
138 | ||
139 | sub RecordType { | |
140 | my $res = ref($_[0]) || $_[0]; | |
141 | $res =~ s/.*:://; | |
142 | return $res; | |
143 | } | |
144 | ||
145 | =head2 ObjectTypeStr | |
146 | ||
147 | DEPRECATED. Stays here for backwards. Returns localized L</RecordType>. | |
84fb5b46 MKG |
148 | |
149 | =cut | |
150 | ||
3ffc5f4f MKG |
151 | # we deprecate because of: |
152 | # * ObjectType is used in several classes with ObjectId to store | |
153 | # records of different types, for example transactions use those | |
154 | # and it's unclear what this method should return 'Transaction' | |
155 | # or type of referenced record | |
156 | # * returning localized thing is not good idea | |
157 | ||
84fb5b46 MKG |
158 | sub ObjectTypeStr { |
159 | my $self = shift; | |
3ffc5f4f MKG |
160 | RT->Deprecated( |
161 | Remove => "4.4", | |
162 | Instead => "RecordType", | |
163 | ); | |
164 | return $self->loc( $self->RecordType( @_ ) ); | |
84fb5b46 MKG |
165 | } |
166 | ||
167 | =head2 Attributes | |
168 | ||
169 | Return this object's attributes as an RT::Attributes object | |
170 | ||
171 | =cut | |
172 | ||
173 | sub Attributes { | |
174 | my $self = shift; | |
175 | unless ($self->{'attributes'}) { | |
176 | $self->{'attributes'} = RT::Attributes->new($self->CurrentUser); | |
177 | $self->{'attributes'}->LimitToObject($self); | |
178 | $self->{'attributes'}->OrderByCols({FIELD => 'id'}); | |
179 | } | |
180 | return ($self->{'attributes'}); | |
181 | } | |
182 | ||
183 | ||
184 | =head2 AddAttribute { Name, Description, Content } | |
185 | ||
186 | Adds a new attribute for this object. | |
187 | ||
188 | =cut | |
189 | ||
190 | sub AddAttribute { | |
191 | my $self = shift; | |
192 | my %args = ( Name => undef, | |
193 | Description => undef, | |
194 | Content => undef, | |
195 | @_ ); | |
196 | ||
197 | my $attr = RT::Attribute->new( $self->CurrentUser ); | |
198 | my ( $id, $msg ) = $attr->Create( | |
199 | Object => $self, | |
200 | Name => $args{'Name'}, | |
201 | Description => $args{'Description'}, | |
202 | Content => $args{'Content'} ); | |
203 | ||
204 | ||
205 | # XXX TODO: Why won't RedoSearch work here? | |
206 | $self->Attributes->_DoSearch; | |
207 | ||
208 | return ($id, $msg); | |
209 | } | |
210 | ||
211 | ||
212 | =head2 SetAttribute { Name, Description, Content } | |
213 | ||
214 | Like AddAttribute, but replaces all existing attributes with the same Name. | |
215 | ||
216 | =cut | |
217 | ||
218 | sub SetAttribute { | |
219 | my $self = shift; | |
220 | my %args = ( Name => undef, | |
221 | Description => undef, | |
222 | Content => undef, | |
223 | @_ ); | |
224 | ||
225 | my @AttributeObjs = $self->Attributes->Named( $args{'Name'} ) | |
226 | or return $self->AddAttribute( %args ); | |
227 | ||
228 | my $AttributeObj = pop( @AttributeObjs ); | |
229 | $_->Delete foreach @AttributeObjs; | |
230 | ||
231 | $AttributeObj->SetDescription( $args{'Description'} ); | |
232 | $AttributeObj->SetContent( $args{'Content'} ); | |
233 | ||
234 | $self->Attributes->RedoSearch; | |
235 | return 1; | |
236 | } | |
237 | ||
238 | =head2 DeleteAttribute NAME | |
239 | ||
240 | Deletes all attributes with the matching name for this object. | |
241 | ||
242 | =cut | |
243 | ||
244 | sub DeleteAttribute { | |
245 | my $self = shift; | |
246 | my $name = shift; | |
247 | my ($val,$msg) = $self->Attributes->DeleteEntry( Name => $name ); | |
248 | $self->ClearAttributes; | |
249 | return ($val,$msg); | |
250 | } | |
251 | ||
252 | =head2 FirstAttribute NAME | |
253 | ||
254 | Returns the first attribute with the matching name for this object (as an | |
255 | L<RT::Attribute> object), or C<undef> if no such attributes exist. | |
256 | If there is more than one attribute with the matching name on the | |
257 | object, the first value that was set is returned. | |
258 | ||
259 | =cut | |
260 | ||
261 | sub FirstAttribute { | |
262 | my $self = shift; | |
263 | my $name = shift; | |
264 | return ($self->Attributes->Named( $name ))[0]; | |
265 | } | |
266 | ||
267 | ||
268 | sub ClearAttributes { | |
269 | my $self = shift; | |
270 | delete $self->{'attributes'}; | |
271 | ||
272 | } | |
273 | ||
274 | sub _Handle { return $RT::Handle } | |
275 | ||
276 | ||
277 | ||
278 | =head2 Create PARAMHASH | |
279 | ||
280 | Takes a PARAMHASH of Column -> Value pairs. | |
281 | If any Column has a Validate$PARAMNAME subroutine defined and the | |
282 | value provided doesn't pass validation, this routine returns | |
283 | an error. | |
284 | ||
285 | If this object's table has any of the following atetributes defined as | |
286 | 'Auto', this routine will automatically fill in their values. | |
287 | ||
288 | =over | |
289 | ||
290 | =item Created | |
291 | ||
292 | =item Creator | |
293 | ||
294 | =item LastUpdated | |
295 | ||
296 | =item LastUpdatedBy | |
297 | ||
298 | =back | |
299 | ||
300 | =cut | |
301 | ||
302 | sub Create { | |
303 | my $self = shift; | |
304 | my %attribs = (@_); | |
305 | foreach my $key ( keys %attribs ) { | |
306 | if (my $method = $self->can("Validate$key")) { | |
307 | if (! $method->( $self, $attribs{$key} ) ) { | |
308 | if (wantarray) { | |
309 | return ( 0, $self->loc('Invalid value for [_1]', $key) ); | |
310 | } | |
311 | else { | |
312 | return (0); | |
313 | } | |
314 | } | |
315 | } | |
316 | } | |
317 | ||
318 | ||
319 | ||
320 | my ($sec,$min,$hour,$mday,$mon,$year,$wday,$ydaym,$isdst,$offset) = gmtime(); | |
321 | ||
322 | my $now_iso = | |
323 | sprintf("%04d-%02d-%02d %02d:%02d:%02d", ($year+1900), ($mon+1), $mday, $hour, $min, $sec); | |
324 | ||
325 | $attribs{'Created'} = $now_iso if ( $self->_Accessible( 'Created', 'auto' ) && !$attribs{'Created'}); | |
326 | ||
327 | if ($self->_Accessible( 'Creator', 'auto' ) && !$attribs{'Creator'}) { | |
328 | $attribs{'Creator'} = $self->CurrentUser->id || '0'; | |
329 | } | |
330 | $attribs{'LastUpdated'} = $now_iso | |
331 | if ( $self->_Accessible( 'LastUpdated', 'auto' ) && !$attribs{'LastUpdated'}); | |
332 | ||
333 | $attribs{'LastUpdatedBy'} = $self->CurrentUser->id || '0' | |
334 | if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) && !$attribs{'LastUpdatedBy'}); | |
335 | ||
336 | my $id = $self->SUPER::Create(%attribs); | |
337 | if ( UNIVERSAL::isa( $id, 'Class::ReturnValue' ) ) { | |
338 | if ( $id->errno ) { | |
339 | if (wantarray) { | |
340 | return ( 0, | |
341 | $self->loc( "Internal Error: [_1]", $id->{error_message} ) ); | |
342 | } | |
343 | else { | |
344 | return (0); | |
345 | } | |
346 | } | |
347 | } | |
348 | # If the object was created in the database, | |
349 | # load it up now, so we're sure we get what the database | |
350 | # has. Arguably, this should not be necessary, but there | |
351 | # isn't much we can do about it. | |
352 | ||
353 | unless ($id) { | |
354 | if (wantarray) { | |
355 | return ( $id, $self->loc('Object could not be created') ); | |
356 | } | |
357 | else { | |
358 | return ($id); | |
359 | } | |
360 | ||
361 | } | |
362 | ||
363 | if (UNIVERSAL::isa('errno',$id)) { | |
364 | return(undef); | |
365 | } | |
366 | ||
367 | $self->Load($id) if ($id); | |
368 | ||
369 | ||
370 | ||
371 | if (wantarray) { | |
372 | return ( $id, $self->loc('Object created') ); | |
373 | } | |
374 | else { | |
375 | return ($id); | |
376 | } | |
377 | ||
378 | } | |
379 | ||
380 | ||
381 | ||
382 | =head2 LoadByCols | |
383 | ||
384 | Override DBIx::SearchBuilder::LoadByCols to do case-insensitive loads if the | |
385 | DB is case sensitive | |
386 | ||
387 | =cut | |
388 | ||
389 | sub LoadByCols { | |
390 | my $self = shift; | |
391 | ||
392 | # We don't want to hang onto this | |
393 | $self->ClearAttributes; | |
394 | ||
3ffc5f4f MKG |
395 | unless ( $self->_Handle->CaseSensitive ) { |
396 | my ( $ret, $msg ) = $self->SUPER::LoadByCols( @_ ); | |
397 | return wantarray ? ( $ret, $msg ) : $ret; | |
398 | } | |
84fb5b46 MKG |
399 | |
400 | # If this database is case sensitive we need to uncase objects for | |
401 | # explicit loading | |
402 | my %hash = (@_); | |
403 | foreach my $key ( keys %hash ) { | |
404 | ||
405 | # If we've been passed an empty value, we can't do the lookup. | |
406 | # We don't need to explicitly downcase integers or an id. | |
407 | if ( $key ne 'id' && defined $hash{ $key } && $hash{ $key } !~ /^\d+$/ ) { | |
408 | my ($op, $val, $func); | |
409 | ($key, $op, $val, $func) = | |
410 | $self->_Handle->_MakeClauseCaseInsensitive( $key, '=', delete $hash{ $key } ); | |
411 | $hash{$key}->{operator} = $op; | |
412 | $hash{$key}->{value} = $val; | |
413 | $hash{$key}->{function} = $func; | |
414 | } | |
415 | } | |
3ffc5f4f MKG |
416 | my ( $ret, $msg ) = $self->SUPER::LoadByCols( %hash ); |
417 | return wantarray ? ( $ret, $msg ) : $ret; | |
84fb5b46 MKG |
418 | } |
419 | ||
420 | ||
421 | ||
422 | # There is room for optimizations in most of those subs: | |
423 | ||
424 | ||
425 | sub LastUpdatedObj { | |
426 | my $self = shift; | |
427 | my $obj = RT::Date->new( $self->CurrentUser ); | |
428 | ||
429 | $obj->Set( Format => 'sql', Value => $self->LastUpdated ); | |
430 | return $obj; | |
431 | } | |
432 | ||
433 | ||
434 | ||
435 | sub CreatedObj { | |
436 | my $self = shift; | |
437 | my $obj = RT::Date->new( $self->CurrentUser ); | |
438 | ||
439 | $obj->Set( Format => 'sql', Value => $self->Created ); | |
440 | ||
441 | return $obj; | |
442 | } | |
443 | ||
444 | ||
3ffc5f4f | 445 | # B<DEPRECATED> and will be removed in 4.4 |
84fb5b46 MKG |
446 | sub AgeAsString { |
447 | my $self = shift; | |
3ffc5f4f MKG |
448 | RT->Deprecated( |
449 | Remove => "4.4", | |
450 | Instead => "->CreatedObj->AgeAsString", | |
451 | ); | |
84fb5b46 MKG |
452 | return ( $self->CreatedObj->AgeAsString() ); |
453 | } | |
454 | ||
3ffc5f4f MKG |
455 | # B<DEPRECATED> and will be removed in 4.4 |
456 | sub LongSinceUpdateAsString { | |
457 | my $self = shift; | |
458 | RT->Deprecated( | |
459 | Remove => "4.4", | |
460 | Instead => "->LastUpdatedObj->AgeAsString", | |
461 | ); | |
462 | if ( $self->LastUpdated ) { | |
463 | return ( $self->LastUpdatedObj->AgeAsString() ); | |
464 | } else { | |
465 | return "never"; | |
466 | } | |
467 | } | |
84fb5b46 MKG |
468 | |
469 | sub LastUpdatedAsString { | |
470 | my $self = shift; | |
471 | if ( $self->LastUpdated ) { | |
472 | return ( $self->LastUpdatedObj->AsString() ); | |
3ffc5f4f | 473 | } else { |
84fb5b46 MKG |
474 | return "never"; |
475 | } | |
476 | } | |
477 | ||
84fb5b46 MKG |
478 | sub CreatedAsString { |
479 | my $self = shift; | |
480 | return ( $self->CreatedObj->AsString() ); | |
481 | } | |
482 | ||
84fb5b46 MKG |
483 | sub _Set { |
484 | my $self = shift; | |
485 | ||
486 | my %args = ( | |
487 | Field => undef, | |
488 | Value => undef, | |
489 | IsSQL => undef, | |
490 | @_ | |
491 | ); | |
492 | ||
493 | #if the user is trying to modify the record | |
494 | # TODO: document _why_ this code is here | |
495 | ||
496 | if ( ( !defined( $args{'Field'} ) ) || ( !defined( $args{'Value'} ) ) ) { | |
497 | $args{'Value'} = 0; | |
498 | } | |
499 | ||
500 | my $old_val = $self->__Value($args{'Field'}); | |
501 | $self->_SetLastUpdated(); | |
502 | my $ret = $self->SUPER::_Set( | |
503 | Field => $args{'Field'}, | |
504 | Value => $args{'Value'}, | |
505 | IsSQL => $args{'IsSQL'} | |
506 | ); | |
507 | my ($status, $msg) = $ret->as_array(); | |
508 | ||
509 | # @values has two values, a status code and a message. | |
510 | ||
511 | # $ret is a Class::ReturnValue object. as such, in a boolean context, it's a bool | |
512 | # we want to change the standard "success" message | |
513 | if ($status) { | |
403d7b0b MKG |
514 | if ($self->SQLType( $args{'Field'}) =~ /text/) { |
515 | $msg = $self->loc( | |
516 | "[_1] updated", | |
517 | $self->loc( $args{'Field'} ), | |
518 | ); | |
519 | } else { | |
520 | $msg = $self->loc( | |
521 | "[_1] changed from [_2] to [_3]", | |
522 | $self->loc( $args{'Field'} ), | |
523 | ( $old_val ? '"' . $old_val . '"' : $self->loc("(no value)") ), | |
524 | '"' . $self->__Value( $args{'Field'}) . '"', | |
525 | ); | |
526 | } | |
527 | } else { | |
528 | $msg = $self->CurrentUser->loc_fuzzy($msg); | |
84fb5b46 | 529 | } |
84fb5b46 | 530 | |
403d7b0b | 531 | return wantarray ? ($status, $msg) : $ret; |
84fb5b46 MKG |
532 | } |
533 | ||
534 | ||
535 | ||
536 | =head2 _SetLastUpdated | |
537 | ||
538 | This routine updates the LastUpdated and LastUpdatedBy columns of the row in question | |
539 | It takes no options. Arguably, this is a bug | |
540 | ||
541 | =cut | |
542 | ||
543 | sub _SetLastUpdated { | |
544 | my $self = shift; | |
84fb5b46 MKG |
545 | my $now = RT::Date->new( $self->CurrentUser ); |
546 | $now->SetToNow(); | |
547 | ||
548 | if ( $self->_Accessible( 'LastUpdated', 'auto' ) ) { | |
549 | my ( $msg, $val ) = $self->__Set( | |
550 | Field => 'LastUpdated', | |
551 | Value => $now->ISO | |
552 | ); | |
553 | } | |
554 | if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) ) { | |
555 | my ( $msg, $val ) = $self->__Set( | |
556 | Field => 'LastUpdatedBy', | |
557 | Value => $self->CurrentUser->id | |
558 | ); | |
559 | } | |
560 | } | |
561 | ||
562 | ||
563 | ||
564 | =head2 CreatorObj | |
565 | ||
566 | Returns an RT::User object with the RT account of the creator of this row | |
567 | ||
568 | =cut | |
569 | ||
570 | sub CreatorObj { | |
571 | my $self = shift; | |
572 | unless ( exists $self->{'CreatorObj'} ) { | |
573 | ||
574 | $self->{'CreatorObj'} = RT::User->new( $self->CurrentUser ); | |
575 | $self->{'CreatorObj'}->Load( $self->Creator ); | |
576 | } | |
577 | return ( $self->{'CreatorObj'} ); | |
578 | } | |
579 | ||
580 | ||
581 | ||
582 | =head2 LastUpdatedByObj | |
583 | ||
584 | Returns an RT::User object of the last user to touch this object | |
585 | ||
586 | =cut | |
587 | ||
588 | sub LastUpdatedByObj { | |
589 | my $self = shift; | |
590 | unless ( exists $self->{LastUpdatedByObj} ) { | |
591 | $self->{'LastUpdatedByObj'} = RT::User->new( $self->CurrentUser ); | |
592 | $self->{'LastUpdatedByObj'}->Load( $self->LastUpdatedBy ); | |
593 | } | |
594 | return $self->{'LastUpdatedByObj'}; | |
595 | } | |
596 | ||
597 | ||
598 | ||
599 | =head2 URI | |
600 | ||
601 | Returns this record's URI | |
602 | ||
603 | =cut | |
604 | ||
605 | sub URI { | |
606 | my $self = shift; | |
607 | my $uri = RT::URI::fsck_com_rt->new($self->CurrentUser); | |
608 | return($uri->URIForObject($self)); | |
609 | } | |
610 | ||
611 | ||
612 | =head2 ValidateName NAME | |
613 | ||
614 | Validate the name of the record we're creating. Mostly, just make sure it's not a numeric ID, which is invalid for Name | |
615 | ||
616 | =cut | |
617 | ||
618 | sub ValidateName { | |
619 | my $self = shift; | |
620 | my $value = shift; | |
621 | if (defined $value && $value=~ /^\d+$/) { | |
622 | return(0); | |
623 | } else { | |
624 | return(1); | |
625 | } | |
626 | } | |
627 | ||
628 | ||
629 | ||
630 | =head2 SQLType attribute | |
631 | ||
632 | return the SQL type for the attribute 'attribute' as stored in _ClassAccessible | |
633 | ||
634 | =cut | |
635 | ||
636 | sub SQLType { | |
637 | my $self = shift; | |
638 | my $field = shift; | |
639 | ||
640 | return ($self->_Accessible($field, 'type')); | |
641 | ||
642 | ||
643 | } | |
644 | ||
645 | sub __Value { | |
646 | my $self = shift; | |
647 | my $field = shift; | |
648 | my %args = ( decode_utf8 => 1, @_ ); | |
649 | ||
650 | unless ($field) { | |
651 | $RT::Logger->error("__Value called with undef field"); | |
652 | } | |
653 | ||
654 | my $value = $self->SUPER::__Value($field); | |
3ffc5f4f | 655 | return $value if ref $value; |
84fb5b46 | 656 | |
dab09ea8 MKG |
657 | return undef if (!defined $value); |
658 | ||
3ffc5f4f MKG |
659 | # Pg returns character columns as character strings; mysql and |
660 | # sqlite return them as bytes. While mysql can be made to return | |
661 | # characters, using the mysql_enable_utf8 flag, the "Content" column | |
662 | # is bytes on mysql and characters on Postgres, making true | |
663 | # consistency impossible. | |
84fb5b46 | 664 | if ( $args{'decode_utf8'} ) { |
3ffc5f4f | 665 | if ( !utf8::is_utf8($value) ) { # mysql/sqlite |
84fb5b46 MKG |
666 | utf8::decode($value); |
667 | } | |
3ffc5f4f | 668 | } else { |
84fb5b46 MKG |
669 | if ( utf8::is_utf8($value) ) { |
670 | utf8::encode($value); | |
671 | } | |
672 | } | |
673 | ||
674 | return $value; | |
675 | ||
676 | } | |
677 | ||
678 | # Set up defaults for DBIx::SearchBuilder::Record::Cachable | |
679 | ||
680 | sub _CacheConfig { | |
681 | { | |
682 | 'cache_p' => 1, | |
683 | 'cache_for_sec' => 30, | |
684 | } | |
685 | } | |
686 | ||
687 | ||
688 | ||
689 | sub _BuildTableAttributes { | |
690 | my $self = shift; | |
691 | my $class = ref($self) || $self; | |
692 | ||
693 | my $attributes; | |
694 | if ( UNIVERSAL::can( $self, '_CoreAccessible' ) ) { | |
695 | $attributes = $self->_CoreAccessible(); | |
696 | } elsif ( UNIVERSAL::can( $self, '_ClassAccessible' ) ) { | |
697 | $attributes = $self->_ClassAccessible(); | |
698 | ||
699 | } | |
700 | ||
701 | foreach my $column (keys %$attributes) { | |
702 | foreach my $attr ( keys %{ $attributes->{$column} } ) { | |
703 | $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr}; | |
704 | } | |
705 | } | |
706 | foreach my $method ( qw(_OverlayAccessible _VendorAccessible _LocalAccessible) ) { | |
707 | next unless UNIVERSAL::can( $self, $method ); | |
708 | $attributes = $self->$method(); | |
709 | ||
710 | foreach my $column ( keys %$attributes ) { | |
711 | foreach my $attr ( keys %{ $attributes->{$column} } ) { | |
712 | $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr}; | |
713 | } | |
714 | } | |
715 | } | |
716 | } | |
717 | ||
718 | ||
719 | =head2 _ClassAccessible | |
720 | ||
721 | Overrides the "core" _ClassAccessible using $_TABLE_ATTR. Behaves identical to the version in | |
722 | DBIx::SearchBuilder::Record | |
723 | ||
724 | =cut | |
725 | ||
726 | sub _ClassAccessible { | |
727 | my $self = shift; | |
728 | return $_TABLE_ATTR->{ref($self) || $self}; | |
729 | } | |
730 | ||
731 | =head2 _Accessible COLUMN ATTRIBUTE | |
732 | ||
733 | returns the value of ATTRIBUTE for COLUMN | |
734 | ||
735 | ||
736 | =cut | |
737 | ||
738 | sub _Accessible { | |
739 | my $self = shift; | |
740 | my $column = shift; | |
741 | my $attribute = lc(shift); | |
3ffc5f4f MKG |
742 | |
743 | my $class = ref($self) || $self; | |
744 | $class->_BuildTableAttributes unless ($_TABLE_ATTR->{$class}); | |
745 | ||
746 | return 0 unless defined ($_TABLE_ATTR->{$class}->{$column}); | |
747 | return $_TABLE_ATTR->{$class}->{$column}->{$attribute} || 0; | |
84fb5b46 MKG |
748 | |
749 | } | |
750 | ||
3ffc5f4f | 751 | =head2 _EncodeLOB BODY MIME_TYPE FILENAME |
84fb5b46 | 752 | |
3ffc5f4f MKG |
753 | Takes a potentially large attachment. Returns (ContentEncoding, |
754 | EncodedBody, MimeType, Filename, NoteArgs) based on system configuration and | |
755 | selected database. Returns a custom (short) text/plain message if | |
756 | DropLongAttachments causes an attachment to not be stored. | |
757 | ||
758 | Encodes your data as base64 or Quoted-Printable as needed based on your | |
759 | Databases's restrictions and the UTF-8ness of the data being passed in. Since | |
760 | we are storing in columns marked UTF8, we must ensure that binary data is | |
761 | encoded on databases which are strict. | |
762 | ||
763 | This function expects to receive an octet string in order to properly | |
764 | evaluate and encode it. It will return an octet string. | |
765 | ||
766 | NoteArgs is currently used to indicate caller that the message is too long and | |
767 | is truncated or dropped. It's a hashref which is expected to be passed to | |
768 | L<RT::Record/_NewTransaction>. | |
84fb5b46 MKG |
769 | |
770 | =cut | |
771 | ||
772 | sub _EncodeLOB { | |
3ffc5f4f MKG |
773 | my $self = shift; |
774 | my $Body = shift; | |
775 | my $MIMEType = shift || ''; | |
776 | my $Filename = shift; | |
84fb5b46 | 777 | |
3ffc5f4f MKG |
778 | my $ContentEncoding = 'none'; |
779 | my $note_args; | |
84fb5b46 | 780 | |
3ffc5f4f | 781 | RT::Util::assert_bytes( $Body ); |
84fb5b46 | 782 | |
3ffc5f4f MKG |
783 | #get the max attachment length from RT |
784 | my $MaxSize = RT->Config->Get('MaxAttachmentSize'); | |
84fb5b46 | 785 | |
3ffc5f4f MKG |
786 | #if the current attachment contains nulls and the |
787 | #database doesn't support embedded nulls | |
84fb5b46 | 788 | |
3ffc5f4f | 789 | if ( ( !$RT::Handle->BinarySafeBLOBs ) && ( $Body =~ /\x00/ ) ) { |
84fb5b46 | 790 | |
3ffc5f4f MKG |
791 | # set a flag telling us to mimencode the attachment |
792 | $ContentEncoding = 'base64'; | |
84fb5b46 | 793 | |
3ffc5f4f MKG |
794 | #cut the max attchment size by 25% (for mime-encoding overhead. |
795 | $RT::Logger->debug("Max size is $MaxSize"); | |
796 | $MaxSize = $MaxSize * 3 / 4; | |
797 | # Some databases (postgres) can't handle non-utf8 data | |
798 | } elsif ( !$RT::Handle->BinarySafeBLOBs | |
799 | && $Body =~ /\P{ASCII}/ | |
800 | && !Encode::is_utf8( $Body, 1 ) ) { | |
801 | $ContentEncoding = 'quoted-printable'; | |
802 | } | |
84fb5b46 | 803 | |
3ffc5f4f MKG |
804 | #if the attachment is larger than the maximum size |
805 | if ( ($MaxSize) and ( $MaxSize < length($Body) ) ) { | |
84fb5b46 | 806 | |
3ffc5f4f MKG |
807 | my $size = length $Body; |
808 | # if we're supposed to truncate large attachments | |
809 | if (RT->Config->Get('TruncateLongAttachments')) { | |
84fb5b46 | 810 | |
3ffc5f4f | 811 | $RT::Logger->info("$self: Truncated an attachment of size $size"); |
84fb5b46 | 812 | |
3ffc5f4f MKG |
813 | # truncate the attachment to that length. |
814 | $Body = substr( $Body, 0, $MaxSize ); | |
815 | $note_args = { | |
816 | Type => 'AttachmentTruncate', | |
817 | Data => $Filename, | |
818 | OldValue => $size, | |
819 | NewValue => $MaxSize, | |
820 | ActivateScrips => 0, | |
821 | }; | |
84fb5b46 | 822 | |
84fb5b46 MKG |
823 | } |
824 | ||
3ffc5f4f MKG |
825 | # elsif we're supposed to drop large attachments on the floor, |
826 | elsif (RT->Config->Get('DropLongAttachments')) { | |
827 | ||
828 | # drop the attachment on the floor | |
829 | $RT::Logger->info( "$self: Dropped an attachment of size $size" ); | |
830 | $RT::Logger->info( "It started: " . substr( $Body, 0, 60 ) ); | |
831 | $note_args = { | |
832 | Type => 'AttachmentDrop', | |
833 | Data => $Filename, | |
834 | OldValue => $size, | |
835 | NewValue => $MaxSize, | |
836 | ActivateScrips => 0, | |
837 | }; | |
838 | $Filename .= ".txt" if $Filename && $Filename !~ /\.txt$/; | |
839 | return ("none", "Large attachment dropped", "text/plain", $Filename, $note_args ); | |
84fb5b46 | 840 | } |
3ffc5f4f | 841 | } |
84fb5b46 | 842 | |
3ffc5f4f MKG |
843 | # if we need to mimencode the attachment |
844 | if ( $ContentEncoding eq 'base64' ) { | |
845 | # base64 encode the attachment | |
846 | $Body = MIME::Base64::encode_base64($Body); | |
847 | ||
848 | } elsif ($ContentEncoding eq 'quoted-printable') { | |
849 | $Body = MIME::QuotedPrint::encode($Body); | |
850 | } | |
84fb5b46 | 851 | |
84fb5b46 | 852 | |
3ffc5f4f | 853 | return ($ContentEncoding, $Body, $MIMEType, $Filename, $note_args ); |
84fb5b46 MKG |
854 | } |
855 | ||
3ffc5f4f MKG |
856 | =head2 _DecodeLOB C<ContentType>, C<ContentEncoding>, C<Content> |
857 | ||
858 | Unpacks data stored in the database, which may be base64 or QP encoded | |
859 | because of our need to store binary and badly encoded data in columns | |
860 | marked as UTF-8. Databases such as PostgreSQL and Oracle care that you | |
861 | are feeding them invalid UTF-8 and will refuse the content. This | |
862 | function handles unpacking the encoded data. | |
863 | ||
864 | It returns textual data as a UTF-8 string which has been processed by Encode's | |
865 | PERLQQ filter which will replace the invalid bytes with \x{HH} so you can see | |
866 | the invalid byte but won't run into problems treating the data as UTF-8 later. | |
867 | ||
868 | This is similar to how we filter all data coming in via the web UI in | |
869 | RT::Interface::Web::DecodeARGS. This filter should only end up being | |
870 | applied to old data from less UTF-8-safe versions of RT. | |
871 | ||
872 | If the passed C<ContentType> includes a character set, that will be used | |
873 | to decode textual data; the default character set is UTF-8. This is | |
874 | necessary because while we attempt to store textual data as UTF-8, the | |
875 | definition of "textual" has migrated over time, and thus we may now need | |
876 | to attempt to decode data that was previously not trancoded on insertion. | |
877 | ||
878 | Important Note - This function expects an octet string and returns a | |
879 | character string for non-binary data. | |
880 | ||
881 | =cut | |
882 | ||
84fb5b46 MKG |
883 | sub _DecodeLOB { |
884 | my $self = shift; | |
885 | my $ContentType = shift || ''; | |
886 | my $ContentEncoding = shift || 'none'; | |
887 | my $Content = shift; | |
888 | ||
3ffc5f4f MKG |
889 | RT::Util::assert_bytes( $Content ); |
890 | ||
84fb5b46 MKG |
891 | if ( $ContentEncoding eq 'base64' ) { |
892 | $Content = MIME::Base64::decode_base64($Content); | |
893 | } | |
894 | elsif ( $ContentEncoding eq 'quoted-printable' ) { | |
895 | $Content = MIME::QuotedPrint::decode($Content); | |
896 | } | |
897 | elsif ( $ContentEncoding && $ContentEncoding ne 'none' ) { | |
898 | return ( $self->loc( "Unknown ContentEncoding [_1]", $ContentEncoding ) ); | |
899 | } | |
900 | if ( RT::I18N::IsTextualContentType($ContentType) ) { | |
3ffc5f4f MKG |
901 | my $entity = MIME::Entity->new(); |
902 | $entity->head->add("Content-Type", $ContentType); | |
903 | $entity->bodyhandle( MIME::Body::Scalar->new( $Content ) ); | |
904 | my $charset = RT::I18N::_FindOrGuessCharset($entity); | |
905 | $charset = 'utf-8' if not $charset or not Encode::find_encoding($charset); | |
906 | ||
907 | $Content = Encode::decode($charset,$Content,Encode::FB_PERLQQ); | |
84fb5b46 | 908 | } |
3ffc5f4f | 909 | return ($Content); |
84fb5b46 MKG |
910 | } |
911 | ||
84fb5b46 MKG |
912 | =head2 Update ARGSHASH |
913 | ||
914 | Updates fields on an object for you using the proper Set methods, | |
915 | skipping unchanged values. | |
916 | ||
917 | ARGSRef => a hashref of attributes => value for the update | |
918 | AttributesRef => an arrayref of keys in ARGSRef that should be updated | |
919 | AttributePrefix => a prefix that should be added to the attributes in AttributesRef | |
920 | when looking up values in ARGSRef | |
921 | Bare attributes are tried before prefixed attributes | |
922 | ||
923 | Returns a list of localized results of the update | |
924 | ||
925 | =cut | |
926 | ||
927 | sub Update { | |
928 | my $self = shift; | |
929 | ||
930 | my %args = ( | |
931 | ARGSRef => undef, | |
932 | AttributesRef => undef, | |
933 | AttributePrefix => undef, | |
934 | @_ | |
935 | ); | |
936 | ||
937 | my $attributes = $args{'AttributesRef'}; | |
938 | my $ARGSRef = $args{'ARGSRef'}; | |
939 | my %new_values; | |
940 | ||
941 | # gather all new values | |
942 | foreach my $attribute (@$attributes) { | |
943 | my $value; | |
944 | if ( defined $ARGSRef->{$attribute} ) { | |
945 | $value = $ARGSRef->{$attribute}; | |
946 | } | |
947 | elsif ( | |
948 | defined( $args{'AttributePrefix'} ) | |
949 | && defined( | |
950 | $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute } | |
951 | ) | |
952 | ) { | |
953 | $value = $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute }; | |
954 | ||
955 | } | |
956 | else { | |
957 | next; | |
958 | } | |
959 | ||
960 | $value =~ s/\r\n/\n/gs; | |
961 | ||
c36a7e1d MKG |
962 | my $truncated_value = $self->TruncateValue($attribute, $value); |
963 | ||
84fb5b46 MKG |
964 | # If Queue is 'General', we want to resolve the queue name for |
965 | # the object. | |
966 | ||
967 | # This is in an eval block because $object might not exist. | |
968 | # and might not have a Name method. But "can" won't find autoloaded | |
969 | # items. If it fails, we don't care | |
970 | do { | |
971 | no warnings "uninitialized"; | |
972 | local $@; | |
3ffc5f4f | 973 | my $name = eval { |
84fb5b46 | 974 | my $object = $attribute . "Obj"; |
3ffc5f4f | 975 | $self->$object->Name; |
84fb5b46 | 976 | }; |
3ffc5f4f MKG |
977 | unless ($@) { |
978 | next if $name eq $value || $name eq ($value || 0); | |
979 | } | |
403d7b0b | 980 | |
3ffc5f4f MKG |
981 | next if $truncated_value eq $self->$attribute(); |
982 | next if ( $truncated_value || 0 ) eq $self->$attribute(); | |
84fb5b46 MKG |
983 | }; |
984 | ||
985 | $new_values{$attribute} = $value; | |
986 | } | |
987 | ||
988 | return $self->_UpdateAttributes( | |
989 | Attributes => $attributes, | |
990 | NewValues => \%new_values, | |
991 | ); | |
992 | } | |
993 | ||
994 | sub _UpdateAttributes { | |
995 | my $self = shift; | |
996 | my %args = ( | |
997 | Attributes => [], | |
998 | NewValues => {}, | |
999 | @_, | |
1000 | ); | |
1001 | ||
1002 | my @results; | |
1003 | ||
1004 | foreach my $attribute (@{ $args{Attributes} }) { | |
1005 | next if !exists($args{NewValues}{$attribute}); | |
1006 | ||
1007 | my $value = $args{NewValues}{$attribute}; | |
1008 | my $method = "Set$attribute"; | |
1009 | my ( $code, $msg ) = $self->$method($value); | |
1010 | my ($prefix) = ref($self) =~ /RT(?:.*)::(\w+)/; | |
1011 | ||
1012 | # Default to $id, but use name if we can get it. | |
1013 | my $label = $self->id; | |
1014 | $label = $self->Name if (UNIVERSAL::can($self,'Name')); | |
1015 | # this requires model names to be loc'ed. | |
1016 | ||
1017 | =for loc | |
1018 | ||
1019 | "Ticket" # loc | |
1020 | "User" # loc | |
1021 | "Group" # loc | |
1022 | "Queue" # loc | |
1023 | ||
1024 | =cut | |
1025 | ||
1026 | push @results, $self->loc( $prefix ) . " $label: ". $msg; | |
1027 | ||
1028 | =for loc | |
1029 | ||
1030 | "[_1] could not be set to [_2].", # loc | |
1031 | "That is already the current value", # loc | |
1032 | "No value sent to _Set!", # loc | |
1033 | "Illegal value for [_1]", # loc | |
1034 | "The new value has been set.", # loc | |
1035 | "No column specified", # loc | |
1036 | "Immutable field", # loc | |
1037 | "Nonexistant field?", # loc | |
1038 | "Invalid data", # loc | |
1039 | "Couldn't find row", # loc | |
1040 | "Missing a primary key?: [_1]", # loc | |
1041 | "Found Object", # loc | |
1042 | ||
1043 | =cut | |
1044 | ||
1045 | } | |
1046 | ||
1047 | return @results; | |
1048 | } | |
1049 | ||
1050 | ||
1051 | ||
1052 | ||
1053 | =head2 Members | |
1054 | ||
1055 | This returns an RT::Links object which references all the tickets | |
1056 | which are 'MembersOf' this ticket | |
1057 | ||
1058 | =cut | |
1059 | ||
1060 | sub Members { | |
1061 | my $self = shift; | |
1062 | return ( $self->_Links( 'Target', 'MemberOf' ) ); | |
1063 | } | |
1064 | ||
1065 | ||
1066 | ||
1067 | =head2 MemberOf | |
1068 | ||
1069 | This returns an RT::Links object which references all the tickets that this | |
1070 | ticket is a 'MemberOf' | |
1071 | ||
1072 | =cut | |
1073 | ||
1074 | sub MemberOf { | |
1075 | my $self = shift; | |
1076 | return ( $self->_Links( 'Base', 'MemberOf' ) ); | |
1077 | } | |
1078 | ||
1079 | ||
1080 | ||
1081 | =head2 RefersTo | |
1082 | ||
1083 | This returns an RT::Links object which shows all references for which this ticket is a base | |
1084 | ||
1085 | =cut | |
1086 | ||
1087 | sub RefersTo { | |
1088 | my $self = shift; | |
1089 | return ( $self->_Links( 'Base', 'RefersTo' ) ); | |
1090 | } | |
1091 | ||
1092 | ||
1093 | ||
1094 | =head2 ReferredToBy | |
1095 | ||
1096 | This returns an L<RT::Links> object which shows all references for which this ticket is a target | |
1097 | ||
1098 | =cut | |
1099 | ||
1100 | sub ReferredToBy { | |
1101 | my $self = shift; | |
1102 | return ( $self->_Links( 'Target', 'RefersTo' ) ); | |
1103 | } | |
1104 | ||
1105 | ||
1106 | ||
1107 | =head2 DependedOnBy | |
1108 | ||
1109 | This returns an RT::Links object which references all the tickets that depend on this one | |
1110 | ||
1111 | =cut | |
1112 | ||
1113 | sub DependedOnBy { | |
1114 | my $self = shift; | |
1115 | return ( $self->_Links( 'Target', 'DependsOn' ) ); | |
1116 | } | |
1117 | ||
1118 | ||
1119 | ||
1120 | ||
1121 | =head2 HasUnresolvedDependencies | |
1122 | ||
1123 | Takes a paramhash of Type (default to '__any'). Returns the number of | |
1124 | unresolved dependencies, if $self->UnresolvedDependencies returns an | |
1125 | object with one or more members of that type. Returns false | |
1126 | otherwise. | |
1127 | ||
1128 | =cut | |
1129 | ||
1130 | sub HasUnresolvedDependencies { | |
1131 | my $self = shift; | |
1132 | my %args = ( | |
1133 | Type => undef, | |
1134 | @_ | |
1135 | ); | |
1136 | ||
1137 | my $deps = $self->UnresolvedDependencies; | |
1138 | ||
1139 | if ($args{Type}) { | |
3ffc5f4f MKG |
1140 | $deps->LimitType( VALUE => $args{Type} ); |
1141 | } else { | |
1142 | $deps->IgnoreType; | |
84fb5b46 MKG |
1143 | } |
1144 | ||
1145 | if ($deps->Count > 0) { | |
1146 | return $deps->Count; | |
1147 | } | |
1148 | else { | |
1149 | return (undef); | |
1150 | } | |
1151 | } | |
1152 | ||
1153 | ||
1154 | ||
1155 | =head2 UnresolvedDependencies | |
1156 | ||
1157 | Returns an RT::Tickets object of tickets which this ticket depends on | |
1158 | and which have a status of new, open or stalled. (That list comes from | |
1159 | RT::Queue->ActiveStatusArray | |
1160 | ||
1161 | =cut | |
1162 | ||
1163 | ||
1164 | sub UnresolvedDependencies { | |
1165 | my $self = shift; | |
1166 | my $deps = RT::Tickets->new($self->CurrentUser); | |
1167 | ||
3ffc5f4f | 1168 | $deps->LimitToActiveStatus; |
84fb5b46 MKG |
1169 | $deps->LimitDependedOnBy($self->Id); |
1170 | ||
1171 | return($deps); | |
1172 | ||
1173 | } | |
1174 | ||
1175 | ||
1176 | ||
1177 | =head2 AllDependedOnBy | |
1178 | ||
1179 | Returns an array of RT::Ticket objects which (directly or indirectly) | |
1180 | depends on this ticket; takes an optional 'Type' argument in the param | |
1181 | hash, which will limit returned tickets to that type, as well as cause | |
1182 | tickets with that type to serve as 'leaf' nodes that stops the recursive | |
1183 | dependency search. | |
1184 | ||
1185 | =cut | |
1186 | ||
1187 | sub AllDependedOnBy { | |
1188 | my $self = shift; | |
1189 | return $self->_AllLinkedTickets( LinkType => 'DependsOn', | |
1190 | Direction => 'Target', @_ ); | |
1191 | } | |
1192 | ||
1193 | =head2 AllDependsOn | |
1194 | ||
1195 | Returns an array of RT::Ticket objects which this ticket (directly or | |
1196 | indirectly) depends on; takes an optional 'Type' argument in the param | |
1197 | hash, which will limit returned tickets to that type, as well as cause | |
1198 | tickets with that type to serve as 'leaf' nodes that stops the | |
1199 | recursive dependency search. | |
1200 | ||
1201 | =cut | |
1202 | ||
1203 | sub AllDependsOn { | |
1204 | my $self = shift; | |
1205 | return $self->_AllLinkedTickets( LinkType => 'DependsOn', | |
1206 | Direction => 'Base', @_ ); | |
1207 | } | |
1208 | ||
1209 | sub _AllLinkedTickets { | |
1210 | my $self = shift; | |
1211 | ||
1212 | my %args = ( | |
1213 | LinkType => undef, | |
1214 | Direction => undef, | |
1215 | Type => undef, | |
3ffc5f4f MKG |
1216 | _found => {}, |
1217 | _top => 1, | |
84fb5b46 MKG |
1218 | @_ |
1219 | ); | |
1220 | ||
1221 | my $dep = $self->_Links( $args{Direction}, $args{LinkType}); | |
1222 | while (my $link = $dep->Next()) { | |
1223 | my $uri = $args{Direction} eq 'Target' ? $link->BaseURI : $link->TargetURI; | |
3ffc5f4f | 1224 | next unless ($uri->IsLocal()); |
84fb5b46 | 1225 | my $obj = $args{Direction} eq 'Target' ? $link->BaseObj : $link->TargetObj; |
3ffc5f4f | 1226 | next if $args{_found}{$obj->Id}; |
84fb5b46 | 1227 | |
3ffc5f4f MKG |
1228 | if (!$args{Type}) { |
1229 | $args{_found}{$obj->Id} = $obj; | |
1230 | $obj->_AllLinkedTickets( %args, _top => 0 ); | |
1231 | } | |
1232 | elsif ($obj->Type and $obj->Type eq $args{Type}) { | |
1233 | $args{_found}{$obj->Id} = $obj; | |
1234 | } | |
1235 | else { | |
1236 | $obj->_AllLinkedTickets( %args, _top => 0 ); | |
1237 | } | |
84fb5b46 MKG |
1238 | } |
1239 | ||
1240 | if ($args{_top}) { | |
3ffc5f4f | 1241 | return map { $args{_found}{$_} } sort keys %{$args{_found}}; |
84fb5b46 MKG |
1242 | } |
1243 | else { | |
3ffc5f4f | 1244 | return 1; |
84fb5b46 MKG |
1245 | } |
1246 | } | |
1247 | ||
1248 | ||
1249 | ||
1250 | =head2 DependsOn | |
1251 | ||
1252 | This returns an RT::Links object which references all the tickets that this ticket depends on | |
1253 | ||
1254 | =cut | |
1255 | ||
1256 | sub DependsOn { | |
1257 | my $self = shift; | |
1258 | return ( $self->_Links( 'Base', 'DependsOn' ) ); | |
1259 | } | |
1260 | ||
1261 | ||
1262 | ||
1263 | ||
1264 | ||
1265 | ||
1266 | =head2 Links DIRECTION [TYPE] | |
1267 | ||
1268 | Return links (L<RT::Links>) to/from this object. | |
1269 | ||
1270 | DIRECTION is either 'Base' or 'Target'. | |
1271 | ||
1272 | TYPE is a type of links to return, it can be omitted to get | |
1273 | links of any type. | |
1274 | ||
1275 | =cut | |
1276 | ||
1277 | sub Links { shift->_Links(@_) } | |
1278 | ||
1279 | sub _Links { | |
1280 | my $self = shift; | |
1281 | ||
1282 | #TODO: Field isn't the right thing here. but I ahave no idea what mnemonic --- | |
1283 | #tobias meant by $f | |
1284 | my $field = shift; | |
1285 | my $type = shift || ""; | |
1286 | ||
1287 | unless ( $self->{"$field$type"} ) { | |
1288 | $self->{"$field$type"} = RT::Links->new( $self->CurrentUser ); | |
1289 | # at least to myself | |
1290 | $self->{"$field$type"}->Limit( FIELD => $field, | |
1291 | VALUE => $self->URI, | |
1292 | ENTRYAGGREGATOR => 'OR' ); | |
1293 | $self->{"$field$type"}->Limit( FIELD => 'Type', | |
1294 | VALUE => $type ) | |
1295 | if ($type); | |
1296 | } | |
1297 | return ( $self->{"$field$type"} ); | |
1298 | } | |
1299 | ||
1300 | ||
1301 | ||
1302 | ||
1303 | =head2 FormatType | |
1304 | ||
1305 | Takes a Type and returns a string that is more human readable. | |
1306 | ||
1307 | =cut | |
1308 | ||
1309 | sub FormatType{ | |
1310 | my $self = shift; | |
1311 | my %args = ( Type => '', | |
3ffc5f4f MKG |
1312 | @_ |
1313 | ); | |
84fb5b46 MKG |
1314 | $args{Type} =~ s/([A-Z])/" " . lc $1/ge; |
1315 | $args{Type} =~ s/^\s+//; | |
1316 | return $args{Type}; | |
1317 | } | |
1318 | ||
1319 | ||
1320 | ||
1321 | ||
1322 | =head2 FormatLink | |
1323 | ||
1324 | Takes either a Target or a Base and returns a string of human friendly text. | |
1325 | ||
1326 | =cut | |
1327 | ||
1328 | sub FormatLink { | |
1329 | my $self = shift; | |
1330 | my %args = ( Object => undef, | |
3ffc5f4f MKG |
1331 | FallBack => '', |
1332 | @_ | |
1333 | ); | |
84fb5b46 MKG |
1334 | my $text = "URI " . $args{FallBack}; |
1335 | if ($args{Object} && $args{Object}->isa("RT::Ticket")) { | |
3ffc5f4f | 1336 | $text = "Ticket " . $args{Object}->id; |
84fb5b46 MKG |
1337 | } |
1338 | return $text; | |
1339 | } | |
1340 | ||
84fb5b46 MKG |
1341 | =head2 _AddLink |
1342 | ||
1343 | Takes a paramhash of Type and one of Base or Target. Adds that link to this object. | |
1344 | ||
3ffc5f4f MKG |
1345 | If Silent is true then no transactions will be recorded. You can individually |
1346 | control transactions on both base and target and with SilentBase and | |
1347 | SilentTarget respectively. By default both transactions are created. | |
1348 | ||
1349 | If the link destination is a local object and does the | |
1350 | L<RT::Record::Role::Status> role, this method ensures object Status is not | |
1351 | "deleted". Linking to deleted objects is forbidden. | |
84fb5b46 | 1352 | |
3ffc5f4f MKG |
1353 | If the link destination (i.e. not C<$self>) is a local object and the |
1354 | C<$StrictLinkACL> option is enabled, this method checks the appropriate right | |
1355 | on the destination object (if any, as returned by the L</ModifyLinkRight> | |
1356 | method). B<< The subclass is expected to check the appropriate right on the | |
1357 | source object (i.e. C<$self>) before calling this method. >> This allows a | |
1358 | different right to be used on the source object during creation, for example. | |
1359 | ||
1360 | Returns a tuple of (link ID, message, flag if link already existed). | |
84fb5b46 MKG |
1361 | |
1362 | =cut | |
1363 | ||
1364 | sub _AddLink { | |
1365 | my $self = shift; | |
3ffc5f4f MKG |
1366 | my %args = ( |
1367 | Target => '', | |
1368 | Base => '', | |
1369 | Type => '', | |
1370 | Silent => undef, | |
1371 | Silent => undef, | |
1372 | SilentBase => undef, | |
1373 | SilentTarget => undef, | |
1374 | @_ | |
1375 | ); | |
84fb5b46 MKG |
1376 | |
1377 | # Remote_link is the URI of the object that is not this ticket | |
1378 | my $remote_link; | |
1379 | my $direction; | |
1380 | ||
1381 | if ( $args{'Base'} and $args{'Target'} ) { | |
1382 | $RT::Logger->debug( "$self tried to create a link. both base and target were specified" ); | |
01e3b242 | 1383 | return ( 0, $self->loc("Can't specify both base and target") ); |
84fb5b46 MKG |
1384 | } |
1385 | elsif ( $args{'Base'} ) { | |
1386 | $args{'Target'} = $self->URI(); | |
1387 | $remote_link = $args{'Base'}; | |
1388 | $direction = 'Target'; | |
1389 | } | |
1390 | elsif ( $args{'Target'} ) { | |
1391 | $args{'Base'} = $self->URI(); | |
1392 | $remote_link = $args{'Target'}; | |
1393 | $direction = 'Base'; | |
1394 | } | |
1395 | else { | |
1396 | return ( 0, $self->loc('Either base or target must be specified') ); | |
1397 | } | |
1398 | ||
3ffc5f4f MKG |
1399 | my $remote_uri = RT::URI->new( $self->CurrentUser ); |
1400 | if ($remote_uri->FromURI( $remote_link )) { | |
1401 | my $remote_obj = $remote_uri->IsLocal ? $remote_uri->Object : undef; | |
1402 | if ($remote_obj and $remote_obj->id) { | |
1403 | # Enforce the remote end of StrictLinkACL | |
1404 | if (RT->Config->Get("StrictLinkACL")) { | |
1405 | my $right = $remote_obj->ModifyLinkRight; | |
1406 | ||
1407 | return (0, $self->loc("Permission denied")) | |
1408 | if $right and | |
1409 | not $self->CurrentUser->HasRight( Right => $right, Object => $remote_obj ); | |
1410 | } | |
1411 | ||
1412 | # Prevent linking to deleted objects | |
1413 | if ($remote_obj->DOES("RT::Record::Role::Status") | |
1414 | and $remote_obj->Status eq "deleted") { | |
1415 | return (0, $self->loc("Linking to a deleted [_1] is not allowed", $self->loc(lc($remote_obj->RecordType)))); | |
1416 | } | |
1417 | } | |
1418 | } else { | |
1419 | return (0, $self->loc("Couldn't resolve '[_1]' into a link.", $remote_link)); | |
1420 | } | |
1421 | ||
84fb5b46 | 1422 | # Check if the link already exists - we don't want duplicates |
84fb5b46 MKG |
1423 | my $old_link = RT::Link->new( $self->CurrentUser ); |
1424 | $old_link->LoadByParams( Base => $args{'Base'}, | |
1425 | Type => $args{'Type'}, | |
1426 | Target => $args{'Target'} ); | |
1427 | if ( $old_link->Id ) { | |
1428 | $RT::Logger->debug("$self Somebody tried to duplicate a link"); | |
1429 | return ( $old_link->id, $self->loc("Link already exists"), 1 ); | |
1430 | } | |
1431 | ||
3ffc5f4f | 1432 | if ( $args{'Type'} =~ /^(?:DependsOn|MemberOf)$/ ) { |
84fb5b46 | 1433 | |
3ffc5f4f MKG |
1434 | my @tickets = $self->_AllLinkedTickets( |
1435 | LinkType => $args{'Type'}, | |
1436 | Direction => $direction eq 'Target' ? 'Base' : 'Target', | |
1437 | ); | |
1438 | if ( grep { $_->id == ( $direction eq 'Target' ? $args{'Base'} : $args{'Target'} ) } @tickets ) { | |
1439 | return ( 0, $self->loc("Refused to add link which would create a circular relationship") ); | |
1440 | } | |
1441 | } | |
84fb5b46 MKG |
1442 | |
1443 | # Storing the link in the DB. | |
1444 | my $link = RT::Link->new( $self->CurrentUser ); | |
1445 | my ($linkid, $linkmsg) = $link->Create( Target => $args{Target}, | |
3ffc5f4f MKG |
1446 | Base => $args{Base}, |
1447 | Type => $args{Type} ); | |
84fb5b46 MKG |
1448 | |
1449 | unless ($linkid) { | |
1450 | $RT::Logger->error("Link could not be created: ".$linkmsg); | |
3ffc5f4f | 1451 | return ( 0, $self->loc("Link could not be created: [_1]", $linkmsg) ); |
84fb5b46 MKG |
1452 | } |
1453 | ||
3ffc5f4f MKG |
1454 | my $basetext = $self->FormatLink(Object => $link->BaseObj, |
1455 | FallBack => $args{Base}); | |
1456 | my $targettext = $self->FormatLink(Object => $link->TargetObj, | |
1457 | FallBack => $args{Target}); | |
84fb5b46 | 1458 | my $typetext = $self->FormatType(Type => $args{Type}); |
3ffc5f4f MKG |
1459 | my $TransString = "$basetext $typetext $targettext."; |
1460 | ||
1461 | # No transactions for you! | |
1462 | return ($linkid, $TransString) if $args{'Silent'}; | |
1463 | ||
1464 | my $opposite_direction = $direction eq 'Target' ? 'Base': 'Target'; | |
84fb5b46 | 1465 | |
3ffc5f4f MKG |
1466 | # Some transactions? |
1467 | unless ( $args{ 'Silent'. $direction } ) { | |
1468 | my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction( | |
1469 | Type => 'AddLink', | |
1470 | Field => $RT::Link::DIRMAP{$args{'Type'}}->{$direction}, | |
1471 | NewValue => $remote_uri->URI || $remote_link, | |
1472 | TimeTaken => 0 | |
1473 | ); | |
1474 | $RT::Logger->error("Couldn't create transaction: $Msg") unless $Trans; | |
1475 | } | |
84fb5b46 | 1476 | |
3ffc5f4f MKG |
1477 | if ( !$args{"Silent$opposite_direction"} && $remote_uri->IsLocal ) { |
1478 | my $OtherObj = $remote_uri->Object; | |
1479 | my ( $val, $msg ) = $OtherObj->_NewTransaction( | |
1480 | Type => 'AddLink', | |
1481 | Field => $RT::Link::DIRMAP{$args{'Type'}}->{$opposite_direction}, | |
1482 | NewValue => $self->URI, | |
1483 | TimeTaken => 0, | |
1484 | ); | |
1485 | $RT::Logger->error("Couldn't create transaction: $msg") unless $val; | |
1486 | } | |
1487 | ||
1488 | return ($linkid, $TransString); | |
1489 | } | |
84fb5b46 MKG |
1490 | |
1491 | =head2 _DeleteLink | |
1492 | ||
3ffc5f4f MKG |
1493 | Takes a paramhash of Type and one of Base or Target. Removes that link from this object. |
1494 | ||
1495 | If Silent is true then no transactions will be recorded. You can individually | |
1496 | control transactions on both base and target and with SilentBase and | |
1497 | SilentTarget respectively. By default both transactions are created. | |
1498 | ||
1499 | If the link destination (i.e. not C<$self>) is a local object and the | |
1500 | C<$StrictLinkACL> option is enabled, this method checks the appropriate right | |
1501 | on the destination object (if any, as returned by the L</ModifyLinkRight> | |
1502 | method). B<< The subclass is expected to check the appropriate right on the | |
1503 | source object (i.e. C<$self>) before calling this method. >> | |
1504 | ||
1505 | Returns a tuple of (status flag, message). | |
84fb5b46 MKG |
1506 | |
1507 | =cut | |
1508 | ||
1509 | sub _DeleteLink { | |
1510 | my $self = shift; | |
1511 | my %args = ( | |
3ffc5f4f MKG |
1512 | Base => undef, |
1513 | Target => undef, | |
1514 | Type => undef, | |
1515 | Silent => undef, | |
1516 | SilentBase => undef, | |
1517 | SilentTarget => undef, | |
84fb5b46 MKG |
1518 | @_ |
1519 | ); | |
1520 | ||
3ffc5f4f | 1521 | # We want one of base and target. We don't care which but we only want _one_. |
84fb5b46 MKG |
1522 | my $direction; |
1523 | my $remote_link; | |
1524 | ||
1525 | if ( $args{'Base'} and $args{'Target'} ) { | |
1526 | $RT::Logger->debug("$self ->_DeleteLink. got both Base and Target"); | |
01e3b242 | 1527 | return ( 0, $self->loc("Can't specify both base and target") ); |
84fb5b46 MKG |
1528 | } |
1529 | elsif ( $args{'Base'} ) { | |
1530 | $args{'Target'} = $self->URI(); | |
3ffc5f4f MKG |
1531 | $remote_link = $args{'Base'}; |
1532 | $direction = 'Target'; | |
84fb5b46 MKG |
1533 | } |
1534 | elsif ( $args{'Target'} ) { | |
1535 | $args{'Base'} = $self->URI(); | |
3ffc5f4f MKG |
1536 | $remote_link = $args{'Target'}; |
1537 | $direction = 'Base'; | |
84fb5b46 MKG |
1538 | } |
1539 | else { | |
1540 | $RT::Logger->error("Base or Target must be specified"); | |
1541 | return ( 0, $self->loc('Either base or target must be specified') ); | |
1542 | } | |
1543 | ||
3ffc5f4f MKG |
1544 | my $remote_uri = RT::URI->new( $self->CurrentUser ); |
1545 | if ($remote_uri->FromURI( $remote_link )) { | |
1546 | # Enforce the remote end of StrictLinkACL | |
1547 | my $remote_obj = $remote_uri->IsLocal ? $remote_uri->Object : undef; | |
1548 | if ($remote_obj and $remote_obj->id and RT->Config->Get("StrictLinkACL")) { | |
1549 | my $right = $remote_obj->ModifyLinkRight; | |
1550 | ||
1551 | return (0, $self->loc("Permission denied")) | |
1552 | if $right and | |
1553 | not $self->CurrentUser->HasRight( Right => $right, Object => $remote_obj ); | |
1554 | } | |
1555 | } else { | |
1556 | return (0, $self->loc("Couldn't resolve '[_1]' into a link.", $remote_link)); | |
1557 | } | |
84fb5b46 | 1558 | |
3ffc5f4f MKG |
1559 | my $link = RT::Link->new( $self->CurrentUser ); |
1560 | $RT::Logger->debug( "Trying to load link: " | |
1561 | . $args{'Base'} . " " | |
1562 | . $args{'Type'} . " " | |
1563 | . $args{'Target'} ); | |
1564 | ||
1565 | $link->LoadByParams( | |
1566 | Base => $args{'Base'}, | |
1567 | Type => $args{'Type'}, | |
1568 | Target => $args{'Target'} | |
1569 | ); | |
84fb5b46 | 1570 | |
3ffc5f4f MKG |
1571 | unless ($link->id) { |
1572 | $RT::Logger->debug("Couldn't find that link"); | |
1573 | return ( 0, $self->loc("Link not found") ); | |
1574 | } | |
84fb5b46 | 1575 | |
3ffc5f4f | 1576 | my $basetext = $self->FormatLink(Object => $link->BaseObj, |
84fb5b46 | 1577 | FallBack => $args{Base}); |
3ffc5f4f | 1578 | my $targettext = $self->FormatLink(Object => $link->TargetObj, |
84fb5b46 | 1579 | FallBack => $args{Target}); |
3ffc5f4f MKG |
1580 | my $typetext = $self->FormatType(Type => $args{Type}); |
1581 | my $TransString = "$basetext no longer $typetext $targettext."; | |
1582 | ||
1583 | my ($ok, $msg) = $link->Delete(); | |
1584 | unless ($ok) { | |
1585 | RT->Logger->error("Link could not be deleted: $msg"); | |
1586 | return ( 0, $self->loc("Link could not be deleted: [_1]", $msg) ); | |
84fb5b46 MKG |
1587 | } |
1588 | ||
3ffc5f4f MKG |
1589 | # No transactions for you! |
1590 | return (1, $TransString) if $args{'Silent'}; | |
1591 | ||
1592 | my $opposite_direction = $direction eq 'Target' ? 'Base': 'Target'; | |
1593 | ||
1594 | # Some transactions? | |
1595 | unless ( $args{ 'Silent'. $direction } ) { | |
1596 | my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction( | |
1597 | Type => 'DeleteLink', | |
1598 | Field => $RT::Link::DIRMAP{$args{'Type'}}->{$direction}, | |
1599 | OldValue => $remote_uri->URI || $remote_link, | |
1600 | TimeTaken => 0 | |
1601 | ); | |
1602 | $RT::Logger->error("Couldn't create transaction: $Msg") unless $Trans; | |
84fb5b46 | 1603 | } |
84fb5b46 | 1604 | |
3ffc5f4f MKG |
1605 | if ( !$args{"Silent$opposite_direction"} && $remote_uri->IsLocal ) { |
1606 | my $OtherObj = $remote_uri->Object; | |
1607 | my ( $val, $msg ) = $OtherObj->_NewTransaction( | |
1608 | Type => 'DeleteLink', | |
1609 | Field => $RT::Link::DIRMAP{$args{'Type'}}->{$opposite_direction}, | |
1610 | OldValue => $self->URI, | |
1611 | TimeTaken => 0, | |
1612 | ); | |
1613 | $RT::Logger->error("Couldn't create transaction: $msg") unless $val; | |
1614 | } | |
1615 | ||
1616 | return (1, $TransString); | |
1617 | } | |
84fb5b46 | 1618 | |
dab09ea8 MKG |
1619 | =head1 LockForUpdate |
1620 | ||
1621 | In a database transaction, gains an exclusive lock on the row, to | |
1622 | prevent race conditions. On SQLite, this is a "RESERVED" lock on the | |
1623 | entire database. | |
84fb5b46 | 1624 | |
dab09ea8 | 1625 | =cut |
84fb5b46 | 1626 | |
dab09ea8 MKG |
1627 | sub LockForUpdate { |
1628 | my $self = shift; | |
1629 | ||
1630 | my $pk = $self->_PrimaryKey; | |
1631 | my $id = @_ ? $_[0] : $self->$pk; | |
1632 | $self->_expire if $self->isa("DBIx::SearchBuilder::Record::Cachable"); | |
1633 | if (RT->Config->Get('DatabaseType') eq "SQLite") { | |
1634 | # SQLite does DB-level locking, upgrading the transaction to | |
1635 | # "RESERVED" on the first UPDATE/INSERT/DELETE. Do a no-op | |
1636 | # UPDATE to force the upgade. | |
1637 | return RT->DatabaseHandle->dbh->do( | |
1638 | "UPDATE " .$self->Table. | |
1639 | " SET $pk = $pk WHERE 1 = 0"); | |
1640 | } else { | |
1641 | return $self->_LoadFromSQL( | |
1642 | "SELECT * FROM ".$self->Table | |
1643 | ." WHERE $pk = ? FOR UPDATE", | |
1644 | $id, | |
1645 | ); | |
1646 | } | |
1647 | } | |
84fb5b46 MKG |
1648 | |
1649 | =head2 _NewTransaction PARAMHASH | |
1650 | ||
1651 | Private function to create a new RT::Transaction object for this ticket update | |
1652 | ||
1653 | =cut | |
1654 | ||
1655 | sub _NewTransaction { | |
1656 | my $self = shift; | |
1657 | my %args = ( | |
1658 | TimeTaken => undef, | |
1659 | Type => undef, | |
1660 | OldValue => undef, | |
1661 | NewValue => undef, | |
1662 | OldReference => undef, | |
1663 | NewReference => undef, | |
1664 | ReferenceType => undef, | |
1665 | Data => undef, | |
1666 | Field => undef, | |
1667 | MIMEObj => undef, | |
1668 | ActivateScrips => 1, | |
1669 | CommitScrips => 1, | |
1670 | SquelchMailTo => undef, | |
1671 | @_ | |
1672 | ); | |
1673 | ||
dab09ea8 MKG |
1674 | my $in_txn = RT->DatabaseHandle->TransactionDepth; |
1675 | RT->DatabaseHandle->BeginTransaction unless $in_txn; | |
1676 | ||
1677 | $self->LockForUpdate; | |
1678 | ||
84fb5b46 MKG |
1679 | my $old_ref = $args{'OldReference'}; |
1680 | my $new_ref = $args{'NewReference'}; | |
1681 | my $ref_type = $args{'ReferenceType'}; | |
1682 | if ($old_ref or $new_ref) { | |
3ffc5f4f MKG |
1683 | $ref_type ||= ref($old_ref) || ref($new_ref); |
1684 | if (!$ref_type) { | |
1685 | $RT::Logger->error("Reference type not specified for transaction"); | |
1686 | return; | |
1687 | } | |
1688 | $old_ref = $old_ref->Id if ref($old_ref); | |
1689 | $new_ref = $new_ref->Id if ref($new_ref); | |
84fb5b46 MKG |
1690 | } |
1691 | ||
1692 | require RT::Transaction; | |
1693 | my $trans = RT::Transaction->new( $self->CurrentUser ); | |
1694 | my ( $transaction, $msg ) = $trans->Create( | |
3ffc5f4f MKG |
1695 | ObjectId => $self->Id, |
1696 | ObjectType => ref($self), | |
84fb5b46 MKG |
1697 | TimeTaken => $args{'TimeTaken'}, |
1698 | Type => $args{'Type'}, | |
1699 | Data => $args{'Data'}, | |
1700 | Field => $args{'Field'}, | |
1701 | NewValue => $args{'NewValue'}, | |
1702 | OldValue => $args{'OldValue'}, | |
1703 | NewReference => $new_ref, | |
1704 | OldReference => $old_ref, | |
1705 | ReferenceType => $ref_type, | |
1706 | MIMEObj => $args{'MIMEObj'}, | |
1707 | ActivateScrips => $args{'ActivateScrips'}, | |
1708 | CommitScrips => $args{'CommitScrips'}, | |
1709 | SquelchMailTo => $args{'SquelchMailTo'}, | |
1710 | ); | |
1711 | ||
1712 | # Rationalize the object since we may have done things to it during the caching. | |
1713 | $self->Load($self->Id); | |
1714 | ||
1715 | $RT::Logger->warning($msg) unless $transaction; | |
1716 | ||
1717 | $self->_SetLastUpdated; | |
1718 | ||
1719 | if ( defined $args{'TimeTaken'} and $self->can('_UpdateTimeTaken')) { | |
3ffc5f4f | 1720 | $self->_UpdateTimeTaken( $args{'TimeTaken'}, Transaction => $trans ); |
84fb5b46 MKG |
1721 | } |
1722 | if ( RT->Config->Get('UseTransactionBatch') and $transaction ) { | |
3ffc5f4f | 1723 | push @{$self->{_TransactionBatch}}, $trans if $args{'CommitScrips'}; |
84fb5b46 | 1724 | } |
dab09ea8 MKG |
1725 | |
1726 | RT->DatabaseHandle->Commit unless $in_txn; | |
1727 | ||
84fb5b46 MKG |
1728 | return ( $transaction, $msg, $trans ); |
1729 | } | |
1730 | ||
1731 | ||
1732 | ||
1733 | =head2 Transactions | |
1734 | ||
3ffc5f4f | 1735 | Returns an L<RT::Transactions> object of all transactions on this record object |
84fb5b46 MKG |
1736 | |
1737 | =cut | |
1738 | ||
1739 | sub Transactions { | |
1740 | my $self = shift; | |
1741 | ||
84fb5b46 | 1742 | my $transactions = RT::Transactions->new( $self->CurrentUser ); |
84fb5b46 MKG |
1743 | $transactions->Limit( |
1744 | FIELD => 'ObjectId', | |
1745 | VALUE => $self->id, | |
1746 | ); | |
1747 | $transactions->Limit( | |
1748 | FIELD => 'ObjectType', | |
1749 | VALUE => ref($self), | |
1750 | ); | |
1751 | ||
3ffc5f4f | 1752 | return $transactions; |
84fb5b46 MKG |
1753 | } |
1754 | ||
3ffc5f4f MKG |
1755 | =head2 SortedTransactions |
1756 | ||
1757 | Returns the result of L</Transactions> ordered per the | |
1758 | I<OldestTransactionsFirst> preference/option. | |
1759 | ||
1760 | =cut | |
1761 | ||
1762 | sub SortedTransactions { | |
1763 | my $self = shift; | |
1764 | my $txns = $self->Transactions; | |
1765 | my $order = RT->Config->Get("OldestTransactionsFirst", $self->CurrentUser) | |
1766 | ? 'ASC' : 'DESC'; | |
1767 | $txns->OrderByCols( | |
1768 | { FIELD => 'Created', ORDER => $order }, | |
1769 | { FIELD => 'id', ORDER => $order }, | |
1770 | ); | |
1771 | return $txns; | |
1772 | } | |
1773 | ||
1774 | our %TRANSACTION_CLASSIFICATION = ( | |
1775 | Create => 'message', | |
1776 | Correspond => 'message', | |
1777 | Comment => 'message', | |
1778 | ||
1779 | AddWatcher => 'people', | |
1780 | DelWatcher => 'people', | |
1781 | ||
1782 | Take => 'people', | |
1783 | Untake => 'people', | |
1784 | Force => 'people', | |
1785 | Steal => 'people', | |
1786 | Give => 'people', | |
1787 | ||
1788 | AddLink => 'links', | |
1789 | DeleteLink => 'links', | |
1790 | ||
1791 | Status => 'basics', | |
1792 | Set => { | |
1793 | __default => 'basics', | |
1794 | map( { $_ => 'dates' } qw( | |
1795 | Told Starts Started Due LastUpdated Created LastUpdated | |
1796 | ) ), | |
1797 | map( { $_ => 'people' } qw( | |
1798 | Owner Creator LastUpdatedBy | |
1799 | ) ), | |
1800 | }, | |
1801 | SystemError => 'error', | |
1802 | AttachmentTruncate => 'attachment-truncate', | |
1803 | AttachmentDrop => 'attachment-drop', | |
1804 | __default => 'other', | |
1805 | ); | |
1806 | ||
1807 | sub ClassifyTransaction { | |
1808 | my $self = shift; | |
1809 | my $txn = shift; | |
1810 | ||
1811 | my $type = $txn->Type; | |
1812 | ||
1813 | my $res = $TRANSACTION_CLASSIFICATION{ $type }; | |
1814 | return $res || $TRANSACTION_CLASSIFICATION{ '__default' } | |
1815 | unless ref $res; | |
1816 | ||
1817 | return $res->{ $txn->Field } || $res->{'__default'} | |
1818 | || $TRANSACTION_CLASSIFICATION{ '__default' }; | |
1819 | } | |
1820 | ||
1821 | =head2 Attachments | |
1822 | ||
1823 | Returns an L<RT::Attachments> object of all attachments on this record object | |
1824 | (for all its L</Transactions>). | |
1825 | ||
1826 | By default Content and Headers of attachments are not fetched right away from | |
1827 | database. Use C<WithContent> and C<WithHeaders> options to override this. | |
1828 | ||
1829 | =cut | |
1830 | ||
1831 | sub Attachments { | |
1832 | my $self = shift; | |
1833 | my %args = ( | |
1834 | WithHeaders => 0, | |
1835 | WithContent => 0, | |
1836 | @_ | |
1837 | ); | |
1838 | my @columns = grep { not /^(Headers|Content)$/ } | |
1839 | RT::Attachment->ReadableAttributes; | |
1840 | push @columns, 'Headers' if $args{'WithHeaders'}; | |
1841 | push @columns, 'Content' if $args{'WithContent'}; | |
1842 | ||
1843 | my $res = RT::Attachments->new( $self->CurrentUser ); | |
1844 | $res->Columns( @columns ); | |
1845 | my $txn_alias = $res->TransactionAlias; | |
1846 | $res->Limit( | |
1847 | ALIAS => $txn_alias, | |
1848 | FIELD => 'ObjectType', | |
1849 | VALUE => ref($self), | |
1850 | ); | |
1851 | $res->Limit( | |
1852 | ALIAS => $txn_alias, | |
1853 | FIELD => 'ObjectId', | |
1854 | VALUE => $self->id, | |
1855 | ); | |
1856 | return $res; | |
1857 | } | |
1858 | ||
1859 | =head2 TextAttachments | |
1860 | ||
1861 | Returns an L<RT::Attachments> object of all attachments, like L<Attachments>, | |
1862 | but only those that are text. | |
1863 | ||
1864 | By default Content and Headers are fetched. Use C<WithContent> and | |
1865 | C<WithHeaders> options to override this. | |
1866 | ||
1867 | =cut | |
1868 | ||
1869 | sub TextAttachments { | |
1870 | my $self = shift; | |
1871 | my $res = $self->Attachments( | |
1872 | WithHeaders => 1, | |
1873 | WithContent => 1, | |
1874 | @_ | |
1875 | ); | |
1876 | $res->Limit( FIELD => 'ContentType', OPERATOR => '=', VALUE => 'text/plain'); | |
1877 | $res->Limit( FIELD => 'ContentType', OPERATOR => 'STARTSWITH', VALUE => 'message/'); | |
1878 | $res->Limit( FIELD => 'ContentType', OPERATOR => '=', VALUE => 'text'); | |
1879 | $res->Limit( FIELD => 'Filename', OPERATOR => 'IS', VALUE => 'NULL') | |
1880 | if RT->Config->Get( 'SuppressInlineTextFiles', $self->CurrentUser ); | |
1881 | return $res; | |
1882 | } | |
84fb5b46 MKG |
1883 | |
1884 | sub CustomFields { | |
1885 | my $self = shift; | |
1886 | my $cfs = RT::CustomFields->new( $self->CurrentUser ); | |
1887 | ||
1888 | $cfs->SetContextObject( $self ); | |
1889 | # XXX handle multiple types properly | |
1890 | $cfs->LimitToLookupType( $self->CustomFieldLookupType ); | |
403d7b0b | 1891 | $cfs->LimitToGlobalOrObjectId( $self->CustomFieldLookupId ); |
84fb5b46 MKG |
1892 | $cfs->ApplySortOrder; |
1893 | ||
1894 | return $cfs; | |
1895 | } | |
1896 | ||
403d7b0b MKG |
1897 | # TODO: This _only_ works for RT::Foo classes. it doesn't work, for |
1898 | # example, for RT::IR::Foo classes. | |
84fb5b46 | 1899 | |
403d7b0b | 1900 | sub CustomFieldLookupId { |
84fb5b46 | 1901 | my $self = shift; |
403d7b0b | 1902 | my $lookup = shift || $self->CustomFieldLookupType; |
84fb5b46 MKG |
1903 | my @classes = ($lookup =~ /RT::(\w+)-/g); |
1904 | ||
403d7b0b MKG |
1905 | # Work on "RT::Queue", for instance |
1906 | return $self->Id unless @classes; | |
1907 | ||
84fb5b46 | 1908 | my $object = $self; |
403d7b0b MKG |
1909 | # Save a ->Load call by not calling ->FooObj->Id, just ->Foo |
1910 | my $final = shift @classes; | |
84fb5b46 | 1911 | foreach my $class (reverse @classes) { |
3ffc5f4f MKG |
1912 | my $method = "${class}Obj"; |
1913 | $object = $object->$method; | |
84fb5b46 MKG |
1914 | } |
1915 | ||
403d7b0b MKG |
1916 | my $id = $object->$final; |
1917 | unless (defined $id) { | |
1918 | my $method = "${final}Obj"; | |
1919 | $id = $object->$method->Id; | |
1920 | } | |
1921 | return $id; | |
84fb5b46 MKG |
1922 | } |
1923 | ||
1924 | ||
1925 | =head2 CustomFieldLookupType | |
1926 | ||
1927 | Returns the path RT uses to figure out which custom fields apply to this object. | |
1928 | ||
1929 | =cut | |
1930 | ||
1931 | sub CustomFieldLookupType { | |
1932 | my $self = shift; | |
01e3b242 | 1933 | return ref($self) || $self; |
84fb5b46 MKG |
1934 | } |
1935 | ||
1936 | ||
1937 | =head2 AddCustomFieldValue { Field => FIELD, Value => VALUE } | |
1938 | ||
1939 | VALUE should be a string. FIELD can be any identifier of a CustomField | |
1940 | supported by L</LoadCustomFieldByIdentifier> method. | |
1941 | ||
1942 | Adds VALUE as a value of CustomField FIELD. If this is a single-value custom field, | |
1943 | deletes the old value. | |
1944 | If VALUE is not a valid value for the custom field, returns | |
1945 | (0, 'Error message' ) otherwise, returns ($id, 'Success Message') where | |
1946 | $id is ID of created L<ObjectCustomFieldValue> object. | |
1947 | ||
1948 | =cut | |
1949 | ||
1950 | sub AddCustomFieldValue { | |
1951 | my $self = shift; | |
1952 | $self->_AddCustomFieldValue(@_); | |
1953 | } | |
1954 | ||
1955 | sub _AddCustomFieldValue { | |
1956 | my $self = shift; | |
1957 | my %args = ( | |
1958 | Field => undef, | |
1959 | Value => undef, | |
1960 | LargeContent => undef, | |
1961 | ContentType => undef, | |
1962 | RecordTransaction => 1, | |
1963 | @_ | |
1964 | ); | |
1965 | ||
1966 | my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'}); | |
1967 | unless ( $cf->Id ) { | |
1968 | return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) ); | |
1969 | } | |
1970 | ||
1971 | my $OCFs = $self->CustomFields; | |
1972 | $OCFs->Limit( FIELD => 'id', VALUE => $cf->Id ); | |
1973 | unless ( $OCFs->Count ) { | |
1974 | return ( | |
1975 | 0, | |
1976 | $self->loc( | |
1977 | "Custom field [_1] does not apply to this object", | |
dab09ea8 | 1978 | ref $args{'Field'} ? $args{'Field'}->id : $args{'Field'} |
84fb5b46 MKG |
1979 | ) |
1980 | ); | |
1981 | } | |
1982 | ||
1983 | # empty string is not correct value of any CF, so undef it | |
1984 | foreach ( qw(Value LargeContent) ) { | |
1985 | $args{ $_ } = undef if defined $args{ $_ } && !length $args{ $_ }; | |
1986 | } | |
1987 | ||
1988 | unless ( $cf->ValidateValue( $args{'Value'} ) ) { | |
1989 | return ( 0, $self->loc("Invalid value for custom field") ); | |
1990 | } | |
1991 | ||
1992 | # If the custom field only accepts a certain # of values, delete the existing | |
1993 | # value and record a "changed from foo to bar" transaction | |
1994 | unless ( $cf->UnlimitedValues ) { | |
1995 | ||
1996 | # Load up a ObjectCustomFieldValues object for this custom field and this ticket | |
1997 | my $values = $cf->ValuesForObject($self); | |
1998 | ||
1999 | # We need to whack any old values here. In most cases, the custom field should | |
2000 | # only have one value to delete. In the pathalogical case, this custom field | |
2001 | # used to be a multiple and we have many values to whack.... | |
2002 | my $cf_values = $values->Count; | |
2003 | ||
2004 | if ( $cf_values > $cf->MaxValues ) { | |
2005 | my $i = 0; #We want to delete all but the max we can currently have , so we can then | |
2006 | # execute the same code to "change" the value from old to new | |
2007 | while ( my $value = $values->Next ) { | |
2008 | $i++; | |
2009 | if ( $i < $cf_values ) { | |
2010 | my ( $val, $msg ) = $cf->DeleteValueForObject( | |
3ffc5f4f MKG |
2011 | Object => $self, |
2012 | Id => $value->id, | |
84fb5b46 MKG |
2013 | ); |
2014 | unless ($val) { | |
2015 | return ( 0, $msg ); | |
2016 | } | |
2017 | my ( $TransactionId, $Msg, $TransactionObj ) = | |
2018 | $self->_NewTransaction( | |
2019 | Type => 'CustomField', | |
2020 | Field => $cf->Id, | |
2021 | OldReference => $value, | |
2022 | ); | |
2023 | } | |
2024 | } | |
2025 | $values->RedoSearch if $i; # redo search if have deleted at least one value | |
2026 | } | |
2027 | ||
3ffc5f4f MKG |
2028 | if ( my $entry = $values->HasEntry($args{'Value'}, $args{'LargeContent'}) ) { |
2029 | return $entry->id; | |
84fb5b46 MKG |
2030 | } |
2031 | ||
3ffc5f4f MKG |
2032 | my $old_value = $values->First; |
2033 | my $old_content; | |
2034 | $old_content = $old_value->Content if $old_value; | |
2035 | ||
84fb5b46 MKG |
2036 | my ( $new_value_id, $value_msg ) = $cf->AddValueForObject( |
2037 | Object => $self, | |
2038 | Content => $args{'Value'}, | |
2039 | LargeContent => $args{'LargeContent'}, | |
2040 | ContentType => $args{'ContentType'}, | |
2041 | ); | |
2042 | ||
2043 | unless ( $new_value_id ) { | |
2044 | return ( 0, $self->loc( "Could not add new custom field value: [_1]", $value_msg ) ); | |
2045 | } | |
2046 | ||
2047 | my $new_value = RT::ObjectCustomFieldValue->new( $self->CurrentUser ); | |
2048 | $new_value->Load( $new_value_id ); | |
2049 | ||
2050 | # now that adding the new value was successful, delete the old one | |
2051 | if ( $old_value ) { | |
2052 | my ( $val, $msg ) = $old_value->Delete(); | |
2053 | return ( 0, $msg ) unless $val; | |
2054 | } | |
2055 | ||
2056 | if ( $args{'RecordTransaction'} ) { | |
2057 | my ( $TransactionId, $Msg, $TransactionObj ) = | |
2058 | $self->_NewTransaction( | |
2059 | Type => 'CustomField', | |
2060 | Field => $cf->Id, | |
2061 | OldReference => $old_value, | |
2062 | NewReference => $new_value, | |
2063 | ); | |
2064 | } | |
2065 | ||
2066 | my $new_content = $new_value->Content; | |
2067 | ||
2068 | # For datetime, we need to display them in "human" format in result message | |
2069 | #XXX TODO how about date without time? | |
2070 | if ($cf->Type eq 'DateTime') { | |
2071 | my $DateObj = RT::Date->new( $self->CurrentUser ); | |
2072 | $DateObj->Set( | |
2073 | Format => 'ISO', | |
2074 | Value => $new_content, | |
2075 | ); | |
2076 | $new_content = $DateObj->AsString; | |
2077 | ||
2078 | if ( defined $old_content && length $old_content ) { | |
2079 | $DateObj->Set( | |
2080 | Format => 'ISO', | |
2081 | Value => $old_content, | |
2082 | ); | |
2083 | $old_content = $DateObj->AsString; | |
2084 | } | |
2085 | } | |
2086 | ||
2087 | unless ( defined $old_content && length $old_content ) { | |
2088 | return ( $new_value_id, $self->loc( "[_1] [_2] added", $cf->Name, $new_content )); | |
2089 | } | |
2090 | elsif ( !defined $new_content || !length $new_content ) { | |
2091 | return ( $new_value_id, | |
2092 | $self->loc( "[_1] [_2] deleted", $cf->Name, $old_content ) ); | |
2093 | } | |
2094 | else { | |
2095 | return ( $new_value_id, $self->loc( "[_1] [_2] changed to [_3]", $cf->Name, $old_content, $new_content)); | |
2096 | } | |
2097 | ||
2098 | } | |
2099 | ||
2100 | # otherwise, just add a new value and record "new value added" | |
2101 | else { | |
3ffc5f4f MKG |
2102 | my $values = $cf->ValuesForObject($self); |
2103 | if ( my $entry = $values->HasEntry($args{'Value'}, $args{'LargeContent'}) ) { | |
2104 | return $entry->id; | |
2105 | } | |
2106 | ||
84fb5b46 MKG |
2107 | my ($new_value_id, $msg) = $cf->AddValueForObject( |
2108 | Object => $self, | |
2109 | Content => $args{'Value'}, | |
2110 | LargeContent => $args{'LargeContent'}, | |
2111 | ContentType => $args{'ContentType'}, | |
2112 | ); | |
2113 | ||
2114 | unless ( $new_value_id ) { | |
2115 | return ( 0, $self->loc( "Could not add new custom field value: [_1]", $msg ) ); | |
2116 | } | |
2117 | if ( $args{'RecordTransaction'} ) { | |
2118 | my ( $tid, $msg ) = $self->_NewTransaction( | |
2119 | Type => 'CustomField', | |
2120 | Field => $cf->Id, | |
2121 | NewReference => $new_value_id, | |
2122 | ReferenceType => 'RT::ObjectCustomFieldValue', | |
2123 | ); | |
2124 | unless ( $tid ) { | |
2125 | return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $msg ) ); | |
2126 | } | |
2127 | } | |
2128 | return ( $new_value_id, $self->loc( "[_1] added as a value for [_2]", $args{'Value'}, $cf->Name ) ); | |
2129 | } | |
2130 | } | |
2131 | ||
2132 | ||
2133 | ||
2134 | =head2 DeleteCustomFieldValue { Field => FIELD, Value => VALUE } | |
2135 | ||
2136 | Deletes VALUE as a value of CustomField FIELD. | |
2137 | ||
2138 | VALUE can be a string, a CustomFieldValue or a ObjectCustomFieldValue. | |
2139 | ||
2140 | If VALUE is not a valid value for the custom field, returns | |
2141 | (0, 'Error message' ) otherwise, returns (1, 'Success Message') | |
2142 | ||
2143 | =cut | |
2144 | ||
2145 | sub DeleteCustomFieldValue { | |
2146 | my $self = shift; | |
2147 | my %args = ( | |
2148 | Field => undef, | |
2149 | Value => undef, | |
2150 | ValueId => undef, | |
2151 | @_ | |
2152 | ); | |
2153 | ||
2154 | my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'}); | |
2155 | unless ( $cf->Id ) { | |
2156 | return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) ); | |
2157 | } | |
2158 | ||
2159 | my ( $val, $msg ) = $cf->DeleteValueForObject( | |
2160 | Object => $self, | |
2161 | Id => $args{'ValueId'}, | |
2162 | Content => $args{'Value'}, | |
2163 | ); | |
2164 | unless ($val) { | |
2165 | return ( 0, $msg ); | |
2166 | } | |
2167 | ||
2168 | my ( $TransactionId, $Msg, $TransactionObj ) = $self->_NewTransaction( | |
2169 | Type => 'CustomField', | |
2170 | Field => $cf->Id, | |
2171 | OldReference => $val, | |
2172 | ReferenceType => 'RT::ObjectCustomFieldValue', | |
2173 | ); | |
2174 | unless ($TransactionId) { | |
2175 | return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $Msg ) ); | |
2176 | } | |
2177 | ||
2178 | my $old_value = $TransactionObj->OldValue; | |
2179 | # For datetime, we need to display them in "human" format in result message | |
2180 | if ( $cf->Type eq 'DateTime' ) { | |
2181 | my $DateObj = RT::Date->new( $self->CurrentUser ); | |
2182 | $DateObj->Set( | |
2183 | Format => 'ISO', | |
2184 | Value => $old_value, | |
2185 | ); | |
2186 | $old_value = $DateObj->AsString; | |
2187 | } | |
2188 | return ( | |
2189 | $TransactionId, | |
2190 | $self->loc( | |
2191 | "[_1] is no longer a value for custom field [_2]", | |
2192 | $old_value, $cf->Name | |
2193 | ) | |
2194 | ); | |
2195 | } | |
2196 | ||
2197 | ||
2198 | ||
2199 | =head2 FirstCustomFieldValue FIELD | |
2200 | ||
2201 | Return the content of the first value of CustomField FIELD for this ticket | |
2202 | Takes a field id or name | |
2203 | ||
2204 | =cut | |
2205 | ||
2206 | sub FirstCustomFieldValue { | |
2207 | my $self = shift; | |
2208 | my $field = shift; | |
2209 | ||
2210 | my $values = $self->CustomFieldValues( $field ); | |
2211 | return undef unless my $first = $values->First; | |
2212 | return $first->Content; | |
2213 | } | |
2214 | ||
2215 | =head2 CustomFieldValuesAsString FIELD | |
2216 | ||
2217 | Return the content of the CustomField FIELD for this ticket. | |
2218 | If this is a multi-value custom field, values will be joined with newlines. | |
2219 | ||
2220 | Takes a field id or name as the first argument | |
2221 | ||
2222 | Takes an optional Separator => "," second and third argument | |
2223 | if you want to join the values using something other than a newline | |
2224 | ||
2225 | =cut | |
2226 | ||
2227 | sub CustomFieldValuesAsString { | |
2228 | my $self = shift; | |
2229 | my $field = shift; | |
2230 | my %args = @_; | |
2231 | my $separator = $args{Separator} || "\n"; | |
2232 | ||
2233 | my $values = $self->CustomFieldValues( $field ); | |
2234 | return join ($separator, grep { defined $_ } | |
2235 | map { $_->Content } @{$values->ItemsArrayRef}); | |
2236 | } | |
2237 | ||
2238 | ||
2239 | ||
2240 | =head2 CustomFieldValues FIELD | |
2241 | ||
2242 | Return a ObjectCustomFieldValues object of all values of the CustomField whose | |
2243 | id or Name is FIELD for this record. | |
2244 | ||
2245 | Returns an RT::ObjectCustomFieldValues object | |
2246 | ||
2247 | =cut | |
2248 | ||
2249 | sub CustomFieldValues { | |
2250 | my $self = shift; | |
2251 | my $field = shift; | |
2252 | ||
2253 | if ( $field ) { | |
2254 | my $cf = $self->LoadCustomFieldByIdentifier( $field ); | |
2255 | ||
2256 | # we were asked to search on a custom field we couldn't find | |
2257 | unless ( $cf->id ) { | |
2258 | $RT::Logger->warning("Couldn't load custom field by '$field' identifier"); | |
2259 | return RT::ObjectCustomFieldValues->new( $self->CurrentUser ); | |
2260 | } | |
2261 | return ( $cf->ValuesForObject($self) ); | |
2262 | } | |
2263 | ||
2264 | # we're not limiting to a specific custom field; | |
2265 | my $ocfs = RT::ObjectCustomFieldValues->new( $self->CurrentUser ); | |
2266 | $ocfs->LimitToObject( $self ); | |
2267 | return $ocfs; | |
2268 | } | |
2269 | ||
2270 | =head2 LoadCustomFieldByIdentifier IDENTIFER | |
2271 | ||
2272 | Find the custom field has id or name IDENTIFIER for this object. | |
2273 | ||
2274 | If no valid field is found, returns an empty RT::CustomField object. | |
2275 | ||
2276 | =cut | |
2277 | ||
2278 | sub LoadCustomFieldByIdentifier { | |
2279 | my $self = shift; | |
2280 | my $field = shift; | |
2281 | ||
2282 | my $cf; | |
2283 | if ( UNIVERSAL::isa( $field, "RT::CustomField" ) ) { | |
2284 | $cf = RT::CustomField->new($self->CurrentUser); | |
2285 | $cf->SetContextObject( $self ); | |
2286 | $cf->LoadById( $field->id ); | |
2287 | } | |
2288 | elsif ($field =~ /^\d+$/) { | |
2289 | $cf = RT::CustomField->new($self->CurrentUser); | |
2290 | $cf->SetContextObject( $self ); | |
2291 | $cf->LoadById($field); | |
2292 | } else { | |
2293 | ||
2294 | my $cfs = $self->CustomFields($self->CurrentUser); | |
2295 | $cfs->SetContextObject( $self ); | |
2296 | $cfs->Limit(FIELD => 'Name', VALUE => $field, CASESENSITIVE => 0); | |
2297 | $cf = $cfs->First || RT::CustomField->new($self->CurrentUser); | |
2298 | } | |
2299 | return $cf; | |
2300 | } | |
2301 | ||
2302 | sub ACLEquivalenceObjects { } | |
2303 | ||
3ffc5f4f MKG |
2304 | =head2 HasRight |
2305 | ||
2306 | Takes a paramhash with the attributes 'Right' and 'Principal' | |
2307 | 'Right' is a ticket-scoped textual right from RT::ACE | |
2308 | 'Principal' is an RT::User object | |
2309 | ||
2310 | Returns 1 if the principal has the right. Returns undef if not. | |
2311 | ||
2312 | =cut | |
2313 | ||
2314 | sub HasRight { | |
2315 | my $self = shift; | |
2316 | my %args = ( | |
2317 | Right => undef, | |
2318 | Principal => undef, | |
2319 | @_ | |
2320 | ); | |
2321 | ||
2322 | $args{Principal} ||= $self->CurrentUser->PrincipalObj; | |
2323 | ||
2324 | return $args{'Principal'}->HasRight( | |
2325 | Object => $self->Id ? $self : $RT::System, | |
2326 | Right => $args{'Right'} | |
2327 | ); | |
2328 | } | |
2329 | ||
2330 | sub CurrentUserHasRight { | |
2331 | my $self = shift; | |
2332 | return $self->HasRight( Right => @_ ); | |
2333 | } | |
2334 | ||
2335 | sub ModifyLinkRight { } | |
2336 | ||
2337 | =head2 ColumnMapClassName | |
2338 | ||
2339 | ColumnMap needs a massaged collection class name to load the correct list | |
2340 | display. Equivalent to L<RT::SearchBuilder/ColumnMapClassName>, but provided | |
2341 | for a record instead of a collection. | |
2342 | ||
2343 | Returns a string. May be called as a package method. | |
2344 | ||
2345 | =cut | |
2346 | ||
2347 | sub ColumnMapClassName { | |
2348 | my $self = shift; | |
2349 | my $Class = ref($self) || $self; | |
2350 | $Class =~ s/:/_/g; | |
2351 | return $Class; | |
2352 | } | |
2353 | ||
84fb5b46 MKG |
2354 | sub BasicColumns { } |
2355 | ||
2356 | sub WikiBase { | |
2357 | return RT->Config->Get('WebPath'). "/index.html?q="; | |
2358 | } | |
2359 | ||
3ffc5f4f MKG |
2360 | sub UID { |
2361 | my $self = shift; | |
2362 | return undef unless defined $self->Id; | |
2363 | return "@{[ref $self]}-$RT::Organization-@{[$self->Id]}"; | |
2364 | } | |
2365 | ||
2366 | sub FindDependencies { | |
2367 | my $self = shift; | |
2368 | my ($walker, $deps) = @_; | |
2369 | for my $col (qw/Creator LastUpdatedBy/) { | |
2370 | if ( $self->_Accessible( $col, 'read' ) ) { | |
2371 | next unless $self->$col; | |
2372 | my $obj = RT::Principal->new( $self->CurrentUser ); | |
2373 | $obj->Load( $self->$col ); | |
2374 | $deps->Add( out => $obj->Object ); | |
2375 | } | |
2376 | } | |
2377 | ||
2378 | # Object attributes, we have to check on every object | |
2379 | my $objs = $self->Attributes; | |
2380 | $deps->Add( in => $objs ); | |
2381 | ||
2382 | # Transactions | |
2383 | if ( $self->isa("RT::Ticket") | |
2384 | or $self->isa("RT::User") | |
2385 | or $self->isa("RT::Group") | |
2386 | or $self->isa("RT::Article") | |
2387 | or $self->isa("RT::Queue") ) | |
2388 | { | |
2389 | $objs = RT::Transactions->new( $self->CurrentUser ); | |
2390 | $objs->Limit( FIELD => 'ObjectType', VALUE => ref $self ); | |
2391 | $objs->Limit( FIELD => 'ObjectId', VALUE => $self->id ); | |
2392 | $deps->Add( in => $objs ); | |
2393 | } | |
2394 | ||
2395 | # Object custom field values | |
2396 | if (( $self->isa("RT::Transaction") | |
2397 | or $self->isa("RT::Ticket") | |
2398 | or $self->isa("RT::User") | |
2399 | or $self->isa("RT::Group") | |
2400 | or $self->isa("RT::Queue") | |
2401 | or $self->isa("RT::Article") ) | |
2402 | and $self->can("CustomFieldValues") ) | |
2403 | { | |
2404 | $objs = $self->CustomFieldValues; # Actually OCFVs | |
2405 | $objs->{find_expired_rows} = 1; | |
2406 | $deps->Add( in => $objs ); | |
2407 | } | |
2408 | ||
2409 | # ACE records | |
2410 | if ( $self->isa("RT::Group") | |
2411 | or $self->isa("RT::Class") | |
2412 | or $self->isa("RT::Queue") | |
2413 | or $self->isa("RT::CustomField") ) | |
2414 | { | |
2415 | $objs = RT::ACL->new( $self->CurrentUser ); | |
2416 | $objs->LimitToObject( $self ); | |
2417 | $deps->Add( in => $objs ); | |
2418 | } | |
2419 | } | |
2420 | ||
2421 | sub Serialize { | |
2422 | my $self = shift; | |
2423 | my %args = ( | |
2424 | Methods => {}, | |
2425 | UIDs => 1, | |
2426 | @_, | |
2427 | ); | |
2428 | my %methods = ( | |
2429 | Creator => "CreatorObj", | |
2430 | LastUpdatedBy => "LastUpdatedByObj", | |
2431 | %{ $args{Methods} || {} }, | |
2432 | ); | |
2433 | ||
2434 | my %values = %{$self->{values}}; | |
2435 | ||
2436 | my %ca = %{ $self->_ClassAccessible }; | |
2437 | my @cols = grep {exists $values{lc $_} and defined $values{lc $_}} keys %ca; | |
2438 | ||
2439 | my %store; | |
2440 | $store{$_} = $values{lc $_} for @cols; | |
2441 | $store{id} = $values{id}; # Explicitly necessary in some cases | |
2442 | ||
2443 | # Un-apply the _transfer_ encoding, but don't mess with the octets | |
2444 | # themselves. Calling ->Content directly would, in some cases, | |
2445 | # decode from some mostly-unknown character set -- which reversing | |
2446 | # on the far end would be complicated. | |
2447 | if ($ca{ContentEncoding} and $ca{ContentType}) { | |
2448 | my ($content_col) = grep {exists $ca{$_}} qw/LargeContent Content/; | |
2449 | $store{$content_col} = $self->_DecodeLOB( | |
2450 | "application/octet-stream", # Lie so that we get bytes, not characters | |
2451 | $self->ContentEncoding, | |
2452 | $self->_Value( $content_col, decode_utf8 => 0 ) | |
2453 | ); | |
2454 | delete $store{ContentEncoding}; | |
2455 | } | |
2456 | return %store unless $args{UIDs}; | |
2457 | ||
2458 | # Use FooObj to turn Foo into a reference to the UID | |
2459 | for my $col ( grep {$store{$_}} @cols ) { | |
2460 | my $method = $methods{$col}; | |
2461 | if (not $method) { | |
2462 | $method = $col; | |
2463 | $method =~ s/(Id)?$/Obj/; | |
2464 | } | |
2465 | next unless $self->can($method); | |
2466 | ||
2467 | my $obj = $self->$method; | |
2468 | next unless $obj and $obj->isa("RT::Record"); | |
2469 | $store{$col} = \($obj->UID); | |
2470 | } | |
2471 | ||
2472 | # Anything on an object should get the UID stored instead | |
2473 | if ($store{ObjectType} and $store{ObjectId} and $self->can("Object")) { | |
2474 | delete $store{$_} for qw/ObjectType ObjectId/; | |
2475 | $store{Object} = \($self->Object->UID); | |
2476 | } | |
2477 | ||
2478 | return %store; | |
2479 | } | |
2480 | ||
2481 | sub PreInflate { | |
2482 | my $class = shift; | |
2483 | my ($importer, $uid, $data) = @_; | |
2484 | ||
2485 | my $ca = $class->_ClassAccessible; | |
2486 | my %ca = %{ $ca }; | |
2487 | ||
2488 | if ($ca{ContentEncoding} and $ca{ContentType}) { | |
2489 | my ($content_col) = grep {exists $ca{$_}} qw/LargeContent Content/; | |
2490 | if (defined $data->{$content_col}) { | |
2491 | my ($ContentEncoding, $Content) = $class->_EncodeLOB( | |
2492 | $data->{$content_col}, $data->{ContentType}, | |
2493 | ); | |
2494 | $data->{ContentEncoding} = $ContentEncoding; | |
2495 | $data->{$content_col} = $Content; | |
2496 | } | |
2497 | } | |
2498 | ||
2499 | if ($data->{Object} and not $ca{Object}) { | |
2500 | my $ref_uid = ${ delete $data->{Object} }; | |
2501 | my $ref = $importer->Lookup( $ref_uid ); | |
2502 | if ($ref) { | |
2503 | my ($class, $id) = @{$ref}; | |
2504 | $data->{ObjectId} = $id; | |
2505 | $data->{ObjectType} = $class; | |
2506 | } else { | |
2507 | $data->{ObjectId} = 0; | |
2508 | $data->{ObjectType} = ""; | |
2509 | $importer->Postpone( | |
2510 | for => $ref_uid, | |
2511 | uid => $uid, | |
2512 | column => "ObjectId", | |
2513 | classcolumn => "ObjectType", | |
2514 | ); | |
2515 | } | |
2516 | } | |
2517 | ||
2518 | for my $col (keys %{$data}) { | |
2519 | if (ref $data->{$col}) { | |
2520 | my $ref_uid = ${ $data->{$col} }; | |
2521 | my $ref = $importer->Lookup( $ref_uid ); | |
2522 | if ($ref) { | |
2523 | my (undef, $id) = @{$ref}; | |
2524 | $data->{$col} = $id; | |
2525 | } else { | |
2526 | $data->{$col} = 0; | |
2527 | $importer->Postpone( | |
2528 | for => $ref_uid, | |
2529 | uid => $uid, | |
2530 | column => $col, | |
2531 | ); | |
2532 | } | |
2533 | } | |
2534 | } | |
2535 | ||
2536 | return 1; | |
2537 | } | |
2538 | ||
2539 | sub PostInflate { | |
2540 | } | |
2541 | ||
84fb5b46 MKG |
2542 | RT::Base->_ImportOverlays(); |
2543 | ||
2544 | 1; |