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)};
 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 " . length($Body) . "\n" . "It started: " . substr( $Body, 0, 60 ) . "\n" );
 821                 return ("none", "Large attachment dropped" );
 822             }
 823         }
 824
 825         # if we need to mimencode the attachment
 826         if ( $ContentEncoding eq 'base64' ) {
 827
 828             # base64 encode the attachment
 829             Encode::_utf8_off($Body);
 830             $Body = MIME::Base64::encode_base64($Body);
 831
 832         } elsif ($ContentEncoding eq 'quoted-printable') {
 833             Encode::_utf8_off($Body);
 834             $Body = MIME::QuotedPrint::encode($Body);
 835         }
 836
 837
 838         return ($ContentEncoding, $Body);
 839
 840 }
 841
 842 sub _DecodeLOB {
 843     my $self            = shift;
 844     my $ContentType     = shift;
 845     my $ContentEncoding = shift;
 846     my $Content         = shift;
 847
 848     if ( $ContentEncoding eq 'base64' ) {
 849         $Content = MIME::Base64::decode_base64($Content);
 850     }
 851     elsif ( $ContentEncoding eq 'quoted-printable' ) {
 852         $Content = MIME::QuotedPrint::decode($Content);
 853     }
 854     elsif ( $ContentEncoding && $ContentEncoding ne 'none' ) {
 855         return ( $self->loc( "Unknown ContentEncoding [_1]", $ContentEncoding ) );
 856     }
 857     if ( $ContentType eq 'text/plain' ) {
 858        $Content = Encode::decode_utf8($Content) unless Encode::is_utf8($Content);
 859     }
 860         return ($Content);
 861 }
 862
 863 # {{{ LINKDIRMAP
 864 # A helper table for links mapping to make it easier
 865 # to build and parse links between tickets
 866
 867 use vars '%LINKDIRMAP';
 868
 869 %LINKDIRMAP = (
 870     MemberOf => { Base => 'MemberOf',
 871                   Target => 'HasMember', },
 872     RefersTo => { Base => 'RefersTo',
 873                 Target => 'ReferredToBy', },
 874     DependsOn => { Base => 'DependsOn',
 875                    Target => 'DependedOnBy', },
 876     MergedInto => { Base => 'MergedInto',
 877                    Target => 'MergedInto', },
 878
 879 );
 880
 881 sub Update {
 882     my $self = shift;
 883
 884     my %args = (
 885         ARGSRef         => undef,
 886         AttributesRef   => undef,
 887         AttributePrefix => undef,
 888         @_
 889     );
 890
 891     my $attributes = $args{'AttributesRef'};
 892     my $ARGSRef    = $args{'ARGSRef'};
 893     my @results;
 894
 895     foreach my $attribute (@$attributes) {
 896         my $value;
 897         if ( defined $ARGSRef->{$attribute} ) {
 898             $value = $ARGSRef->{$attribute};
 899         }
 900         elsif (
 901             defined( $args{'AttributePrefix'} )
 902             && defined(
 903                 $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute }
 904             )
 905           ) {
 906             $value = $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute };
 907
 908         }
 909         else {
 910             next;
 911         }
 912
 913         $value =~ s/\r\n/\n/gs;
 914
 915
 916         # If Queue is 'General', we want to resolve the queue name for
 917         # the object.
 918
 919         # This is in an eval block because $object might not exist.
 920         # and might not have a Name method. But "can" won't find autoloaded
 921         # items. If it fails, we don't care
 922         eval {
 923             my $object = $attribute . "Obj";
 924             next if ($self->$object->Name eq $value);
 925         };
 926         next if ( $value eq $self->$attribute() );
 927         my $method = "Set$attribute";
 928         my ( $code, $msg ) = $self->$method($value);
 929         my ($prefix) = ref($self) =~ /RT::(\w+)/;
 930
 931         # Default to $id, but use name if we can get it.
 932         my $label = $self->id;
 933         $label = $self->Name if (UNIVERSAL::can($self,'Name'));
 934         push @results, $self->loc( "$prefix [_1]", $label ) . ': '. $msg;
 935
 936 =for loc
 937
 938                                    "[_1] could not be set to [_2].",       # loc
 939                                    "That is already the current value",    # loc
 940                                    "No value sent to _Set!\n",             # loc
 941                                    "Illegal value for [_1]",               # loc
 942                                    "The new value has been set.",          # loc
 943                                    "No column specified",                  # loc
 944                                    "Immutable field",                      # loc
 945                                    "Nonexistant field?",                   # loc
 946                                    "Invalid data",                         # loc
 947                                    "Couldn't find row",                    # loc
 948                                    "Missing a primary key?: [_1]",         # loc
 949                                    "Found Object",                         # loc
 950
 951 =cut
 952
 953     }
 954
 955     return @results;
 956 }
 957
 958 # {{{ Routines dealing with Links
 959
 960 # {{{ Link Collections
 961
 962 # {{{ sub Members
 963
 964 =head2 Members
 965
 966   This returns an RT::Links object which references all the tickets
 967 which are 'MembersOf' this ticket
 968
 969 =cut
 970
 971 sub Members {
 972     my $self = shift;
 973     return ( $self->_Links( 'Target', 'MemberOf' ) );
 974 }
 975
 976 # }}}
 977
 978 # {{{ sub MemberOf
 979
 980 =head2 MemberOf
 981
 982   This returns an RT::Links object which references all the tickets that this
 983 ticket is a 'MemberOf'
 984
 985 =cut
 986
 987 sub MemberOf {
 988     my $self = shift;
 989     return ( $self->_Links( 'Base', 'MemberOf' ) );
 990 }
 991
 992 # }}}
 993
 994 # {{{ RefersTo
 995
 996 =head2 RefersTo
 997
 998   This returns an RT::Links object which shows all references for which this ticket is a base
 999
