Initial commit 4.0.5-3
[usit-rt.git] / lib / RT / Record.pm
1 # BEGIN BPS TAGGED BLOCK {{{
2 #
3 # COPYRIGHT:
4 #
5 # This software is Copyright (c) 1996-2012 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
70 use RT::Date;
71 use RT::User;
72 use RT::Attributes;
73 use Encode qw();
74
75 our $_TABLE_ATTR = { };
76 use base RT->Config->Get('RecordBaseClass');
77 use base 'RT::Base';
78
79
80 sub _Init {
81     my $self = shift;
82     $self->_BuildTableAttributes unless ($_TABLE_ATTR->{ref($self)});
83     $self->CurrentUser(@_);
84 }
85
86
87
88 =head2 _PrimaryKeys
89
90 The primary keys for RT classes is 'id'
91
92 =cut
93
94 sub _PrimaryKeys { return ['id'] }
95 # short circuit many, many thousands of calls from searchbuilder
96 sub _PrimaryKey { 'id' }
97
98 =head2 Id
99
100 Override L<DBIx::SearchBuilder/Id> to avoid a few lookups RT doesn't do
101 on a very common codepath
102
103 C<id> is an alias to C<Id> and is the preferred way to call this method.
104
105 =cut
106
107 sub Id {
108     return shift->{'values'}->{id};
109 }
110
111 *id = \&Id;
112
113 =head2 Delete
114
115 Delete this record object from the database.
116
117 =cut
118
119 sub Delete {
120     my $self = shift;
121     my ($rv) = $self->SUPER::Delete;
122     if ($rv) {
123         return ($rv, $self->loc("Object deleted"));
124     } else {
125
126         return(0, $self->loc("Object could not be deleted"))
127     } 
128 }
129
130 =head2 ObjectTypeStr
131
132 Returns a string which is this object's type.  The type is the class,
133 without the "RT::" prefix.
134
135
136 =cut
137
138 sub ObjectTypeStr {
139     my $self = shift;
140     if (ref($self) =~ /^.*::(\w+)$/) {
141         return $self->loc($1);
142     } else {
143         return $self->loc(ref($self));
144     }
145 }
146
147 =head2 Attributes
148
149 Return this object's attributes as an RT::Attributes object
150
151 =cut
152
153 sub Attributes {
154     my $self = shift;
155     unless ($self->{'attributes'}) {
156         $self->{'attributes'} = RT::Attributes->new($self->CurrentUser);
157         $self->{'attributes'}->LimitToObject($self);
158         $self->{'attributes'}->OrderByCols({FIELD => 'id'});
159     }
160     return ($self->{'attributes'});
161 }
162
163
164 =head2 AddAttribute { Name, Description, Content }
165
166 Adds a new attribute for this object.
167
168 =cut
169
170 sub AddAttribute {
171     my $self = shift;
172     my %args = ( Name        => undef,
173                  Description => undef,
174                  Content     => undef,
175                  @_ );
176
177     my $attr = RT::Attribute->new( $self->CurrentUser );
178     my ( $id, $msg ) = $attr->Create( 
179                                       Object    => $self,
180                                       Name        => $args{'Name'},
181                                       Description => $args{'Description'},
182                                       Content     => $args{'Content'} );
183
184
185     # XXX TODO: Why won't RedoSearch work here?                                     
186     $self->Attributes->_DoSearch;
187     
188     return ($id, $msg);
189 }
190
191
192 =head2 SetAttribute { Name, Description, Content }
193
194 Like AddAttribute, but replaces all existing attributes with the same Name.
195
196 =cut
197
198 sub SetAttribute {
199     my $self = shift;
200     my %args = ( Name        => undef,
201                  Description => undef,
202                  Content     => undef,
203                  @_ );
204
205     my @AttributeObjs = $self->Attributes->Named( $args{'Name'} )
206         or return $self->AddAttribute( %args );
207
208     my $AttributeObj = pop( @AttributeObjs );
209     $_->Delete foreach @AttributeObjs;
210
211     $AttributeObj->SetDescription( $args{'Description'} );
212     $AttributeObj->SetContent( $args{'Content'} );
213
214     $self->Attributes->RedoSearch;
215     return 1;
216 }
217
218 =head2 DeleteAttribute NAME
219
220 Deletes all attributes with the matching name for this object.
221
222 =cut
223
224 sub DeleteAttribute {
225     my $self = shift;
226     my $name = shift;
227     my ($val,$msg) =  $self->Attributes->DeleteEntry( Name => $name );
228     $self->ClearAttributes;
229     return ($val,$msg);
230 }
231
232 =head2 FirstAttribute NAME
233
234 Returns the first attribute with the matching name for this object (as an
235 L<RT::Attribute> object), or C<undef> if no such attributes exist.
236 If there is more than one attribute with the matching name on the
237 object, the first value that was set is returned.
238
239 =cut
240
241 sub FirstAttribute {
242     my $self = shift;
243     my $name = shift;
244     return ($self->Attributes->Named( $name ))[0];
245 }
246
247
248 sub ClearAttributes {
249     my $self = shift;
250     delete $self->{'attributes'};
251
252 }
253
254 sub _Handle { return $RT::Handle }
255
256
257
258 =head2  Create PARAMHASH
259
260 Takes a PARAMHASH of Column -> Value pairs.
261 If any Column has a Validate$PARAMNAME subroutine defined and the 
262 value provided doesn't pass validation, this routine returns
263 an error.
264
265 If this object's table has any of the following atetributes defined as
266 'Auto', this routine will automatically fill in their values.
267
268 =over
269
270 =item Created
271
272 =item Creator
273
274 =item LastUpdated
275
276 =item LastUpdatedBy
277
278 =back
279
280 =cut
281
282 sub Create {
283     my $self    = shift;
284     my %attribs = (@_);
285     foreach my $key ( keys %attribs ) {
286         if (my $method = $self->can("Validate$key")) {
287         if (! $method->( $self, $attribs{$key} ) ) {
288             if (wantarray) {
289                 return ( 0, $self->loc('Invalid value for [_1]', $key) );
290             }
291             else {
292                 return (0);
293             }
294         }
295         }
296     }
297
298
299
300     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$ydaym,$isdst,$offset) = gmtime();
301
302     my $now_iso =
303      sprintf("%04d-%02d-%02d %02d:%02d:%02d", ($year+1900), ($mon+1), $mday, $hour, $min, $sec);
304
305     $attribs{'Created'} = $now_iso if ( $self->_Accessible( 'Created', 'auto' ) && !$attribs{'Created'});
306
307     if ($self->_Accessible( 'Creator', 'auto' ) && !$attribs{'Creator'}) {
308          $attribs{'Creator'} = $self->CurrentUser->id || '0'; 
309     }
310     $attribs{'LastUpdated'} = $now_iso
311       if ( $self->_Accessible( 'LastUpdated', 'auto' ) && !$attribs{'LastUpdated'});
312
313     $attribs{'LastUpdatedBy'} = $self->CurrentUser->id || '0'
314       if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) && !$attribs{'LastUpdatedBy'});
315
316     my $id = $self->SUPER::Create(%attribs);
317     if ( UNIVERSAL::isa( $id, 'Class::ReturnValue' ) ) {
318         if ( $id->errno ) {
319             if (wantarray) {
320                 return ( 0,
321                     $self->loc( "Internal Error: [_1]", $id->{error_message} ) );
322             }
323             else {
324                 return (0);
325             }
326         }
327     }
328     # If the object was created in the database, 
329     # load it up now, so we're sure we get what the database 
330     # has.  Arguably, this should not be necessary, but there
331     # isn't much we can do about it.
332
333    unless ($id) { 
334     if (wantarray) {
335         return ( $id, $self->loc('Object could not be created') );
336     }
337     else {
338         return ($id);
339     }
340
341    }
342
343     if  (UNIVERSAL::isa('errno',$id)) {
344         return(undef);
345     }
346
347     $self->Load($id) if ($id);
348
349
350
351     if (wantarray) {
352         return ( $id, $self->loc('Object created') );
353     }
354     else {
355         return ($id);
356     }
357
358 }
359
360
361
362 =head2 LoadByCols
363
364 Override DBIx::SearchBuilder::LoadByCols to do case-insensitive loads if the 
365 DB is case sensitive
366
367 =cut
368
369 sub LoadByCols {
370     my $self = shift;
371
372     # We don't want to hang onto this
373     $self->ClearAttributes;
374
375     return $self->SUPER::LoadByCols( @_ ) unless $self->_Handle->CaseSensitive;
376
377     # If this database is case sensitive we need to uncase objects for
378     # explicit loading
379     my %hash = (@_);
380     foreach my $key ( keys %hash ) {
381
382         # If we've been passed an empty value, we can't do the lookup. 
383         # We don't need to explicitly downcase integers or an id.
384         if ( $key ne 'id' && defined $hash{ $key } && $hash{ $key } !~ /^\d+$/ ) {
385             my ($op, $val, $func);
386             ($key, $op, $val, $func) =
387                 $self->_Handle->_MakeClauseCaseInsensitive( $key, '=', delete $hash{ $key } );
388             $hash{$key}->{operator} = $op;
389             $hash{$key}->{value}    = $val;
390             $hash{$key}->{function} = $func;
391         }
392     }
393     return $self->SUPER::LoadByCols( %hash );
394 }
395
396
397
398 # There is room for optimizations in most of those subs:
399
400
401 sub LastUpdatedObj {
402     my $self = shift;
403     my $obj  = RT::Date->new( $self->CurrentUser );
404
405     $obj->Set( Format => 'sql', Value => $self->LastUpdated );
406     return $obj;
407 }
408
409
410
411 sub CreatedObj {
412     my $self = shift;
413     my $obj  = RT::Date->new( $self->CurrentUser );
414
415     $obj->Set( Format => 'sql', Value => $self->Created );
416
417     return $obj;
418 }
419
420
421 #
422 # TODO: This should be deprecated
423 #
424 sub AgeAsString {
425     my $self = shift;
426     return ( $self->CreatedObj->AgeAsString() );
427 }
428
429
430
431 # TODO this should be deprecated
432
433 sub LastUpdatedAsString {
434     my $self = shift;
435     if ( $self->LastUpdated ) {
436         return ( $self->LastUpdatedObj->AsString() );
437
438     }
439     else {
440         return "never";
441     }
442 }
443
444
445 #
446 # TODO This should be deprecated 
447 #
448 sub CreatedAsString {
449     my $self = shift;
450     return ( $self->CreatedObj->AsString() );
451 }
452
453
454 #
455 # TODO This should be deprecated
456 #
457 sub LongSinceUpdateAsString {
458     my $self = shift;
459     if ( $self->LastUpdated ) {
460
461         return ( $self->LastUpdatedObj->AgeAsString() );
462
463     }
464     else {
465         return "never";
466     }
467 }
468
469
470
471 #
472 sub _Set {
473     my $self = shift;
474
475     my %args = (
476         Field => undef,
477         Value => undef,
478         IsSQL => undef,
479         @_
480     );
481
482     #if the user is trying to modify the record
483     # TODO: document _why_ this code is here
484
485     if ( ( !defined( $args{'Field'} ) ) || ( !defined( $args{'Value'} ) ) ) {
486         $args{'Value'} = 0;
487     }
488
489     my $old_val = $self->__Value($args{'Field'});
490      $self->_SetLastUpdated();
491     my $ret = $self->SUPER::_Set(
492         Field => $args{'Field'},
493         Value => $args{'Value'},
494         IsSQL => $args{'IsSQL'}
495     );
496         my ($status, $msg) =  $ret->as_array();
497
498         # @values has two values, a status code and a message.
499
500     # $ret is a Class::ReturnValue object. as such, in a boolean context, it's a bool
501     # we want to change the standard "success" message
502     if ($status) {
503         $msg =
504           $self->loc(
505             "[_1] changed from [_2] to [_3]",
506             $self->loc( $args{'Field'} ),
507             ( $old_val ? '"' . $old_val . '"' : $self->loc("(no value)") ),
508             '"' . $self->__Value( $args{'Field'}) . '"' 
509           );
510       } else {
511
512           $msg = $self->CurrentUser->loc_fuzzy($msg);
513     }
514     return wantarray ? ($status, $msg) : $ret;     
515
516 }
517
518
519
520 =head2 _SetLastUpdated
521
522 This routine updates the LastUpdated and LastUpdatedBy columns of the row in question
523 It takes no options. Arguably, this is a bug
524
525 =cut
526
527 sub _SetLastUpdated {
528     my $self = shift;
529     use RT::Date;
530     my $now = RT::Date->new( $self->CurrentUser );
531     $now->SetToNow();
532
533     if ( $self->_Accessible( 'LastUpdated', 'auto' ) ) {
534         my ( $msg, $val ) = $self->__Set(
535             Field => 'LastUpdated',
536             Value => $now->ISO
537         );
538     }
539     if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) ) {
540         my ( $msg, $val ) = $self->__Set(
541             Field => 'LastUpdatedBy',
542             Value => $self->CurrentUser->id
543         );
544     }
545 }
546
547
548
549 =head2 CreatorObj
550
551 Returns an RT::User object with the RT account of the creator of this row
552
553 =cut
554
555 sub CreatorObj {
556     my $self = shift;
557     unless ( exists $self->{'CreatorObj'} ) {
558
559         $self->{'CreatorObj'} = RT::User->new( $self->CurrentUser );
560         $self->{'CreatorObj'}->Load( $self->Creator );
561     }
562     return ( $self->{'CreatorObj'} );
563 }
564
565
566
567 =head2 LastUpdatedByObj
568
569   Returns an RT::User object of the last user to touch this object
570
571 =cut
572
573 sub LastUpdatedByObj {
574     my $self = shift;
575     unless ( exists $self->{LastUpdatedByObj} ) {
576         $self->{'LastUpdatedByObj'} = RT::User->new( $self->CurrentUser );
577         $self->{'LastUpdatedByObj'}->Load( $self->LastUpdatedBy );
578     }
579     return $self->{'LastUpdatedByObj'};
580 }
581
582
583
584 =head2 URI
585
586 Returns this record's URI
587
588 =cut
589
590 sub URI {
591     my $self = shift;
592     my $uri = RT::URI::fsck_com_rt->new($self->CurrentUser);
593     return($uri->URIForObject($self));
594 }
595
596
597 =head2 ValidateName NAME
598
599 Validate the name of the record we're creating. Mostly, just make sure it's not a numeric ID, which is invalid for Name
600
601 =cut
602
603 sub ValidateName {
604     my $self = shift;
605     my $value = shift;
606     if (defined $value && $value=~ /^\d+$/) {
607         return(0);
608     } else  {
609         return(1);
610     }
611 }
612
613
614
615 =head2 SQLType attribute
616
617 return the SQL type for the attribute 'attribute' as stored in _ClassAccessible
618
619 =cut
620
621 sub SQLType {
622     my $self = shift;
623     my $field = shift;
624
625     return ($self->_Accessible($field, 'type'));
626
627
628 }
629
630 sub __Value {
631     my $self  = shift;
632     my $field = shift;
633     my %args  = ( decode_utf8 => 1, @_ );
634
635     unless ($field) {
636         $RT::Logger->error("__Value called with undef field");
637     }
638
639     my $value = $self->SUPER::__Value($field);
640
641     if ( $args{'decode_utf8'} ) {
642         if ( !utf8::is_utf8($value) ) {
643             utf8::decode($value);
644         }
645     }
646     else {
647         if ( utf8::is_utf8($value) ) {
648             utf8::encode($value);
649         }
650     }
651
652     return $value;
653
654 }
655
656 # Set up defaults for DBIx::SearchBuilder::Record::Cachable
657
658 sub _CacheConfig {
659   {
660      'cache_p'        => 1,
661      'cache_for_sec'  => 30,
662   }
663 }
664
665
666
667 sub _BuildTableAttributes {
668     my $self = shift;
669     my $class = ref($self) || $self;
670
671     my $attributes;
672     if ( UNIVERSAL::can( $self, '_CoreAccessible' ) ) {
673        $attributes = $self->_CoreAccessible();
674     } elsif ( UNIVERSAL::can( $self, '_ClassAccessible' ) ) {
675        $attributes = $self->_ClassAccessible();
676
677     }
678
679     foreach my $column (keys %$attributes) {
680         foreach my $attr ( keys %{ $attributes->{$column} } ) {
681             $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr};
682         }
683     }
684     foreach my $method ( qw(_OverlayAccessible _VendorAccessible _LocalAccessible) ) {
685         next unless UNIVERSAL::can( $self, $method );
686         $attributes = $self->$method();
687
688         foreach my $column ( keys %$attributes ) {
689             foreach my $attr ( keys %{ $attributes->{$column} } ) {
690                 $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr};
691             }
692         }
693     }
694 }
695
696
697 =head2 _ClassAccessible 
698
699 Overrides the "core" _ClassAccessible using $_TABLE_ATTR. Behaves identical to the version in
700 DBIx::SearchBuilder::Record
701
702 =cut
703
704 sub _ClassAccessible {
705     my $self = shift;
706     return $_TABLE_ATTR->{ref($self) || $self};
707 }
708
709 =head2 _Accessible COLUMN ATTRIBUTE
710
711 returns the value of ATTRIBUTE for COLUMN
712
713
714 =cut 
715
716 sub _Accessible  {
717   my $self = shift;
718   my $column = shift;
719   my $attribute = lc(shift);
720   return 0 unless defined ($_TABLE_ATTR->{ref($self)}->{$column});
721   return $_TABLE_ATTR->{ref($self)}->{$column}->{$attribute} || 0;
722
723 }
724
725 =head2 _EncodeLOB BODY MIME_TYPE
726
727 Takes a potentially large attachment. Returns (ContentEncoding, EncodedBody) based on system configuration and selected database
728
729 =cut
730
731 sub _EncodeLOB {
732         my $self = shift;
733         my $Body = shift;
734         my $MIMEType = shift || '';
735         my $Filename = shift;
736
737         my $ContentEncoding = 'none';
738
739         #get the max attachment length from RT
740         my $MaxSize = RT->Config->Get('MaxAttachmentSize');
741
742         #if the current attachment contains nulls and the
743         #database doesn't support embedded nulls
744
745         if ( ( !$RT::Handle->BinarySafeBLOBs ) && ( $Body =~ /\x00/ ) ) {
746
747             # set a flag telling us to mimencode the attachment
748             $ContentEncoding = 'base64';
749
750             #cut the max attchment size by 25% (for mime-encoding overhead.
751             $RT::Logger->debug("Max size is $MaxSize");
752             $MaxSize = $MaxSize * 3 / 4;
753         # Some databases (postgres) can't handle non-utf8 data
754         } elsif (    !$RT::Handle->BinarySafeBLOBs
755                   && $MIMEType !~ /text\/plain/gi
756                   && !Encode::is_utf8( $Body, 1 ) ) {
757               $ContentEncoding = 'quoted-printable';
758         }
759
760         #if the attachment is larger than the maximum size
761         if ( ($MaxSize) and ( $MaxSize < length($Body) ) ) {
762
763             # if we're supposed to truncate large attachments
764             if (RT->Config->Get('TruncateLongAttachments')) {
765
766                 # truncate the attachment to that length.
767                 $Body = substr( $Body, 0, $MaxSize );
768
769             }
770
771             # elsif we're supposed to drop large attachments on the floor,
772             elsif (RT->Config->Get('DropLongAttachments')) {
773
774                 # drop the attachment on the floor
775                 $RT::Logger->info( "$self: Dropped an attachment of size "
776                                    . length($Body));
777                 $RT::Logger->info( "It started: " . substr( $Body, 0, 60 ) );
778                 $Filename .= ".txt" if $Filename;
779                 return ("none", "Large attachment dropped", "plain/text", $Filename );
780             }
781         }
782
783         # if we need to mimencode the attachment
784         if ( $ContentEncoding eq 'base64' ) {
785
786             # base64 encode the attachment
787             Encode::_utf8_off($Body);
788             $Body = MIME::Base64::encode_base64($Body);
789
790         } elsif ($ContentEncoding eq 'quoted-printable') {
791             Encode::_utf8_off($Body);
792             $Body = MIME::QuotedPrint::encode($Body);
793         }
794
795
796         return ($ContentEncoding, $Body, $MIMEType, $Filename );
797
798 }
799
800 sub _DecodeLOB {
801     my $self            = shift;
802     my $ContentType     = shift || '';
803     my $ContentEncoding = shift || 'none';
804     my $Content         = shift;
805
806     if ( $ContentEncoding eq 'base64' ) {
807         $Content = MIME::Base64::decode_base64($Content);
808     }
809     elsif ( $ContentEncoding eq 'quoted-printable' ) {
810         $Content = MIME::QuotedPrint::decode($Content);
811     }
812     elsif ( $ContentEncoding && $ContentEncoding ne 'none' ) {
813         return ( $self->loc( "Unknown ContentEncoding [_1]", $ContentEncoding ) );
814     }
815     if ( RT::I18N::IsTextualContentType($ContentType) ) {
816        $Content = Encode::decode_utf8($Content) unless Encode::is_utf8($Content);
817     }
818         return ($Content);
819 }
820
821 # A helper table for links mapping to make it easier
822 # to build and parse links between tickets
823
824 use vars '%LINKDIRMAP';
825
826 %LINKDIRMAP = (
827     MemberOf => { Base => 'MemberOf',
828                   Target => 'HasMember', },
829     RefersTo => { Base => 'RefersTo',
830                 Target => 'ReferredToBy', },
831     DependsOn => { Base => 'DependsOn',
832                    Target => 'DependedOnBy', },
833     MergedInto => { Base => 'MergedInto',
834                    Target => 'MergedInto', },
835
836 );
837
838 =head2 Update  ARGSHASH
839
840 Updates fields on an object for you using the proper Set methods,
841 skipping unchanged values.
842
843  ARGSRef => a hashref of attributes => value for the update
844  AttributesRef => an arrayref of keys in ARGSRef that should be updated
845  AttributePrefix => a prefix that should be added to the attributes in AttributesRef
846                     when looking up values in ARGSRef
847                     Bare attributes are tried before prefixed attributes
848
849 Returns a list of localized results of the update
850
851 =cut
852
853 sub Update {
854     my $self = shift;
855
856     my %args = (
857         ARGSRef         => undef,
858         AttributesRef   => undef,
859         AttributePrefix => undef,
860         @_
861     );
862
863     my $attributes = $args{'AttributesRef'};
864     my $ARGSRef    = $args{'ARGSRef'};
865     my %new_values;
866
867     # gather all new values
868     foreach my $attribute (@$attributes) {
869         my $value;
870         if ( defined $ARGSRef->{$attribute} ) {
871             $value = $ARGSRef->{$attribute};
872         }
873         elsif (
874             defined( $args{'AttributePrefix'} )
875             && defined(
876                 $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute }
877             )
878           ) {
879             $value = $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute };
880
881         }
882         else {
883             next;
884         }
885
886         $value =~ s/\r\n/\n/gs;
887
888         # If Queue is 'General', we want to resolve the queue name for
889         # the object.
890
891         # This is in an eval block because $object might not exist.
892         # and might not have a Name method. But "can" won't find autoloaded
893         # items. If it fails, we don't care
894         do {
895             no warnings "uninitialized";
896             local $@;
897             eval {
898                 my $object = $attribute . "Obj";
899                 my $name = $self->$object->Name;
900                 next if $name eq $value || $name eq ($value || 0);
901             };
902             next if $value eq $self->$attribute();
903             next if ($value || 0) eq $self->$attribute();
904         };
905
906         $new_values{$attribute} = $value;
907     }
908
909     return $self->_UpdateAttributes(
910         Attributes => $attributes,
911         NewValues  => \%new_values,
912     );
913 }
914
915 sub _UpdateAttributes {
916     my $self = shift;
917     my %args = (
918         Attributes => [],
919         NewValues  => {},
920         @_,
921     );
922
923     my @results;
924
925     foreach my $attribute (@{ $args{Attributes} }) {
926         next if !exists($args{NewValues}{$attribute});
927
928         my $value = $args{NewValues}{$attribute};
929         my $method = "Set$attribute";
930         my ( $code, $msg ) = $self->$method($value);
931         my ($prefix) = ref($self) =~ /RT(?:.*)::(\w+)/;
932
933         # Default to $id, but use name if we can get it.
934         my $label = $self->id;
935         $label = $self->Name if (UNIVERSAL::can($self,'Name'));
936         # this requires model names to be loc'ed.
937
938 =for loc
939
940     "Ticket" # loc
941     "User" # loc
942     "Group" # loc
943     "Queue" # loc
944
945 =cut
946
947         push @results, $self->loc( $prefix ) . " $label: ". $msg;
948
949 =for loc
950
951                                    "[_1] could not be set to [_2].",       # loc
952                                    "That is already the current value",    # loc
953                                    "No value sent to _Set!",               # loc
954                                    "Illegal value for [_1]",               # loc
955                                    "The new value has been set.",          # loc
956                                    "No column specified",                  # loc
957                                    "Immutable field",                      # loc
958                                    "Nonexistant field?",                   # loc
959                                    "Invalid data",                         # loc
960                                    "Couldn't find row",                    # loc
961                                    "Missing a primary key?: [_1]",         # loc
962                                    "Found Object",                         # loc
963
964 =cut
965
966     }
967
968     return @results;
969 }
970
971
972
973
974 =head2 Members
975
976   This returns an RT::Links object which references all the tickets 
977 which are 'MembersOf' this ticket
978
979 =cut
980
981 sub Members {
982     my $self = shift;
983     return ( $self->_Links( 'Target', 'MemberOf' ) );
984 }
985
986
987
988 =head2 MemberOf
989
990   This returns an RT::Links object which references all the tickets that this
991 ticket is a 'MemberOf'
992
993 =cut
994
995 sub MemberOf {
996     my $self = shift;
997     return ( $self->_Links( 'Base', 'MemberOf' ) );
998 }
999
1000
1001
1002 =head2 RefersTo
1003
1004   This returns an RT::Links object which shows all references for which this ticket is a base
1005
1006 =cut
1007
1008 sub RefersTo {
1009     my $self = shift;
1010     return ( $self->_Links( 'Base', 'RefersTo' ) );
1011 }
1012
1013
1014
1015 =head2 ReferredToBy
1016
1017 This returns an L<RT::Links> object which shows all references for which this ticket is a target
1018
1019 =cut
1020
1021 sub ReferredToBy {
1022     my $self = shift;
1023     return ( $self->_Links( 'Target', 'RefersTo' ) );
1024 }
1025
1026
1027
1028 =head2 DependedOnBy
1029
1030   This returns an RT::Links object which references all the tickets that depend on this one
1031
1032 =cut
1033
1034 sub DependedOnBy {
1035     my $self = shift;
1036     return ( $self->_Links( 'Target', 'DependsOn' ) );
1037 }
1038
1039
1040
1041
1042 =head2 HasUnresolvedDependencies
1043
1044 Takes a paramhash of Type (default to '__any').  Returns the number of
1045 unresolved dependencies, if $self->UnresolvedDependencies returns an
1046 object with one or more members of that type.  Returns false
1047 otherwise.
1048
1049 =cut
1050
1051 sub HasUnresolvedDependencies {
1052     my $self = shift;
1053     my %args = (
1054         Type   => undef,
1055         @_
1056     );
1057
1058     my $deps = $self->UnresolvedDependencies;
1059
1060     if ($args{Type}) {
1061         $deps->Limit( FIELD => 'Type', 
1062               OPERATOR => '=',
1063               VALUE => $args{Type}); 
1064     }
1065     else {
1066             $deps->IgnoreType;
1067     }
1068
1069     if ($deps->Count > 0) {
1070         return $deps->Count;
1071     }
1072     else {
1073         return (undef);
1074     }
1075 }
1076
1077
1078
1079 =head2 UnresolvedDependencies
1080
1081 Returns an RT::Tickets object of tickets which this ticket depends on
1082 and which have a status of new, open or stalled. (That list comes from
1083 RT::Queue->ActiveStatusArray
1084
1085 =cut
1086
1087
1088 sub UnresolvedDependencies {
1089     my $self = shift;
1090     my $deps = RT::Tickets->new($self->CurrentUser);
1091
1092     my @live_statuses = RT::Queue->ActiveStatusArray();
1093     foreach my $status (@live_statuses) {
1094         $deps->LimitStatus(VALUE => $status);
1095     }
1096     $deps->LimitDependedOnBy($self->Id);
1097
1098     return($deps);
1099
1100 }
1101
1102
1103
1104 =head2 AllDependedOnBy
1105
1106 Returns an array of RT::Ticket objects which (directly or indirectly)
1107 depends on this ticket; takes an optional 'Type' argument in the param
1108 hash, which will limit returned tickets to that type, as well as cause
1109 tickets with that type to serve as 'leaf' nodes that stops the recursive
1110 dependency search.
1111
1112 =cut
1113
1114 sub AllDependedOnBy {
1115     my $self = shift;
1116     return $self->_AllLinkedTickets( LinkType => 'DependsOn',
1117                                      Direction => 'Target', @_ );
1118 }
1119
1120 =head2 AllDependsOn
1121
1122 Returns an array of RT::Ticket objects which this ticket (directly or
1123 indirectly) depends on; takes an optional 'Type' argument in the param
1124 hash, which will limit returned tickets to that type, as well as cause
1125 tickets with that type to serve as 'leaf' nodes that stops the
1126 recursive dependency search.
1127
1128 =cut
1129
1130 sub AllDependsOn {
1131     my $self = shift;
1132     return $self->_AllLinkedTickets( LinkType => 'DependsOn',
1133                                      Direction => 'Base', @_ );
1134 }
1135
1136 sub _AllLinkedTickets {
1137     my $self = shift;
1138
1139     my %args = (
1140         LinkType  => undef,
1141         Direction => undef,
1142         Type   => undef,
1143         _found => {},
1144         _top   => 1,
1145         @_
1146     );
1147
1148     my $dep = $self->_Links( $args{Direction}, $args{LinkType});
1149     while (my $link = $dep->Next()) {
1150         my $uri = $args{Direction} eq 'Target' ? $link->BaseURI : $link->TargetURI;
1151         next unless ($uri->IsLocal());
1152         my $obj = $args{Direction} eq 'Target' ? $link->BaseObj : $link->TargetObj;
1153         next if $args{_found}{$obj->Id};
1154
1155         if (!$args{Type}) {
1156             $args{_found}{$obj->Id} = $obj;
1157             $obj->_AllLinkedTickets( %args, _top => 0 );
1158         }
1159         elsif ($obj->Type and $obj->Type eq $args{Type}) {
1160             $args{_found}{$obj->Id} = $obj;
1161         }
1162         else {
1163             $obj->_AllLinkedTickets( %args, _top => 0 );
1164         }
1165     }
1166
1167     if ($args{_top}) {
1168         return map { $args{_found}{$_} } sort keys %{$args{_found}};
1169     }
1170     else {
1171         return 1;
1172     }
1173 }
1174
1175
1176
1177 =head2 DependsOn
1178
1179   This returns an RT::Links object which references all the tickets that this ticket depends on
1180
1181 =cut
1182
1183 sub DependsOn {
1184     my $self = shift;
1185     return ( $self->_Links( 'Base', 'DependsOn' ) );
1186 }
1187
1188
1189
1190
1191
1192
1193 =head2 Links DIRECTION [TYPE]
1194
1195 Return links (L<RT::Links>) to/from this object.
1196
1197 DIRECTION is either 'Base' or 'Target'.
1198
1199 TYPE is a type of links to return, it can be omitted to get
1200 links of any type.
1201
1202 =cut
1203
1204 sub Links { shift->_Links(@_) }
1205
1206 sub _Links {
1207     my $self = shift;
1208
1209     #TODO: Field isn't the right thing here. but I ahave no idea what mnemonic ---
1210     #tobias meant by $f
1211     my $field = shift;
1212     my $type  = shift || "";
1213
1214     unless ( $self->{"$field$type"} ) {
1215         $self->{"$field$type"} = RT::Links->new( $self->CurrentUser );
1216             # at least to myself
1217             $self->{"$field$type"}->Limit( FIELD => $field,
1218                                            VALUE => $self->URI,
1219                                            ENTRYAGGREGATOR => 'OR' );
1220             $self->{"$field$type"}->Limit( FIELD => 'Type',
1221                                            VALUE => $type )
1222               if ($type);
1223     }
1224     return ( $self->{"$field$type"} );
1225 }
1226
1227
1228
1229
1230 =head2 FormatType
1231
1232 Takes a Type and returns a string that is more human readable.
1233
1234 =cut
1235
1236 sub FormatType{
1237     my $self = shift;
1238     my %args = ( Type => '',
1239                  @_
1240                );
1241     $args{Type} =~ s/([A-Z])/" " . lc $1/ge;
1242     $args{Type} =~ s/^\s+//;
1243     return $args{Type};
1244 }
1245
1246
1247
1248
1249 =head2 FormatLink
1250
1251 Takes either a Target or a Base and returns a string of human friendly text.
1252
1253 =cut
1254
1255 sub FormatLink {
1256     my $self = shift;
1257     my %args = ( Object => undef,
1258                  FallBack => '',
1259                  @_
1260                );
1261     my $text = "URI " . $args{FallBack};
1262     if ($args{Object} && $args{Object}->isa("RT::Ticket")) {
1263         $text = "Ticket " . $args{Object}->id;
1264     }
1265     return $text;
1266 }
1267
1268
1269
1270 =head2 _AddLink
1271
1272 Takes a paramhash of Type and one of Base or Target. Adds that link to this object.
1273
1274 Returns C<link id>, C<message> and C<exist> flag.
1275
1276
1277 =cut
1278
1279 sub _AddLink {
1280     my $self = shift;
1281     my %args = ( Target => '',
1282                  Base   => '',
1283                  Type   => '',
1284                  Silent => undef,
1285                  @_ );
1286
1287
1288     # Remote_link is the URI of the object that is not this ticket
1289     my $remote_link;
1290     my $direction;
1291
1292     if ( $args{'Base'} and $args{'Target'} ) {
1293         $RT::Logger->debug( "$self tried to create a link. both base and target were specified" );
1294         return ( 0, $self->loc("Can't specifiy both base and target") );
1295     }
1296     elsif ( $args{'Base'} ) {
1297         $args{'Target'} = $self->URI();
1298         $remote_link    = $args{'Base'};
1299         $direction      = 'Target';
1300     }
1301     elsif ( $args{'Target'} ) {
1302         $args{'Base'} = $self->URI();
1303         $remote_link  = $args{'Target'};
1304         $direction    = 'Base';
1305     }
1306     else {
1307         return ( 0, $self->loc('Either base or target must be specified') );
1308     }
1309
1310     # Check if the link already exists - we don't want duplicates
1311     use RT::Link;
1312     my $old_link = RT::Link->new( $self->CurrentUser );
1313     $old_link->LoadByParams( Base   => $args{'Base'},
1314                              Type   => $args{'Type'},
1315                              Target => $args{'Target'} );
1316     if ( $old_link->Id ) {
1317         $RT::Logger->debug("$self Somebody tried to duplicate a link");
1318         return ( $old_link->id, $self->loc("Link already exists"), 1 );
1319     }
1320
1321     # }}}
1322
1323
1324     # Storing the link in the DB.
1325     my $link = RT::Link->new( $self->CurrentUser );
1326     my ($linkid, $linkmsg) = $link->Create( Target => $args{Target},
1327                                   Base   => $args{Base},
1328                                   Type   => $args{Type} );
1329
1330     unless ($linkid) {
1331         $RT::Logger->error("Link could not be created: ".$linkmsg);
1332         return ( 0, $self->loc("Link could not be created") );
1333     }
1334
1335     my $basetext = $self->FormatLink(Object => $link->BaseObj,
1336                                      FallBack => $args{Base});
1337     my $targettext = $self->FormatLink(Object => $link->TargetObj,
1338                                        FallBack => $args{Target});
1339     my $typetext = $self->FormatType(Type => $args{Type});
1340     my $TransString =
1341       "$basetext $typetext $targettext.";
1342     return ( $linkid, $TransString ) ;
1343 }
1344
1345
1346
1347 =head2 _DeleteLink
1348
1349 Delete a link. takes a paramhash of Base, Target and Type.
1350 Either Base or Target must be null. The null value will 
1351 be replaced with this ticket\'s id
1352
1353 =cut 
1354
1355 sub _DeleteLink {
1356     my $self = shift;
1357     my %args = (
1358         Base   => undef,
1359         Target => undef,
1360         Type   => undef,
1361         @_
1362     );
1363
1364     #we want one of base and target. we don't care which
1365     #but we only want _one_
1366
1367     my $direction;
1368     my $remote_link;
1369
1370     if ( $args{'Base'} and $args{'Target'} ) {
1371         $RT::Logger->debug("$self ->_DeleteLink. got both Base and Target");
1372         return ( 0, $self->loc("Can't specifiy both base and target") );
1373     }
1374     elsif ( $args{'Base'} ) {
1375         $args{'Target'} = $self->URI();
1376         $remote_link = $args{'Base'};
1377         $direction = 'Target';
1378     }
1379     elsif ( $args{'Target'} ) {
1380         $args{'Base'} = $self->URI();
1381         $remote_link = $args{'Target'};
1382         $direction='Base';
1383     }
1384     else {
1385         $RT::Logger->error("Base or Target must be specified");
1386         return ( 0, $self->loc('Either base or target must be specified') );
1387     }
1388
1389     my $link = RT::Link->new( $self->CurrentUser );
1390     $RT::Logger->debug( "Trying to load link: " . $args{'Base'} . " " . $args{'Type'} . " " . $args{'Target'} );
1391
1392
1393     $link->LoadByParams( Base=> $args{'Base'}, Type=> $args{'Type'}, Target=>  $args{'Target'} );
1394     #it's a real link. 
1395
1396     if ( $link->id ) {
1397         my $basetext = $self->FormatLink(Object => $link->BaseObj,
1398                                      FallBack => $args{Base});
1399         my $targettext = $self->FormatLink(Object => $link->TargetObj,
1400                                        FallBack => $args{Target});
1401         my $typetext = $self->FormatType(Type => $args{Type});
1402         my $linkid = $link->id;
1403         $link->Delete();
1404         my $TransString = "$basetext no longer $typetext $targettext.";
1405         return ( 1, $TransString);
1406     }
1407
1408     #if it's not a link we can find
1409     else {
1410         $RT::Logger->debug("Couldn't find that link");
1411         return ( 0, $self->loc("Link not found") );
1412     }
1413 }
1414
1415
1416
1417
1418
1419 =head2 _NewTransaction  PARAMHASH
1420
1421 Private function to create a new RT::Transaction object for this ticket update
1422
1423 =cut
1424
1425 sub _NewTransaction {
1426     my $self = shift;
1427     my %args = (
1428         TimeTaken => undef,
1429         Type      => undef,
1430         OldValue  => undef,
1431         NewValue  => undef,
1432         OldReference  => undef,
1433         NewReference  => undef,
1434         ReferenceType => undef,
1435         Data      => undef,
1436         Field     => undef,
1437         MIMEObj   => undef,
1438         ActivateScrips => 1,
1439         CommitScrips => 1,
1440         SquelchMailTo => undef,
1441         @_
1442     );
1443
1444     my $old_ref = $args{'OldReference'};
1445     my $new_ref = $args{'NewReference'};
1446     my $ref_type = $args{'ReferenceType'};
1447     if ($old_ref or $new_ref) {
1448         $ref_type ||= ref($old_ref) || ref($new_ref);
1449         if (!$ref_type) {
1450             $RT::Logger->error("Reference type not specified for transaction");
1451             return;
1452         }
1453         $old_ref = $old_ref->Id if ref($old_ref);
1454         $new_ref = $new_ref->Id if ref($new_ref);
1455     }
1456
1457     require RT::Transaction;
1458     my $trans = RT::Transaction->new( $self->CurrentUser );
1459     my ( $transaction, $msg ) = $trans->Create(
1460         ObjectId  => $self->Id,
1461         ObjectType => ref($self),
1462         TimeTaken => $args{'TimeTaken'},
1463         Type      => $args{'Type'},
1464         Data      => $args{'Data'},
1465         Field     => $args{'Field'},
1466         NewValue  => $args{'NewValue'},
1467         OldValue  => $args{'OldValue'},
1468         NewReference  => $new_ref,
1469         OldReference  => $old_ref,
1470         ReferenceType => $ref_type,
1471         MIMEObj   => $args{'MIMEObj'},
1472         ActivateScrips => $args{'ActivateScrips'},
1473         CommitScrips => $args{'CommitScrips'},
1474         SquelchMailTo => $args{'SquelchMailTo'},
1475     );
1476
1477     # Rationalize the object since we may have done things to it during the caching.
1478     $self->Load($self->Id);
1479
1480     $RT::Logger->warning($msg) unless $transaction;
1481
1482     $self->_SetLastUpdated;
1483
1484     if ( defined $args{'TimeTaken'} and $self->can('_UpdateTimeTaken')) {
1485         $self->_UpdateTimeTaken( $args{'TimeTaken'} );
1486     }
1487     if ( RT->Config->Get('UseTransactionBatch') and $transaction ) {
1488             push @{$self->{_TransactionBatch}}, $trans if $args{'CommitScrips'};
1489     }
1490     return ( $transaction, $msg, $trans );
1491 }
1492
1493
1494
1495 =head2 Transactions
1496
1497   Returns an RT::Transactions object of all transactions on this record object
1498
1499 =cut
1500
1501 sub Transactions {
1502     my $self = shift;
1503
1504     use RT::Transactions;
1505     my $transactions = RT::Transactions->new( $self->CurrentUser );
1506
1507     #If the user has no rights, return an empty object
1508     $transactions->Limit(
1509         FIELD => 'ObjectId',
1510         VALUE => $self->id,
1511     );
1512     $transactions->Limit(
1513         FIELD => 'ObjectType',
1514         VALUE => ref($self),
1515     );
1516
1517     return ($transactions);
1518 }
1519
1520 #
1521
1522 sub CustomFields {
1523     my $self = shift;
1524     my $cfs  = RT::CustomFields->new( $self->CurrentUser );
1525     
1526     $cfs->SetContextObject( $self );
1527     # XXX handle multiple types properly
1528     $cfs->LimitToLookupType( $self->CustomFieldLookupType );
1529     $cfs->LimitToGlobalOrObjectId(
1530         $self->_LookupId( $self->CustomFieldLookupType )
1531     );
1532     $cfs->ApplySortOrder;
1533
1534     return $cfs;
1535 }
1536
1537 # TODO: This _only_ works for RT::Class classes. it doesn't work, for example,
1538 # for RT::IR classes.
1539
1540 sub _LookupId {
1541     my $self = shift;
1542     my $lookup = shift;
1543     my @classes = ($lookup =~ /RT::(\w+)-/g);
1544
1545     my $object = $self;
1546     foreach my $class (reverse @classes) {
1547         my $method = "${class}Obj";
1548         $object = $object->$method;
1549     }
1550
1551     return $object->Id;
1552 }
1553
1554
1555 =head2 CustomFieldLookupType 
1556
1557 Returns the path RT uses to figure out which custom fields apply to this object.
1558
1559 =cut
1560
1561 sub CustomFieldLookupType {
1562     my $self = shift;
1563     return ref($self);
1564 }
1565
1566
1567 =head2 AddCustomFieldValue { Field => FIELD, Value => VALUE }
1568
1569 VALUE should be a string. FIELD can be any identifier of a CustomField
1570 supported by L</LoadCustomFieldByIdentifier> method.
1571
1572 Adds VALUE as a value of CustomField FIELD. If this is a single-value custom field,
1573 deletes the old value.
1574 If VALUE is not a valid value for the custom field, returns 
1575 (0, 'Error message' ) otherwise, returns ($id, 'Success Message') where
1576 $id is ID of created L<ObjectCustomFieldValue> object.
1577
1578 =cut
1579
1580 sub AddCustomFieldValue {
1581     my $self = shift;
1582     $self->_AddCustomFieldValue(@_);
1583 }
1584
1585 sub _AddCustomFieldValue {
1586     my $self = shift;
1587     my %args = (
1588         Field             => undef,
1589         Value             => undef,
1590         LargeContent      => undef,
1591         ContentType       => undef,
1592         RecordTransaction => 1,
1593         @_
1594     );
1595
1596     my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
1597     unless ( $cf->Id ) {
1598         return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
1599     }
1600
1601     my $OCFs = $self->CustomFields;
1602     $OCFs->Limit( FIELD => 'id', VALUE => $cf->Id );
1603     unless ( $OCFs->Count ) {
1604         return (
1605             0,
1606             $self->loc(
1607                 "Custom field [_1] does not apply to this object",
1608                 $args{'Field'}
1609             )
1610         );
1611     }
1612
1613     # empty string is not correct value of any CF, so undef it
1614     foreach ( qw(Value LargeContent) ) {
1615         $args{ $_ } = undef if defined $args{ $_ } && !length $args{ $_ };
1616     }
1617
1618     unless ( $cf->ValidateValue( $args{'Value'} ) ) {
1619         return ( 0, $self->loc("Invalid value for custom field") );
1620     }
1621
1622     # If the custom field only accepts a certain # of values, delete the existing
1623     # value and record a "changed from foo to bar" transaction
1624     unless ( $cf->UnlimitedValues ) {
1625
1626         # Load up a ObjectCustomFieldValues object for this custom field and this ticket
1627         my $values = $cf->ValuesForObject($self);
1628
1629         # We need to whack any old values here.  In most cases, the custom field should
1630         # only have one value to delete.  In the pathalogical case, this custom field
1631         # used to be a multiple and we have many values to whack....
1632         my $cf_values = $values->Count;
1633
1634         if ( $cf_values > $cf->MaxValues ) {
1635             my $i = 0;   #We want to delete all but the max we can currently have , so we can then
1636                  # execute the same code to "change" the value from old to new
1637             while ( my $value = $values->Next ) {
1638                 $i++;
1639                 if ( $i < $cf_values ) {
1640                     my ( $val, $msg ) = $cf->DeleteValueForObject(
1641                         Object  => $self,
1642                         Content => $value->Content
1643                     );
1644                     unless ($val) {
1645                         return ( 0, $msg );
1646                     }
1647                     my ( $TransactionId, $Msg, $TransactionObj ) =
1648                       $self->_NewTransaction(
1649                         Type         => 'CustomField',
1650                         Field        => $cf->Id,
1651                         OldReference => $value,
1652                       );
1653                 }
1654             }
1655             $values->RedoSearch if $i; # redo search if have deleted at least one value
1656         }
1657
1658         my ( $old_value, $old_content );
1659         if ( $old_value = $values->First ) {
1660             $old_content = $old_value->Content;
1661             $old_content = undef if defined $old_content && !length $old_content;
1662
1663             my $is_the_same = 1;
1664             if ( defined $args{'Value'} ) {
1665                 $is_the_same = 0 unless defined $old_content
1666                     && lc $old_content eq lc $args{'Value'};
1667             } else {
1668                 $is_the_same = 0 if defined $old_content;
1669             }
1670             if ( $is_the_same ) {
1671                 my $old_content = $old_value->LargeContent;
1672                 if ( defined $args{'LargeContent'} ) {
1673                     $is_the_same = 0 unless defined $old_content
1674                         && $old_content eq $args{'LargeContent'};
1675                 } else {
1676                     $is_the_same = 0 if defined $old_content;
1677                 }
1678             }
1679
1680             return $old_value->id if $is_the_same;
1681         }
1682
1683         my ( $new_value_id, $value_msg ) = $cf->AddValueForObject(
1684             Object       => $self,
1685             Content      => $args{'Value'},
1686             LargeContent => $args{'LargeContent'},
1687             ContentType  => $args{'ContentType'},
1688         );
1689
1690         unless ( $new_value_id ) {
1691             return ( 0, $self->loc( "Could not add new custom field value: [_1]", $value_msg ) );
1692         }
1693
1694         my $new_value = RT::ObjectCustomFieldValue->new( $self->CurrentUser );
1695         $new_value->Load( $new_value_id );
1696
1697         # now that adding the new value was successful, delete the old one
1698         if ( $old_value ) {
1699             my ( $val, $msg ) = $old_value->Delete();
1700             return ( 0, $msg ) unless $val;
1701         }
1702
1703         if ( $args{'RecordTransaction'} ) {
1704             my ( $TransactionId, $Msg, $TransactionObj ) =
1705               $self->_NewTransaction(
1706                 Type         => 'CustomField',
1707                 Field        => $cf->Id,
1708                 OldReference => $old_value,
1709                 NewReference => $new_value,
1710               );
1711         }
1712
1713         my $new_content = $new_value->Content;
1714
1715         # For datetime, we need to display them in "human" format in result message
1716         #XXX TODO how about date without time?
1717         if ($cf->Type eq 'DateTime') {
1718             my $DateObj = RT::Date->new( $self->CurrentUser );
1719             $DateObj->Set(
1720                 Format => 'ISO',
1721                 Value  => $new_content,
1722             );
1723             $new_content = $DateObj->AsString;
1724
1725             if ( defined $old_content && length $old_content ) {
1726                 $DateObj->Set(
1727                     Format => 'ISO',
1728                     Value  => $old_content,
1729                 );
1730                 $old_content = $DateObj->AsString;
1731             }
1732         }
1733
1734         unless ( defined $old_content && length $old_content ) {
1735             return ( $new_value_id, $self->loc( "[_1] [_2] added", $cf->Name, $new_content ));
1736         }
1737         elsif ( !defined $new_content || !length $new_content ) {
1738             return ( $new_value_id,
1739                 $self->loc( "[_1] [_2] deleted", $cf->Name, $old_content ) );
1740         }
1741         else {
1742             return ( $new_value_id, $self->loc( "[_1] [_2] changed to [_3]", $cf->Name, $old_content, $new_content));
1743         }
1744
1745     }
1746
1747     # otherwise, just add a new value and record "new value added"
1748     else {
1749         my ($new_value_id, $msg) = $cf->AddValueForObject(
1750             Object       => $self,
1751             Content      => $args{'Value'},
1752             LargeContent => $args{'LargeContent'},
1753             ContentType  => $args{'ContentType'},
1754         );
1755
1756         unless ( $new_value_id ) {
1757             return ( 0, $self->loc( "Could not add new custom field value: [_1]", $msg ) );
1758         }
1759         if ( $args{'RecordTransaction'} ) {
1760             my ( $tid, $msg ) = $self->_NewTransaction(
1761                 Type          => 'CustomField',
1762                 Field         => $cf->Id,
1763                 NewReference  => $new_value_id,
1764                 ReferenceType => 'RT::ObjectCustomFieldValue',
1765             );
1766             unless ( $tid ) {
1767                 return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $msg ) );
1768             }
1769         }
1770         return ( $new_value_id, $self->loc( "[_1] added as a value for [_2]", $args{'Value'}, $cf->Name ) );
1771     }
1772 }
1773
1774
1775
1776 =head2 DeleteCustomFieldValue { Field => FIELD, Value => VALUE }
1777
1778 Deletes VALUE as a value of CustomField FIELD. 
1779
1780 VALUE can be a string, a CustomFieldValue or a ObjectCustomFieldValue.
1781
1782 If VALUE is not a valid value for the custom field, returns 
1783 (0, 'Error message' ) otherwise, returns (1, 'Success Message')
1784
1785 =cut
1786
1787 sub DeleteCustomFieldValue {
1788     my $self = shift;
1789     my %args = (
1790         Field   => undef,
1791         Value   => undef,
1792         ValueId => undef,
1793         @_
1794     );
1795
1796     my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
1797     unless ( $cf->Id ) {
1798         return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
1799     }
1800
1801     my ( $val, $msg ) = $cf->DeleteValueForObject(
1802         Object  => $self,
1803         Id      => $args{'ValueId'},
1804         Content => $args{'Value'},
1805     );
1806     unless ($val) {
1807         return ( 0, $msg );
1808     }
1809
1810     my ( $TransactionId, $Msg, $TransactionObj ) = $self->_NewTransaction(
1811         Type          => 'CustomField',
1812         Field         => $cf->Id,
1813         OldReference  => $val,
1814         ReferenceType => 'RT::ObjectCustomFieldValue',
1815     );
1816     unless ($TransactionId) {
1817         return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $Msg ) );
1818     }
1819
1820     my $old_value = $TransactionObj->OldValue;
1821     # For datetime, we need to display them in "human" format in result message
1822     if ( $cf->Type eq 'DateTime' ) {
1823         my $DateObj = RT::Date->new( $self->CurrentUser );
1824         $DateObj->Set(
1825             Format => 'ISO',
1826             Value  => $old_value,
1827         );
1828         $old_value = $DateObj->AsString;
1829     }
1830     return (
1831         $TransactionId,
1832         $self->loc(
1833             "[_1] is no longer a value for custom field [_2]",
1834             $old_value, $cf->Name
1835         )
1836     );
1837 }
1838
1839
1840
1841 =head2 FirstCustomFieldValue FIELD
1842
1843 Return the content of the first value of CustomField FIELD for this ticket
1844 Takes a field id or name
1845
1846 =cut
1847
1848 sub FirstCustomFieldValue {
1849     my $self = shift;
1850     my $field = shift;
1851
1852     my $values = $self->CustomFieldValues( $field );
1853     return undef unless my $first = $values->First;
1854     return $first->Content;
1855 }
1856
1857 =head2 CustomFieldValuesAsString FIELD
1858
1859 Return the content of the CustomField FIELD for this ticket.
1860 If this is a multi-value custom field, values will be joined with newlines.
1861
1862 Takes a field id or name as the first argument
1863
1864 Takes an optional Separator => "," second and third argument
1865 if you want to join the values using something other than a newline
1866
1867 =cut
1868
1869 sub CustomFieldValuesAsString {
1870     my $self  = shift;
1871     my $field = shift;
1872     my %args  = @_;
1873     my $separator = $args{Separator} || "\n";
1874
1875     my $values = $self->CustomFieldValues( $field );
1876     return join ($separator, grep { defined $_ }
1877                  map { $_->Content } @{$values->ItemsArrayRef});
1878 }
1879
1880
1881
1882 =head2 CustomFieldValues FIELD
1883
1884 Return a ObjectCustomFieldValues object of all values of the CustomField whose 
1885 id or Name is FIELD for this record.
1886
1887 Returns an RT::ObjectCustomFieldValues object
1888
1889 =cut
1890
1891 sub CustomFieldValues {
1892     my $self  = shift;
1893     my $field = shift;
1894
1895     if ( $field ) {
1896         my $cf = $self->LoadCustomFieldByIdentifier( $field );
1897
1898         # we were asked to search on a custom field we couldn't find
1899         unless ( $cf->id ) {
1900             $RT::Logger->warning("Couldn't load custom field by '$field' identifier");
1901             return RT::ObjectCustomFieldValues->new( $self->CurrentUser );
1902         }
1903         return ( $cf->ValuesForObject($self) );
1904     }
1905
1906     # we're not limiting to a specific custom field;
1907     my $ocfs = RT::ObjectCustomFieldValues->new( $self->CurrentUser );
1908     $ocfs->LimitToObject( $self );
1909     return $ocfs;
1910 }
1911
1912 =head2 LoadCustomFieldByIdentifier IDENTIFER
1913
1914 Find the custom field has id or name IDENTIFIER for this object.
1915
1916 If no valid field is found, returns an empty RT::CustomField object.
1917
1918 =cut
1919
1920 sub LoadCustomFieldByIdentifier {
1921     my $self = shift;
1922     my $field = shift;
1923     
1924     my $cf;
1925     if ( UNIVERSAL::isa( $field, "RT::CustomField" ) ) {
1926         $cf = RT::CustomField->new($self->CurrentUser);
1927         $cf->SetContextObject( $self );
1928         $cf->LoadById( $field->id );
1929     }
1930     elsif ($field =~ /^\d+$/) {
1931         $cf = RT::CustomField->new($self->CurrentUser);
1932         $cf->SetContextObject( $self );
1933         $cf->LoadById($field);
1934     } else {
1935
1936         my $cfs = $self->CustomFields($self->CurrentUser);
1937         $cfs->SetContextObject( $self );
1938         $cfs->Limit(FIELD => 'Name', VALUE => $field, CASESENSITIVE => 0);
1939         $cf = $cfs->First || RT::CustomField->new($self->CurrentUser);
1940     }
1941     return $cf;
1942 }
1943
1944 sub ACLEquivalenceObjects { } 
1945
1946 sub BasicColumns { }
1947
1948 sub WikiBase {
1949     return RT->Config->Get('WebPath'). "/index.html?q=";
1950 }
1951
1952 RT::Base->_ImportOverlays();
1953
1954 1;