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