rt/lib/RT/Record.pm

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