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