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