1000 =cut
1001
1002 sub RefersTo {
1003     my $self = shift;
1004     return ( $self->_Links( 'Base', 'RefersTo' ) );
1005 }
1006
1007 # }}}
1008
1009 # {{{ ReferredToBy
1010
1011 =head2 ReferredToBy
1012
1013   This returns an RT::Links object which shows all references for which this ticket is a target
1014
1015 =cut
1016
1017 sub ReferredToBy {
1018     my $self = shift;
1019     return ( $self->_Links( 'Target', 'RefersTo' ) );
1020 }
1021
1022 # }}}
1023
1024 # {{{ DependedOnBy
1025
1026 =head2 DependedOnBy
1027
1028   This returns an RT::Links object which references all the tickets that depend on this one
1029
1030 =cut
1031
1032 sub DependedOnBy {
1033     my $self = shift;
1034     return ( $self->_Links( 'Target', 'DependsOn' ) );
1035 }
1036
1037 # }}}
1038
1039
1040
1041 =head2 HasUnresolvedDependencies
1042
1043   Takes a paramhash of Type (default to '__any').  Returns true if
1044 $self->UnresolvedDependencies returns an object with one or more members
1045 of that type.  Returns false otherwise
1046
1047
1048 =begin testing
1049
1050 my $t1 = RT::Ticket->new($RT::SystemUser);
1051 my ($id, $trans, $msg) = $t1->Create(Subject => 'DepTest1', Queue => 'general');
1052 ok($id, "Created dep test 1 - $msg");
1053
1054 my $t2 = RT::Ticket->new($RT::SystemUser);
1055 my ($id2, $trans, $msg2) = $t2->Create(Subject => 'DepTest2', Queue => 'general');
1056 ok($id2, "Created dep test 2 - $msg2");
1057 my $t3 = RT::Ticket->new($RT::SystemUser);
1058 my ($id3, $trans, $msg3) = $t3->Create(Subject => 'DepTest3', Queue => 'general', Type => 'approval');
1059 ok($id3, "Created dep test 3 - $msg3");
1060 my ($addid, $addmsg);
1061 ok (($addid, $addmsg) =$t1->AddLink( Type => 'DependsOn', Target => $t2->id));
1062 ok ($addid, $addmsg);
1063 ok (($addid, $addmsg) =$t1->AddLink( Type => 'DependsOn', Target => $t3->id));
1064
1065 ok ($addid, $addmsg);
1066 my $link = RT::Link->new($RT::SystemUser);
1067 my ($rv, $msg) = $link->Load($addid);
1068 ok ($rv, $msg);
1069 ok ($link->LocalTarget == $t3->id, "Link LocalTarget is correct");
1070 ok ($link->LocalBase   == $t1->id, "Link LocalBase   is correct");
1071
1072 ok ($t1->HasUnresolvedDependencies, "Ticket ".$t1->Id." has unresolved deps");
1073 ok (!$t1->HasUnresolvedDependencies( Type => 'blah' ), "Ticket ".$t1->Id." has no unresolved blahs");
1074 ok ($t1->HasUnresolvedDependencies( Type => 'approval' ), "Ticket ".$t1->Id." has unresolved approvals");
1075 ok (!$t2->HasUnresolvedDependencies, "Ticket ".$t2->Id." has no unresolved deps");
1076 ;
1077
1078 my ($rid, $rmsg)= $t1->Resolve();
1079 ok(!$rid, $rmsg);
1080 my ($rid2, $rmsg2) = $t2->Resolve();
1081 ok ($rid2, $rmsg2);
1082 ($rid, $rmsg)= $t1->Resolve();
1083 ok(!$rid, $rmsg);
1084 my ($rid3,$rmsg3) = $t3->Resolve;
1085 ok ($rid3,$rmsg3);
1086 ($rid, $rmsg)= $t1->Resolve();
1087 ok($rid, $rmsg);
1088
1089
1090 =end testing
1091
1092 =cut
1093
1094 sub HasUnresolvedDependencies {
1095     my $self = shift;
1096     my %args = (
1097         Type   => undef,
1098         @_
1099     );
1100
1101     my $deps = $self->UnresolvedDependencies;
1102
1103     if ($args{Type}) {
1104         $deps->Limit( FIELD => 'Type',
1105               OPERATOR => '=',
1106               VALUE => $args{Type});
1107     }
1108     else {
1109             $deps->IgnoreType;
1110     }
1111
1112     if ($deps->Count > 0) {
1113         return 1;
1114     }
1115     else {
1116         return (undef);
1117     }
1118 }
1119
1120
1121 # {{{ UnresolvedDependencies
1122
1123 =head2 UnresolvedDependencies
1124
1125 Returns an RT::Tickets object of tickets which this ticket depends on
1126 and which have a status of new, open or stalled. (That list comes from
1127 RT::Queue->ActiveStatusArray
1128
1129 =cut
1130
1131
1132 sub UnresolvedDependencies {
1133     my $self = shift;
1134     my $deps = RT::Tickets->new($self->CurrentUser);
1135
1136     my @live_statuses = RT::Queue->ActiveStatusArray();
1137     foreach my $status (@live_statuses) {
1138         $deps->LimitStatus(VALUE => $status);
1139     }
1140     $deps->LimitDependedOnBy($self->Id);
1141
1142     return($deps);
1143
1144 }
1145
1146 # }}}
1147
1148 # {{{ AllDependedOnBy
1149
1150 =head2 AllDependedOnBy
1151
1152 Returns an array of RT::Ticket objects which (directly or indirectly)
1153 depends on this ticket; takes an optional 'Type' argument in the param
1154 hash, which will limit returned tickets to that type, as well as cause
1155 tickets with that type to serve as 'leaf' nodes that stops the recursive
1156 dependency search.
1157
1158 =cut
1159
1160 sub AllDependedOnBy {
1161     my $self = shift;
1162     my $dep = $self->DependedOnBy;
1163     my %args = (
1164         Type   => undef,
1165         _found => {},
1166         _top   => 1,
1167         @_
1168     );
1169
1170     while (my $link = $dep->Next()) {
1171         next unless ($link->BaseURI->IsLocal());
1172         next if $args{_found}{$link->BaseObj->Id};
1173
1174         if (!$args{Type}) {
1175             $args{_found}{$link->BaseObj->Id} = $link->BaseObj;
1176             $link->BaseObj->AllDependedOnBy( %args, _top => 0 );
1177         }
1178         elsif ($link->BaseObj->Type eq $args{Type}) {
1179             $args{_found}{$link->BaseObj->Id} = $link->BaseObj;
1180         }
1181         else {
1182             $link->BaseObj->AllDependedOnBy( %args, _top => 0 );
1183         }
1184     }
1185
1186     if ($args{_top}) {
1187         return map { $args{_found}{$_} } sort keys %{$args{_found}};
1188     }
1189     else {
1190         return 1;
1191     }
1192 }
1193
1194 # }}}
1195
1196 # {{{ DependsOn
1197
1198 =head2 DependsOn
1199
1200   This returns an RT::Links object which references all the tickets that this ticket depends on
1201
1202 =cut
1203
1204 sub DependsOn {
1205     my $self = shift;
1206     return ( $self->_Links( 'Base', 'DependsOn' ) );
1207 }
1208
1209 # }}}
1210
1211
1212
1213
1214 # {{{ sub _Links
1215
1216 =head2 Links DIRECTION TYPE
1217
1218 return links to/from this object.
1219
1220 =cut
1221
1222 *Links = \&_Links;
1223
1224 sub _Links {
1225     my $self = shift;
1226
1227     #TODO: Field isn't the right thing here. but I ahave no idea what mnemonic ---
1228     #tobias meant by $f
1229     my $field = shift;
1230     my $type  = shift || "";
1231
1232     unless ( $self->{"$field$type"} ) {
1233         $self->{"$field$type"} = new RT::Links( $self->CurrentUser );
1234             # at least to myself
1235             $self->{"$field$type"}->Limit( FIELD => $field,
1236                                            VALUE => $self->URI,
1237                                            ENTRYAGGREGATOR => 'OR' );
1238             $self->{"$field$type"}->Limit( FIELD => 'Type',
1239                                            VALUE => $type )
1240               if ($type);
1241     }
1242     return ( $self->{"$field$type"} );
1243 }
1244
1245 # }}}
1246
1247 # }}}
1248
1249 # {{{ sub _AddLink
1250
1251 =head2 _AddLink
1252
1253 Takes a paramhash of Type and one of Base or Target. Adds that link to this ticket.
1254
1255
1256 =cut
1257
1258
1259 sub _AddLink {
1260     my $self = shift;
1261     my %args = ( Target => '',
1262                  Base   => '',
1263                  Type   => '',
1264                  Silent => undef,
1265                  @_ );
1266
1267
1268     # Remote_link is the URI of the object that is not this ticket
1269     my $remote_link;
1270     my $direction;
1271
1272     if ( $args{'Base'} and $args{'Target'} ) {
1273         $RT::Logger->debug( "$self tried to create a link. both base and target were specified\n" );
1274         return ( 0, $self->loc("Can't specifiy both base and target") );
1275     }
1276     elsif ( $args{'Base'} ) {
1277         $args{'Target'} = $self->URI();
1278         my $class = ref($self);
1279         $remote_link    = $args{'Base'};
1280         $direction      = 'Target';
1281     }
1282     elsif ( $args{'Target'} ) {
1283         $args{'Base'} = $self->URI();
1284         my $class = ref($self);
1285         $remote_link  = $args{'Target'};
1286         $direction    = 'Base';
1287     }
1288     else {
1289         return ( 0, $self->loc('Either base or target must be specified') );
1290     }
1291
1292     # {{{ Check if the link already exists - we don't want duplicates
1293     use RT::Link;
1294     my $old_link = RT::Link->new( $self->CurrentUser );
1295     $old_link->LoadByParams( Base   => $args{'Base'},
1296                              Type   => $args{'Type'},
1297                              Target => $args{'Target'} );
1298     if ( $old_link->Id ) {
1299         $RT::Logger->debug("$self Somebody tried to duplicate a link");
1300         return ( $old_link->id, $self->loc("Link already exists") );
1301     }
1302
1303     # }}}
1304
1305
1306     # Storing the link in the DB.
1307     my $link = RT::Link->new( $self->CurrentUser );
1308     my ($linkid, $linkmsg) = $link->Create( Target => $args{Target},
1309                                   Base   => $args{Base},
1310                                   Type   => $args{Type} );
1311
1312     unless ($linkid) {
1313         $RT::Logger->error("Link could not be created: ".$linkmsg);
1314         return ( 0, $self->loc("Link could not be created") );
1315     }
1316
1317     my $TransString =
1318       "Record $args{'Base'} $args{Type} record $args{'Target'}.";
1319
1320     return ( $linkid, $self->loc( "Link created ([_1])", $TransString ) );
1321 }
1322
1323 # }}}
1324
1325 # {{{ sub _DeleteLink
1326
1327 =head2 _DeleteLink
1328
1329 Delete a link. takes a paramhash of Base, Target and Type.
1330 Either Base or Target must be null. The null value will
1331 be replaced with this ticket\'s id
1332
1333 =cut
1334
1335 sub _DeleteLink {
1336     my $self = shift;
1337     my %args = (
1338         Base   => undef,
1339         Target => undef,
1340         Type   => undef,
1341         @_
1342     );
1343
1344     #we want one of base and target. we don't care which
1345     #but we only want _one_
1346
1347     my $direction;
1348     my $remote_link;
1349
1350     if ( $args{'Base'} and $args{'Target'} ) {
1351         $RT::Logger->debug("$self ->_DeleteLink. got both Base and Target\n");
1352         return ( 0, $self->loc("Can't specifiy both base and target") );
1353     }
1354     elsif ( $args{'Base'} ) {
1355         $args{'Target'} = $self->URI();
1356         $remote_link = $args{'Base'};
1357         $direction = 'Target';
1358     }
1359     elsif ( $args{'Target'} ) {
1360         $args{'Base'} = $self->URI();
1361         $remote_link = $args{'Target'};
1362         $direction='Base';
1363     }
1364     else {
1365         $RT::Logger->debug("$self: Base or Target must be specified\n");
1366         return ( 0, $self->loc('Either base or target must be specified') );
1367     }
1368
1369     my $link = new RT::Link( $self->CurrentUser );
1370     $RT::Logger->debug( "Trying to load link: " . $args{'Base'} . " " . $args{'Type'} . " " . $args{'Target'} . "\n" );
1371
1372
1373     $link->LoadByParams( Base=> $args{'Base'}, Type=> $args{'Type'}, Target=>  $args{'Target'} );
1374     #it's a real link.
1375     if ( $link->id ) {
1376
1377         my $linkid = $link->id;
1378         $link->Delete();
1379
1380         my $TransString = "Record $args{'Base'} no longer $args{Type} record $args{'Target'}.";
1381         return ( 1, $self->loc("Link deleted ([_1])", $TransString));
1382     }
1383
1384     #if it's not a link we can find
1385     else {
1386         $RT::Logger->debug("Couldn't find that link\n");
1387         return ( 0, $self->loc("Link not found") );
1388     }
1389 }
1390
1391 # }}}
1392
1393 # }}}
1394
1395 # {{{ Routines dealing with transactions
1396
1397 # {{{ sub _NewTransaction
1398
1399 =head2 _NewTransaction  PARAMHASH
1400
1401 Private function to create a new RT::Transaction object for this ticket update
1402
1403 =cut
1404
1405 sub _NewTransaction {
1406     my $self = shift;
1407     my %args = (
1408         TimeTaken => undef,
1409         Type      => undef,
1410         OldValue  => undef,
1411         NewValue  => undef,
1412         OldReference  => undef,
1413         NewReference  => undef,
1414         ReferenceType => undef,
1415         Data      => undef,
1416         Field     => undef,
1417         MIMEObj   => undef,
1418         ActivateScrips => 1,
1419         CommitScrips => 1,
1420         @_
1421     );
1422
1423     my $old_ref = $args{'OldReference'};
1424     my $new_ref = $args{'NewReference'};
1425     my $ref_type = $args{'ReferenceType'};
1426     if ($old_ref or $new_ref) {
1427         $ref_type ||= ref($old_ref) || ref($new_ref);
1428         if (!$ref_type) {
1429             $RT::Logger->error("Reference type not specified for transaction");
1430             return;
1431         }
1432         $old_ref = $old_ref->Id if ref($old_ref);
1433         $new_ref = $new_ref->Id if ref($new_ref);
1434     }
1435
1436     require RT::Transaction;
1437     my $trans = new RT::Transaction( $self->CurrentUser );
1438     my ( $transaction, $msg ) = $trans->Create(
1439         ObjectId  => $self->Id,
1440         ObjectType => ref($self),
1441         TimeTaken => $args{'TimeTaken'},
1442         Type      => $args{'Type'},
1443         Data      => $args{'Data'},
1444         Field     => $args{'Field'},
1445         NewValue  => $args{'NewValue'},
1446         OldValue  => $args{'OldValue'},
1447         NewReference  => $new_ref,
1448         OldReference  => $old_ref,
1449         ReferenceType => $ref_type,
1450         MIMEObj   => $args{'MIMEObj'},
1451         ActivateScrips => $args{'ActivateScrips'},
1452         CommitScrips => $args{'CommitScrips'},
1453     );
1454
1455     # Rationalize the object since we may have done things to it during the caching.
1456     $self->Load($self->Id);
1457
1458     $RT::Logger->warning($msg) unless $transaction;
1459
1460     $self->_SetLastUpdated;
1461
1462     if ( defined $args{'TimeTaken'} ) {
1463         $self->_UpdateTimeTaken( $args{'TimeTaken'} );
1464     }
1465     if ( $RT::UseTransactionBatch and $transaction ) {
1466             push @{$self->{_TransactionBatch}}, $trans;
1467     }
1468     return ( $transaction, $msg, $trans );
1469 }
1470
1471 # }}}
1472
1473 # {{{ sub Transactions
1474
1475 =head2 Transactions
1476
1477   Returns an RT::Transactions object of all transactions on this record object
1478
1479 =cut
1480
1481 sub Transactions {
1482     my $self = shift;
1483
1484     use RT::Transactions;
1485     my $transactions = RT::Transactions->new( $self->CurrentUser );
1486
1487     #If the user has no rights, return an empty object
1488     $transactions->Limit(
1489         FIELD => 'ObjectId',
1490         VALUE => $self->id,
1491     );
1492     $transactions->Limit(
1493         FIELD => 'ObjectType',
1494         VALUE => ref($self),
1495     );
1496
1497     return ($transactions);
1498 }
1499
1500 # }}}
1501 # }}}
1502 #
1503 # {{{ Routines dealing with custom fields
1504
1505 sub CustomFields {
1506     my $self = shift;
1507     my $cfs  = RT::CustomFields->new( $self->CurrentUser );
1508
1509     # XXX handle multiple types properly
1510     $cfs->LimitToLookupType( $self->CustomFieldLookupType );
1511     $cfs->LimitToGlobalOrObjectId(
1512         $self->_LookupId( $self->CustomFieldLookupType ) );
1513
1514     return $cfs;
1515 }
1516
1517 # TODO: This _only_ works for RT::Class classes. it doesn't work, for example, for RT::FM classes.
1518
1519 sub _LookupId {
1520     my $self = shift;
1521     my $lookup = shift;
1522     my @classes = ($lookup =~ /RT::(\w+)-/g);
1523
1524     my $object = $self;
1525     foreach my $class (reverse @classes) {
1526         my $method = "${class}Obj";
1527         $object = $object->$method;
1528     }
1529
1530     return $object->Id;
1531 }
1532
1533
1534 =head2 CustomFieldLookupType
1535
1536 Returns the path RT uses to figure out which custom fields apply to this object.
1537
1538 =cut
1539
1540 sub CustomFieldLookupType {
1541     my $self = shift;
1542     return ref($self);
1543 }
1544
1545 #TODO Deprecated API. Destroy in 3.6
1546 sub _LookupTypes {
1547     my  $self = shift;
1548     $RT::Logger->warning("_LookupTypes call is deprecated at (". join(":",caller)."). Replace with CustomFieldLookupType");
1549
1550     return($self->CustomFieldLookupType);
1551
1552 }
1553
1554 # {{{ AddCustomFieldValue
1555
1556 =head2 AddCustomFieldValue { Field => FIELD, Value => VALUE }
1557
1558 VALUE should be a string.
1559 FIELD can be a CustomField object OR a CustomField ID.
1560
1561
1562 Adds VALUE as a value of CustomField FIELD.  If this is a single-value custom field,
1563 deletes the old value.
1564 If VALUE is not a valid value for the custom field, returns
1565 (0, 'Error message' ) otherwise, returns (1, 'Success Message')
1566
1567 =cut
1568
1569 sub AddCustomFieldValue {
1570     my $self = shift;
1571     $self->_AddCustomFieldValue(@_);
1572 }
1573
1574 sub _AddCustomFieldValue {
1575     my $self = shift;
1576     my %args = (
1577         Field             => undef,
1578         Value             => undef,
1579         RecordTransaction => 1,
1580         @_
1581     );
1582
1583     my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
1584
1585     unless ( $cf->Id ) {
1586         return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
1587     }
1588
1589     my $OCFs = $self->CustomFields;
1590     $OCFs->Limit( FIELD => 'id', VALUE => $cf->Id );
1591     unless ( $OCFs->Count ) {
1592         return (
1593             0,
1594             $self->loc(
1595                 "Custom field [_1] does not apply to this object",
1596                 $args{'Field'}
1597             )
1598         );
1599     }
1600     # Load up a ObjectCustomFieldValues object for this custom field and this ticket
1601     my $values = $cf->ValuesForObject($self);
1602
1603     unless ( $cf->ValidateValue( $args{'Value'} ) ) {
1604         return ( 0, $self->loc("Invalid value for custom field") );
1605     }
1606
1607     # If the custom field only accepts a certain # of values, delete the existing
1608     # value and record a "changed from foo to bar" transaction
1609     unless ( $cf->UnlimitedValues) {
1610
1611  # We need to whack any old values here.  In most cases, the custom field should
1612  # only have one value to delete.  In the pathalogical case, this custom field
1613  # used to be a multiple and we have many values to whack....
1614         my $cf_values = $values->Count;
1615
1616         if ( $cf_values > $cf->MaxValues ) {
1617             my $i = 0;   #We want to delete all but the max we can currently have , so we can then
1618                  # execute the same code to "change" the value from old to new
1619             while ( my $value = $values->Next ) {
1620                 $i++;
1621                 if ( $i < $cf_values ) {
1622                     my ( $val, $msg ) = $cf->DeleteValueForObject(
1623                         Object  => $self,
1624                         Content => $value->Content
1625                     );
1626                     unless ($val) {
1627                         return ( 0, $msg );
1628                     }
1629                     my ( $TransactionId, $Msg, $TransactionObj ) =
1630                       $self->_NewTransaction(
1631                         Type         => 'CustomField',
1632                         Field        => $cf->Id,
1633                         OldReference => $value,
1634                       );
1635                 }
1636             }
1637         }
1638
1639         my ( $old_value, $old_content );
1640         if ( $old_value = $cf->ValuesForObject($self)->First ) {
1641             $old_content = $old_value->Content();
1642             return (1) if( $old_content eq $args{'Value'} && $old_value->LargeContent eq $args{'LargeContent'});;
1643         }
1644
1645         my ( $new_value_id, $value_msg ) = $cf->AddValueForObject(
1646             Object       => $self,
1647             Content      => $args{'Value'},
1648             LargeContent => $args{'LargeContent'},
1649             ContentType  => $args{'ContentType'},
1650         );
1651
1652         unless ($new_value_id) {
1653             return ( 0, $self->loc( "Could not add new custom field value. [_1] ",, $value_msg));
1654         }
1655
1656         my $new_value = RT::ObjectCustomFieldValue->new( $self->CurrentUser );
1657         $new_value->Load($new_value_id);
1658
1659         # now that adding the new value was successful, delete the old one
1660         if ($old_value) {
1661             my ( $val, $msg ) = $old_value->Delete();
1662             unless ($val) {
1663                 return ( 0, $msg );
1664             }
1665         }
1666
1667         if ( $args{'RecordTransaction'} ) {
1668             my ( $TransactionId, $Msg, $TransactionObj ) =
1669               $self->_NewTransaction(
1670                 Type         => 'CustomField',
1671                 Field        => $cf->Id,
1672                 OldReference => $old_value,
1673                 NewReference => $new_value,
1674               );
1675         }
1676
1677         if ( $old_value eq '' ) {
1678             return ( 1, $self->loc( "[_1] [_2] added", $cf->Name, $new_value->Content ));
1679         }
1680         elsif ( $new_value->Content eq '' ) {
1681             return ( 1,
1682                 $self->loc( "[_1] [_2] deleted", $cf->Name, $old_value->Content ) );
1683         }
1684         else {
1685             return ( 1, $self->loc( "[_1] [_2] changed to [_3]", $cf->Name, $old_content,                $new_value->Content));
1686         }
1687
1688     }
1689
1690     # otherwise, just add a new value and record "new value added"
1691     else {
1692         my ($new_value_id) = $cf->AddValueForObject(
1693             Object       => $self,
1694             Content      => $args{'Value'},
1695             LargeContent => $args{'LargeContent'},
1696             ContentType  => $args{'ContentType'},
1697         );
1698
1699         unless ($new_value_id) {
1700             return ( 0, $self->loc("Could not add new custom field value. ") );
1701         }
1702         if ( $args{'RecordTransaction'} ) {
1703             my ( $TransactionId, $Msg, $TransactionObj ) =
1704               $self->_NewTransaction(
1705                 Type          => 'CustomField',
1706                 Field         => $cf->Id,
1707                 NewReference  => $new_value_id,
1708                 ReferenceType => 'RT::ObjectCustomFieldValue',
1709               );
1710             unless ($TransactionId) {
1711                 return ( 0,
1712                     $self->loc( "Couldn't create a transaction: [_1]", $Msg ) );
1713             }
1714         }
1715         return ( 1, $self->loc( "[_1] added as a value for [_2]", $args{'Value'}, $cf->Name));
1716     }
1717
1718 }
1719
1720 # }}}
1721
1722 # {{{ DeleteCustomFieldValue
1723
1724 =head2 DeleteCustomFieldValue { Field => FIELD, Value => VALUE }
1725
1726 Deletes VALUE as a value of CustomField FIELD.
1727
1728 VALUE can be a string, a CustomFieldValue or a ObjectCustomFieldValue.
1729
1730 If VALUE is not a valid value for the custom field, returns
1731 (0, 'Error message' ) otherwise, returns (1, 'Success Message')
1732
1733 =cut
1734
1735 sub DeleteCustomFieldValue {
1736     my $self = shift;
1737     my %args = (
1738         Field   => undef,
1739         Value   => undef,
1740         ValueId => undef,
1741         @_
1742     );
1743
1744     my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
1745
1746     unless ( $cf->Id ) {
1747         return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
1748     }
1749     my ( $val, $msg ) = $cf->DeleteValueForObject(
1750         Object  => $self,
1751         Id      => $args{'ValueId'},
1752         Content => $args{'Value'},
1753     );
1754     unless ($val) {
1755         return ( 0, $msg );
1756     }
1757     my ( $TransactionId, $Msg, $TransactionObj ) = $self->_NewTransaction(
1758         Type          => 'CustomField',
1759         Field         => $cf->Id,
1760         OldReference  => $val,
1761         ReferenceType => 'RT::ObjectCustomFieldValue',
1762     );
1763     unless ($TransactionId) {
1764         return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $Msg ) );
1765     }
1766
1767     return (
1768         $TransactionId,
1769         $self->loc(
1770             "[_1] is no longer a value for custom field [_2]",
1771             $TransactionObj->OldValue, $cf->Name
1772         )
1773     );
1774 }
1775
1776 # }}}
1777
1778 # {{{ FirstCustomFieldValue
1779
1780 =head2 FirstCustomFieldValue FIELD
1781
1782 Return the content of the first value of CustomField FIELD for this ticket
1783 Takes a field id or name
1784
1785 =cut
1786
1787 sub FirstCustomFieldValue {
1788     my $self = shift;
1789     my $field = shift;
1790     my $values = $self->CustomFieldValues($field);
1791     if ($values->First) {
1792         return $values->First->Content;
1793     } else {
1794         return undef;
1795     }
1796
1797 }
1798
1799
1800
1801 # {{{ CustomFieldValues
1802
1803 =head2 CustomFieldValues FIELD
1804
1805 Return a ObjectCustomFieldValues object of all values of the CustomField whose
1806 id or Name is FIELD for this record.
1807
1808 Returns an RT::ObjectCustomFieldValues object
1809
1810 =cut
1811
1812 sub CustomFieldValues {
1813     my $self  = shift;
1814     my $field = shift;
1815
1816     if ($field) {
1817         my $cf = $self->LoadCustomFieldByIdentifier($field);
1818
1819         # we were asked to search on a custom field we couldn't fine
1820         unless ( $cf->id ) {
1821             return RT::ObjectCustomFieldValues->new( $self->CurrentUser );
1822         }
1823         return ( $cf->ValuesForObject($self) );
1824     }
1825
1826     # we're not limiting to a specific custom field;
1827     my $ocfs = RT::ObjectCustomFieldValues->new( $self->CurrentUser );
1828     $ocfs->LimitToObject($self);
1829     return $ocfs;
1830
1831 }
1832
1833 =head2 CustomField IDENTIFER
1834
1835 Find the custom field has id or name IDENTIFIER for this object.
1836
1837 If no valid field is found, returns an empty RT::CustomField object.
1838
1839 =cut
1840
1841 sub LoadCustomFieldByIdentifier {
1842     my $self = shift;
1843     my $field = shift;
1844
1845     my $cf = RT::CustomField->new($self->CurrentUser);
1846
1847     if ( UNIVERSAL::isa( $field, "RT::CustomField" ) ) {
1848         $cf->LoadById( $field->id );
1849     }
1850     elsif ($field =~ /^\d+$/) {
1851         $cf = RT::CustomField->new($self->CurrentUser);
1852         $cf->Load($field);
1853     } else {
1854
1855         my $cfs = $self->CustomFields($self->CurrentUser);
1856         $cfs->Limit(FIELD => 'Name', VALUE => $field);
1857         $cf = $cfs->First || RT::CustomField->new($self->CurrentUser);
1858     }
1859     return $cf;
1860 }
1861
1862
1863 # }}}
1864
1865 # }}}
1866
1867 # }}}
1868
1869 sub BasicColumns {
1870 }
1871
1872 eval "require RT::Record_Vendor";
1873 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Record_Vendor.pm});
1874 eval "require RT::Record_Local";
1875 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Record_Local.pm});
1876
1877 1;