rt/lib/RT/Record.pm

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