rt/lib/RT/Transaction_Overlay.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::Transaction - RT\'s transaction object
  52
  53 =head1 SYNOPSIS
  54
  55   use RT::Transaction;
  56
  57
  58 =head1 DESCRIPTION
  59
  60
  61 Each RT::Transaction describes an atomic change to a ticket object
  62 or an update to an RT::Ticket object.
  63 It can have arbitrary MIME attachments.
  64
  65
  66 =head1 METHODS
  67
  68
  69 =cut
  70
  71
  72 package RT::Transaction;
  73
  74 use strict;
  75 no warnings qw(redefine);
  76
  77 use vars qw( %_BriefDescriptions $PreferredContentType );
  78
  79 use RT::Attachments;
  80 use RT::Scrips;
  81 use RT::Ruleset;
  82
  83 use HTML::FormatText;
  84 use HTML::TreeBuilder;
  85
  86 # {{{ sub Create
  87
  88 =head2 Create
  89
  90 Create a new transaction.
  91
  92 This routine should _never_ be called by anything other than RT::Ticket.
  93 It should not be called
  94 from client code. Ever. Not ever.  If you do this, we will hunt you down and break your kneecaps.
  95 Then the unpleasant stuff will start.
  96
  97 TODO: Document what gets passed to this
  98
  99 =cut
 100
 101 sub Create {
 102     my $self = shift;
 103     my %args = (
 104         id             => undef,
 105         TimeTaken      => 0,
 106         Type           => 'undefined',
 107         Data           => '',
 108         Field          => undef,
 109         OldValue       => undef,
 110         NewValue       => undef,
 111         MIMEObj        => undef,
 112         ActivateScrips => 1,
 113         CommitScrips   => 1,
 114         ObjectType     => 'RT::Ticket',
 115         ObjectId       => 0,
 116         ReferenceType  => undef,
 117         OldReference   => undef,
 118         NewReference   => undef,
 119         CustomFields   => {},
 120         @_
 121     );
 122
 123     $args{ObjectId} ||= $args{Ticket};
 124
 125     #if we didn't specify a ticket, we need to bail
 126     unless ( $args{'ObjectId'} && $args{'ObjectType'}) {
 127         return ( 0, $self->loc( "Transaction->Create couldn't, as you didn't specify an object type and id"));
 128     }
 129
 130
 131
 132     #lets create our transaction
 133     my %params = (
 134         Type          => $args{'Type'},
 135         Data          => $args{'Data'},
 136         Field         => $args{'Field'},
 137         OldValue      => $args{'OldValue'},
 138         NewValue      => $args{'NewValue'},
 139         Created       => $args{'Created'},
 140         ObjectType    => $args{'ObjectType'},
 141         ObjectId      => $args{'ObjectId'},
 142         ReferenceType => $args{'ReferenceType'},
 143         OldReference  => $args{'OldReference'},
 144         NewReference  => $args{'NewReference'},
 145     );
 146
 147     # Parameters passed in during an import that we probably don't want to touch, otherwise
 148     foreach my $attr (qw(id Creator Created LastUpdated TimeTaken LastUpdatedBy)) {
 149         $params{$attr} = $args{$attr} if ($args{$attr});
 150     }
 151
 152     my $id = $self->SUPER::Create(%params);
 153     $self->Load($id);
 154     if ( defined $args{'MIMEObj'} ) {
 155         my ($id, $msg) = $self->_Attach( $args{'MIMEObj'} );
 156         unless ( $id ) {
 157             $RT::Logger->error("Couldn't add attachment: $msg");
 158             return ( 0, $self->loc("Couldn't add attachment") );
 159         }
 160     }
 161
 162     # Set up any custom fields passed at creation.  Has to happen
 163     # before scrips.
 164
 165     $self->UpdateCustomFields(%{ $args{'CustomFields'} });
 166
 167     #Provide a way to turn off scrips if we need to
 168         $RT::Logger->debug('About to think about scrips for transaction #' .$self->Id);
 169     if ( $args{'ActivateScrips'} and $args{'ObjectType'} eq 'RT::Ticket' ) {
 170        $self->{'scrips'} = RT::Scrips->new($RT::SystemUser);
 171
 172         $RT::Logger->debug('About to prepare scrips for transaction #' .$self->Id);
 173
 174         $self->{'scrips'}->Prepare(
 175             Stage       => 'TransactionCreate',
 176             Type        => $args{'Type'},
 177             Ticket      => $args{'ObjectId'},
 178             Transaction => $self->id,
 179         );
 180
 181        # Entry point of the rule system
 182        my $ticket = RT::Ticket->new($RT::SystemUser);
 183        $ticket->Load($args{'ObjectId'});
 184        my $rules = $self->{rules} = RT::Ruleset->FindAllRules(
 185             Stage       => 'TransactionCreate',
 186             Type        => $args{'Type'},
 187             TicketObj   => $ticket,
 188             TransactionObj => $self,
 189        );
 190
 191         if ($args{'CommitScrips'} ) {
 192             $RT::Logger->debug('About to commit scrips for transaction #' .$self->Id);
 193             $self->{'scrips'}->Commit();
 194             RT::Ruleset->CommitRules($rules);
 195         }
 196     }
 197
 198     return ( $id, $self->loc("Transaction Created") );
 199 }
 200
 201 # }}}
 202
 203 =head2 Scrips
 204
 205 Returns the Scrips object for this transaction.
 206 This routine is only useful on a freshly created transaction object.
 207 Scrips do not get persisted to the database with transactions.
 208
 209
 210 =cut
 211
 212
 213 sub Scrips {
 214     my $self = shift;
 215     return($self->{'scrips'});
 216 }
 217
 218
 219 =head2 Rules
 220
 221 Returns the array of Rule objects for this transaction.
 222 This routine is only useful on a freshly created transaction object.
 223 Rules do not get persisted to the database with transactions.
 224
 225
 226 =cut
 227
 228
 229 sub Rules {
 230     my $self = shift;
 231     return($self->{'rules'});
 232 }
 233
 234
 235 # {{{ sub Delete
 236
 237 =head2 Delete
 238
 239 Delete this transaction. Currently DOES NOT CHECK ACLS
 240
 241 =cut
 242
 243 sub Delete {
 244     my $self = shift;
 245
 246
 247     $RT::Handle->BeginTransaction();
 248
 249     my $attachments = $self->Attachments;
 250
 251     while (my $attachment = $attachments->Next) {
 252         my ($id, $msg) = $attachment->Delete();
 253         unless ($id) {
 254             $RT::Handle->Rollback();
 255             return($id, $self->loc("System Error: [_1]", $msg));
 256         }
 257     }
 258     my ($id,$msg) = $self->SUPER::Delete();
 259         unless ($id) {
 260             $RT::Handle->Rollback();
 261             return($id, $self->loc("System Error: [_1]", $msg));
 262         }
 263     $RT::Handle->Commit();
 264     return ($id,$msg);
 265 }
 266
 267 # }}}
 268
 269 # {{{ Routines dealing with Attachments
 270
 271 # {{{ sub Message
 272
 273 =head2 Message
 274
 275 Returns the L<RT::Attachments> object which contains the "top-level" object
 276 attachment for this transaction.
 277
 278 =cut
 279
 280 sub Message {
 281     my $self = shift;
 282
 283     # XXX: Where is ACL check?
 284
 285     unless ( defined $self->{'message'} ) {
 286
 287         $self->{'message'} = RT::Attachments->new( $self->CurrentUser );
 288         $self->{'message'}->Limit(
 289             FIELD => 'TransactionId',
 290             VALUE => $self->Id
 291         );
 292         $self->{'message'}->ChildrenOf(0);
 293     } else {
 294         $self->{'message'}->GotoFirstItem;
 295     }
 296     return $self->{'message'};
 297 }
 298
 299 # }}}
 300
 301 # {{{ sub Content
 302
 303 =head2 Content PARAMHASH
 304
 305 If this transaction has attached mime objects, returns the body of the first
 306 textual part (as defined in RT::I18N::IsTextualContentType).  Otherwise,
 307 returns undef.
 308
 309 Takes a paramhash.  If the $args{'Quote'} parameter is set, wraps this message
 310 at $args{'Wrap'}.  $args{'Wrap'} defaults to $RT::MessageBoxWidth - 2 or 70.
 311
 312 If $args{'Type'} is set to C<text/html>, this will return an HTML
 313 part of the message, if available.  Otherwise it looks for a text/plain
 314 part. If $args{'Type'} is missing, it defaults to the value of
 315 C<$RT::Transaction::PreferredContentType>, if that's missing too,
 316 defaults to textual.
 317
 318 =cut
 319
 320 sub Content {
 321     my $self = shift;
 322     my %args = (
 323         Type => $PreferredContentType || '',
 324         Quote => 0,
 325         Wrap  => 70,
 326         Wrap  => ( $RT::MessageBoxWidth || 72 ) - 2,
 327         @_
 328     );
 329
 330     my $content;
 331     if ( my $content_obj =
 332         $self->ContentObj( $args{Type} ? ( Type => $args{Type} ) : () ) )
 333     {
 334         $content = $content_obj->Content ||'';
 335
 336         if ( lc $content_obj->ContentType eq 'text/html' ) {
 337             $content =~ s/<p>--\s+<br \/>.*?$//s if $args{'Quote'};
 338
 339             if ($args{Type} ne 'text/html') {
 340                 my $tree = HTML::TreeBuilder->new_from_content( $content );
 341                 $content = HTML::FormatText->new(
 342                     leftmargin  => 0,
 343                     rightmargin => 78,
 344                 )->format( $tree);
 345                 $tree->delete;
 346             }
 347         }
 348         else {
 349             $content =~ s/\n-- \n.*?$//s if $args{'Quote'};
 350             if ($args{Type} eq 'text/html') {
 351                 # Extremely simple text->html converter
 352                 $content =~ s/&/&#38;/g;
 353                 $content =~ s/</&lt;/g;
 354                 $content =~ s/>/&gt;/g;
 355                 $content = "<pre>$content</pre>";
 356             }
 357         }
 358     }
 359
 360     # If all else fails, return a message that we couldn't find any content
 361     else {
 362         $content = $self->loc('This transaction appears to have no content');
 363     }
 364
 365     if ( $args{'Quote'} ) {
 366
 367         # What's the longest line like?
 368         my $max = 0;
 369         foreach ( split ( /\n/, $content ) ) {
 370             $max = length if length > $max;
 371         }
 372
 373         if ( $max > $args{'Wrap'}+6 ) { # 76 ) {
 374             require Text::Wrapper;
 375             my $wrapper = new Text::Wrapper(
 376                 columns    => $args{'Wrap'},
 377                 body_start => ( $max > 70 * 3 ? '   ' : '' ),
 378                 par_start  => ''
 379             );
 380             $content = $wrapper->wrap($content);
 381         }
 382
 383         $content =~ s/^/> /gm;
 384         $content = $self->loc("On [_1], [_2] wrote:", $self->CreatedAsString, $self->CreatorObj->Name)
 385           . "\n$content\n\n";
 386     }
 387
 388     return ($content);
 389 }
 390
 391 # }}}
 392
 393
 394 =head2 Addresses
 395
 396 Returns a hashref of addresses related to this transaction. See L<RT::Attachment/Addresses> for details.
 397
 398 =cut
 399
 400 sub Addresses {
 401         my $self = shift;
 402
 403         if (my $attach = $self->Attachments->First) {
 404                 return $attach->Addresses;
 405         }
 406         else {
 407                 return {};
 408         }
 409
 410 }
 411
 412
 413 # {{{ ContentObj
 414
 415 =head2 ContentObj
 416
 417 Returns the RT::Attachment object which contains the content for this Transaction
 418
 419 =cut
 420
 421
 422 sub ContentObj {
 423     my $self = shift;
 424     my %args = ( Type => $PreferredContentType, Attachment => undef, @_ );
 425
 426     # If we don't have any content, return undef now.
 427     # Get the set of toplevel attachments to this transaction.
 428
 429     my $Attachment = $args{'Attachment'};
 430
 431     $Attachment ||= $self->Attachments->First;
 432
 433     return undef unless ($Attachment);
 434
 435     # If it's a textual part, just return the body.
 436     if ( RT::I18N::IsTextualContentType($Attachment->ContentType) ) {
 437         return ($Attachment);
 438     }
 439
 440     # If it's a multipart object, first try returning the first part with preferred
 441     # MIME type ('text/plain' by default).
 442
 443     elsif ( $Attachment->ContentType =~ qr|^multipart/mixed|i ) {
 444         my $kids = $Attachment->Children;
 445         while (my $child = $kids->Next) {
 446             my $ret =  $self->ContentObj(%args, Attachment => $child);
 447             return $ret if ($ret);
 448         }
 449     }
 450     elsif ( $Attachment->ContentType =~ qr|^multipart/|i ) {
 451         if ( $args{Type} ) {
 452             my $plain_parts = $Attachment->Children;
 453             $plain_parts->ContentType( VALUE => $args{Type} );
 454             $plain_parts->LimitNotEmpty;
 455
 456             # If we actully found a part, return its content
 457             if ( my $first = $plain_parts->First ) {
 458                 return $first;
 459             }
 460         }
 461
 462         # If that fails, return the first textual part which has some content.
 463         my $all_parts = $self->Attachments;
 464         while ( my $part = $all_parts->Next ) {
 465             next unless RT::I18N::IsTextualContentType($part->ContentType)
 466                         && $part->Content;
 467             return $part;
 468         }
 469     }
 470
 471     # We found no content. suck
 472     return (undef);
 473 }
 474
 475 # }}}
 476
 477 # {{{ sub Subject
 478
 479 =head2 Subject
 480
 481 If this transaction has attached mime objects, returns the first one's subject
 482 Otherwise, returns null
 483
 484 =cut
 485
 486 sub Subject {
 487     my $self = shift;
 488     return undef unless my $first = $self->Attachments->First;
 489     return $first->Subject;
 490 }
 491
 492 # }}}
 493
 494 # {{{ sub Attachments
 495
 496 =head2 Attachments
 497
 498 Returns all the RT::Attachment objects which are attached
 499 to this transaction. Takes an optional parameter, which is
 500 a ContentType that Attachments should be restricted to.
 501
 502 =cut
 503
 504 sub Attachments {
 505     my $self = shift;
 506
 507     if ( $self->{'attachments'} ) {
 508         $self->{'attachments'}->GotoFirstItem;
 509         return $self->{'attachments'};
 510     }
 511
 512     $self->{'attachments'} = RT::Attachments->new( $self->CurrentUser );
 513
 514     unless ( $self->CurrentUserCanSee ) {
 515         $self->{'attachments'}->Limit(FIELD => 'id', VALUE => '0');
 516         return $self->{'attachments'};
 517     }
 518
 519     $self->{'attachments'}->Limit( FIELD => 'TransactionId', VALUE => $self->Id );
 520
 521     # Get the self->{'attachments'} in the order they're put into
 522     # the database.  Arguably, we should be returning a tree
 523     # of self->{'attachments'}, not a set...but no current app seems to need
 524     # it.
 525
 526     $self->{'attachments'}->OrderBy( FIELD => 'id', ORDER => 'ASC' );
 527
 528     return $self->{'attachments'};
 529 }
 530
 531 # }}}
 532
 533 # {{{ sub _Attach
 534
 535 =head2 _Attach
 536
 537 A private method used to attach a mime object to this transaction.
 538
 539 =cut
 540
 541 sub _Attach {
 542     my $self       = shift;
 543     my $MIMEObject = shift;
 544
 545     unless ( defined $MIMEObject ) {
 546         $RT::Logger->error("We can't attach a mime object if you don't give us one.");
 547         return ( 0, $self->loc("[_1]: no attachment specified", $self) );
 548     }
 549
 550     my $Attachment = RT::Attachment->new( $self->CurrentUser );
 551     my ($id, $msg) = $Attachment->Create(
 552         TransactionId => $self->Id,
 553         Attachment    => $MIMEObject
 554     );
 555     return ( $Attachment, $msg || $self->loc("Attachment created") );
 556 }
 557
 558 # }}}
 559
 560 # }}}
 561
 562 sub ContentAsMIME {
 563     my $self = shift;
 564
 565     my $main_content = $self->ContentObj;
 566     return unless $main_content;
 567
 568     my $entity = $main_content->ContentAsMIME;
 569
 570     if ( $main_content->Parent ) {
 571         # main content is not top most entity, we shouldn't loose
 572         # From/To/Cc headers that are on a top part
 573         my $attachments = RT::Attachments->new( $self->CurrentUser );
 574         $attachments->Columns(qw(id Parent TransactionId Headers));
 575         $attachments->Limit( FIELD => 'TransactionId', VALUE => $self->id );
 576         $attachments->Limit( FIELD => 'Parent', VALUE => 0 );
 577         $attachments->Limit( FIELD => 'Parent', OPERATOR => 'IS', VALUE => 'NULL', QUOTEVALUE => 0 );
 578         $attachments->OrderBy( FIELD => 'id', ORDER => 'ASC' );
 579         my $tmp = $attachments->First;
 580         if ( $tmp && $tmp->id ne $main_content->id ) {
 581             $entity->make_multipart;
 582             $entity->head->add( split /:/, $_, 2 ) foreach $tmp->SplitHeaders;
 583             $entity->make_singlepart;
 584         }
 585     }
 586
 587     my $attachments = RT::Attachments->new( $self->CurrentUser );
 588     $attachments->Limit( FIELD => 'TransactionId', VALUE => $self->id );
 589     $attachments->Limit(
 590         FIELD => 'id',
 591         OPERATOR => '!=',
 592         VALUE => $main_content->id,
 593     );
 594     $attachments->Limit(
 595         FIELD => 'ContentType',
 596         OPERATOR => 'NOT STARTSWITH',
 597         VALUE => 'multipart/',
 598     );
 599     $attachments->LimitNotEmpty;
 600     while ( my $a = $attachments->Next ) {
 601         $entity->make_multipart unless $entity->is_multipart;
 602         $entity->add_part( $a->ContentAsMIME );
 603     }
 604     return $entity;
 605 }
 606
 607 # {{{ Routines dealing with Transaction Attributes
 608
 609 # {{{ sub Description
 610
 611 =head2 Description
 612
 613 Returns a text string which describes this transaction
 614
 615 =cut
 616
 617 sub Description {
 618     my $self = shift;
 619
 620     unless ( $self->CurrentUserCanSee ) {
 621         return ( $self->loc("Permission Denied") );
 622     }
 623
 624     unless ( defined $self->Type ) {
 625         return ( $self->loc("No transaction type specified"));
 626     }
 627
 628     return $self->loc("[_1] by [_2]", $self->BriefDescription , $self->CreatorObj->Name );
 629 }
 630
 631 # }}}
 632
 633 # {{{ sub BriefDescription
 634
 635 =head2 BriefDescription
 636
 637 Returns a text string which briefly describes this transaction
 638
 639 =cut
 640
 641 sub BriefDescription {
 642     my $self = shift;
 643
 644     unless ( $self->CurrentUserCanSee ) {
 645         return ( $self->loc("Permission Denied") );
 646     }
 647
 648     my $type = $self->Type;    #cache this, rather than calling it 30 times
 649
 650     unless ( defined $type ) {
 651         return $self->loc("No transaction type specified");
 652     }
 653
 654     my $obj_type = $self->FriendlyObjectType;
 655
 656     if ( $type eq 'Create' ) {
 657         return ( $self->loc( "[_1] created", $obj_type ) );
 658     }
 659     elsif ( $type eq 'Enabled' ) {
 660         return ( $self->loc( "[_1] enabled", $obj_type ) );
 661     }
 662     elsif ( $type eq 'Disabled' ) {
 663         return ( $self->loc( "[_1] disabled", $obj_type ) );
 664     }
 665     elsif ( $type =~ /Status/ ) {
 666         if ( $self->Field eq 'Status' ) {
 667             if ( $self->NewValue eq 'deleted' ) {
 668                 return ( $self->loc( "[_1] deleted", $obj_type ) );
 669             }
 670             else {
 671                 return (
 672                     $self->loc(
 673                         "Status changed from [_1] to [_2]",
 674                         "'" . $self->loc( $self->OldValue ) . "'",
 675                         "'" . $self->loc( $self->NewValue ) . "'"
 676                     )
 677                 );
 678
 679             }
 680         }
 681
 682         # Generic:
 683         my $no_value = $self->loc("(no value)");
 684         return (
 685             $self->loc(
 686                 "[_1] changed from [_2] to [_3]",
 687                 $self->Field,
 688                 ( $self->OldValue ? "'" . $self->OldValue . "'" : $no_value ),
 689                 "'" . $self->NewValue . "'"
 690             )
 691         );
 692     }
 693     elsif ( $type =~ /SystemError/ ) {
 694         return $self->loc("System error");
 695     }
 696
 697     if ( my $code = $_BriefDescriptions{$type} ) {
 698         return $code->($self);
 699     }
 700
 701     return $self->loc(
 702         "Default: [_1]/[_2] changed from [_3] to [_4]",
 703         $type,
 704         $self->Field,
 705         (
 706             $self->OldValue
 707             ? "'" . $self->OldValue . "'"
 708             : $self->loc("(no value)")
 709         ),
 710         "'" . $self->NewValue . "'"
 711     );
 712 }
 713
 714 %_BriefDescriptions = (
 715     CommentEmailRecord => sub {
 716         my $self = shift;
 717         return $self->loc("Outgoing email about a comment recorded");
 718     },
 719     EmailRecord => sub {
 720         my $self = shift;
 721         return $self->loc("Outgoing email recorded");
 722     },
 723     Correspond => sub {
 724         my $self = shift;
 725         return $self->loc("Correspondence added");
 726     },
 727     Comment => sub {
 728         my $self = shift;
 729         return $self->loc("Comments added");
 730     },
 731     CustomField => sub {
 732         my $self = shift;
 733         my $field = $self->loc('CustomField');
 734
 735         if ( $self->Field ) {
 736             my $cf = RT::CustomField->new( $self->CurrentUser );
 737             $cf->Load( $self->Field );
 738             $field = $cf->Name();
 739         }
 740
 741         if ( ! defined $self->OldValue || $self->OldValue eq '' ) {
 742             return ( $self->loc("[_1] [_2] added", $field, $self->NewValue) );
 743         }
 744         elsif ( !defined $self->NewValue || $self->NewValue eq '' ) {
 745             return ( $self->loc("[_1] [_2] deleted", $field, $self->OldValue) );
 746
 747         }
 748         else {
 749             return $self->loc("[_1] [_2] changed to [_3]", $field, $self->OldValue, $self->NewValue );
 750         }
 751     },
 752     Untake => sub {
 753         my $self = shift;
 754         return $self->loc("Untaken");
 755     },
 756     Take => sub {
 757         my $self = shift;
 758         return $self->loc("Taken");
 759     },
 760     Force => sub {
 761         my $self = shift;
 762         my $Old = RT::User->new( $self->CurrentUser );
 763         $Old->Load( $self->OldValue );
 764         my $New = RT::User->new( $self->CurrentUser );
 765         $New->Load( $self->NewValue );
 766
 767         return $self->loc("Owner forcibly changed from [_1] to [_2]" , $Old->Name , $New->Name);
 768     },
 769     Steal => sub {
 770         my $self = shift;
 771         my $Old = RT::User->new( $self->CurrentUser );
 772         $Old->Load( $self->OldValue );
 773         return $self->loc("Stolen from [_1]",  $Old->Name);
 774     },
 775     Give => sub {
 776         my $self = shift;
 777         my $New = RT::User->new( $self->CurrentUser );
 778         $New->Load( $self->NewValue );
 779         return $self->loc( "Given to [_1]",  $New->Name );
 780     },
 781     AddWatcher => sub {
 782         my $self = shift;
 783         my $principal = RT::Principal->new($self->CurrentUser);
 784         $principal->Load($self->NewValue);
 785         return $self->loc( "[_1] [_2] added", $self->Field, $principal->Object->Name);
 786     },
 787     DelWatcher => sub {
 788         my $self = shift;
 789         my $principal = RT::Principal->new($self->CurrentUser);
 790         $principal->Load($self->OldValue);
 791         return $self->loc( "[_1] [_2] deleted", $self->Field, $principal->Object->Name);
 792     },
 793     Subject => sub {
 794         my $self = shift;
 795         return $self->loc( "Subject changed to [_1]", $self->Data );
 796     },
 797     AddLink => sub {
 798         my $self = shift;
 799         my $value;
 800         if ( $self->NewValue ) {
 801             my $URI = RT::URI->new( $self->CurrentUser );
 802             $URI->FromURI( $self->NewValue );
 803             if ( $URI->Resolver ) {
 804                 $value = $URI->Resolver->AsString;
 805             }
 806             else {
 807                 $value = $self->NewValue;
 808             }
 809             if ( $self->Field eq 'DependsOn' ) {
 810                 return $self->loc( "Dependency on [_1] added", $value );
 811             }
 812             elsif ( $self->Field eq 'DependedOnBy' ) {
 813                 return $self->loc( "Dependency by [_1] added", $value );
 814
 815             }
 816             elsif ( $self->Field eq 'RefersTo' ) {
 817                 return $self->loc( "Reference to [_1] added", $value );
 818             }
 819             elsif ( $self->Field eq 'ReferredToBy' ) {
 820                 return $self->loc( "Reference by [_1] added", $value );
 821             }
 822             elsif ( $self->Field eq 'MemberOf' ) {
 823                 return $self->loc( "Membership in [_1] added", $value );
 824             }
 825             elsif ( $self->Field eq 'HasMember' ) {
 826                 return $self->loc( "Member [_1] added", $value );
 827             }
 828             elsif ( $self->Field eq 'MergedInto' ) {
 829                 return $self->loc( "Merged into [_1]", $value );
 830             }
 831         }
 832         else {
 833             return ( $self->Data );
 834         }
 835     },
 836     DeleteLink => sub {
 837         my $self = shift;
 838         my $value;
 839         if ( $self->OldValue ) {
 840             my $URI = RT::URI->new( $self->CurrentUser );
 841             $URI->FromURI( $self->OldValue );
 842             if ( $URI->Resolver ) {
 843                 $value = $URI->Resolver->AsString;
 844             }
 845             else {
 846                 $value = $self->OldValue;
 847             }
 848
 849             if ( $self->Field eq 'DependsOn' ) {
 850                 return $self->loc( "Dependency on [_1] deleted", $value );
 851             }
 852             elsif ( $self->Field eq 'DependedOnBy' ) {
 853                 return $self->loc( "Dependency by [_1] deleted", $value );
 854
 855             }
 856             elsif ( $self->Field eq 'RefersTo' ) {
 857                 return $self->loc( "Reference to [_1] deleted", $value );
 858             }
 859             elsif ( $self->Field eq 'ReferredToBy' ) {
 860                 return $self->loc( "Reference by [_1] deleted", $value );
 861             }
 862             elsif ( $self->Field eq 'MemberOf' ) {
 863                 return $self->loc( "Membership in [_1] deleted", $value );
 864             }
 865             elsif ( $self->Field eq 'HasMember' ) {
 866                 return $self->loc( "Member [_1] deleted", $value );
 867             }
 868         }
 869         else {
 870             return ( $self->Data );
 871         }
 872     },
 873     Told => sub {
 874         my $self = shift;
 875         if ( $self->Field eq 'Told' ) {
 876             my $t1 = new RT::Date($self->CurrentUser);
 877             $t1->Set(Format => 'ISO', Value => $self->NewValue);
 878             my $t2 = new RT::Date($self->CurrentUser);
 879             $t2->Set(Format => 'ISO', Value => $self->OldValue);
 880             return $self->loc( "[_1] changed from [_2] to [_3]", $self->loc($self->Field), $t2->AsString, $t1->AsString );
 881         }
 882         else {
 883             return $self->loc( "[_1] changed from [_2] to [_3]",
 884                                $self->loc($self->Field),
 885                                ($self->OldValue? "'".$self->OldValue ."'" : $self->loc("(no value)")) , "'". $self->NewValue."'" );
 886         }
 887     },
 888     Set => sub {
 889         my $self = shift;
 890         if ( $self->Field eq 'Password' ) {
 891             return $self->loc('Password changed');
 892         }
 893         elsif ( $self->Field eq 'Queue' ) {
 894             my $q1 = new RT::Queue( $self->CurrentUser );
 895             $q1->Load( $self->OldValue );
 896             my $q2 = new RT::Queue( $self->CurrentUser );
 897             $q2->Load( $self->NewValue );
 898             return $self->loc("[_1] changed from [_2] to [_3]",
 899                               $self->loc($self->Field) , $q1->Name , $q2->Name);
 900         }
 901
 902         # Write the date/time change at local time:
 903         elsif ($self->Field =~  /Due|Starts|Started|Told/) {
 904             my $t1 = new RT::Date($self->CurrentUser);
 905             $t1->Set(Format => 'ISO', Value => $self->NewValue);
 906             my $t2 = new RT::Date($self->CurrentUser);
 907             $t2->Set(Format => 'ISO', Value => $self->OldValue);
 908             return $self->loc( "[_1] changed from [_2] to [_3]", $self->loc($self->Field), $t2->AsString, $t1->AsString );
 909         }
 910         else {
 911             return $self->loc( "[_1] changed from [_2] to [_3]",
 912                                $self->loc($self->Field),
 913                                ($self->OldValue? "'".$self->OldValue ."'" : $self->loc("(no value)")) , "'". $self->NewValue."'" );
 914         }
 915     },
 916     PurgeTransaction => sub {
 917         my $self = shift;
 918         return $self->loc("Transaction [_1] purged", $self->Data);
 919     },
 920     AddReminder => sub {
 921         my $self = shift;
 922         my $ticket = RT::Ticket->new($self->CurrentUser);
 923         $ticket->Load($self->NewValue);
 924         return $self->loc("Reminder '[_1]' added", $ticket->Subject);
 925     },
 926     OpenReminder => sub {
 927         my $self = shift;
 928         my $ticket = RT::Ticket->new($self->CurrentUser);
 929         $ticket->Load($self->NewValue);
 930         return $self->loc("Reminder '[_1]' reopened", $ticket->Subject);
 931
 932     },
 933     ResolveReminder => sub {
 934         my $self = shift;
 935         my $ticket = RT::Ticket->new($self->CurrentUser);
 936         $ticket->Load($self->NewValue);
 937         return $self->loc("Reminder '[_1]' completed", $ticket->Subject);
 938
 939
 940     }
 941 );
 942
 943 # }}}
 944
 945 # {{{ Utility methods
 946
 947 # {{{ sub IsInbound
 948
 949 =head2 IsInbound
 950
 951 Returns true if the creator of the transaction is a requestor of the ticket.
 952 Returns false otherwise
 953
 954 =cut
 955
 956 sub IsInbound {
 957     my $self = shift;
 958     $self->ObjectType eq 'RT::Ticket' or return undef;
 959     return ( $self->TicketObj->IsRequestor( $self->CreatorObj->PrincipalId ) );
 960 }
 961
 962 # }}}
 963
 964 # }}}
 965
 966 sub _OverlayAccessible {
 967     {
 968
 969           ObjectType => { public => 1},
 970           ObjectId => { public => 1},
 971
 972     }
 973 };
 974
 975 # }}}
 976
 977 # }}}
 978
 979 # {{{ sub _Set
 980
 981 sub _Set {
 982     my $self = shift;
 983     return ( 0, $self->loc('Transactions are immutable') );
 984 }
 985
 986 # }}}
 987
 988 # {{{ sub _Value
 989
 990 =head2 _Value
 991
 992 Takes the name of a table column.
 993 Returns its value as a string, if the user passes an ACL check
 994
 995 =cut
 996
 997 sub _Value {
 998     my $self  = shift;
 999     my $field = shift;
1000
1001     #if the field is public, return it.
1002     if ( $self->_Accessible( $field, 'public' ) ) {
1003         return $self->SUPER::_Value( $field );
1004     }
1005
1006     unless ( $self->CurrentUserCanSee ) {
1007         return undef;
1008     }
1009
1010     return $self->SUPER::_Value( $field );
1011 }
1012
1013 # }}}
1014
1015 # {{{ sub CurrentUserHasRight
1016
1017 =head2 CurrentUserHasRight RIGHT
1018
1019 Calls $self->CurrentUser->HasQueueRight for the right passed in here.
1020 passed in here.
1021
1022 =cut
1023
1024 sub CurrentUserHasRight {
1025     my $self  = shift;
1026     my $right = shift;
1027     return $self->CurrentUser->HasRight(
1028         Right  => $right,
1029         Object => $self->Object
1030     );
1031 }
1032
1033 =head2 CurrentUserCanSee
1034
1035 Returns true if current user has rights to see this particular transaction.
1036
1037 This fact depends on type of the transaction, type of an object the transaction
1038 is attached to and may be other conditions, so this method is prefered over
1039 custom implementations.
1040
1041 =cut
1042
1043 sub CurrentUserCanSee {
1044     my $self = shift;
1045
1046     # If it's a comment, we need to be extra special careful
1047     my $type = $self->__Value('Type');
1048     if ( $type eq 'Comment' ) {
1049         unless ( $self->CurrentUserHasRight('ShowTicketComments') ) {
1050             return 0;
1051         }
1052     }
1053     elsif ( $type eq 'CommentEmailRecord' ) {
1054         unless ( $self->CurrentUserHasRight('ShowTicketComments')
1055             && $self->CurrentUserHasRight('ShowOutgoingEmail') ) {
1056             return 0;
1057         }
1058     }
1059     elsif ( $type eq 'EmailRecord' ) {
1060         unless ( $self->CurrentUserHasRight('ShowOutgoingEmail') ) {
1061             return 0;
1062         }
1063     }
1064     # Make sure the user can see the custom field before showing that it changed
1065     elsif ( $type eq 'CustomField' and my $cf_id = $self->__Value('Field') ) {
1066         my $cf = RT::CustomField->new( $self->CurrentUser );
1067         $cf->SetContextObject( $self->Object );
1068         $cf->Load( $cf_id );
1069         return 0 unless $cf->CurrentUserHasRight('SeeCustomField');
1070     }
1071     #if they ain't got rights to see, don't let em
1072     elsif ( $self->__Value('ObjectType') eq "RT::Ticket" ) {
1073         unless ( $self->CurrentUserHasRight('ShowTicket') ) {
1074             return 0;
1075         }
1076     }
1077
1078     return 1;
1079 }
1080
1081 # }}}
1082
1083 sub Ticket {
1084     my $self = shift;
1085     return $self->ObjectId;
1086 }
1087
1088 sub TicketObj {
1089     my $self = shift;
1090     return $self->Object;
1091 }
1092
1093 sub OldValue {
1094     my $self = shift;
1095     if ( my $type = $self->__Value('ReferenceType')
1096          and my $id = $self->__Value('OldReference') )
1097     {
1098         my $Object = $type->new($self->CurrentUser);
1099         $Object->Load( $id );
1100         return $Object->Content;
1101     }
1102     else {
1103         return $self->__Value('OldValue');
1104     }
1105 }
1106
1107 sub NewValue {
1108     my $self = shift;
1109     if ( my $type = $self->__Value('ReferenceType')
1110          and my $id = $self->__Value('NewReference') )
1111     {
1112         my $Object = $type->new($self->CurrentUser);
1113         $Object->Load( $id );
1114         return $Object->Content;
1115     }
1116     else {
1117         return $self->__Value('NewValue');
1118     }
1119 }
1120
1121 sub Object {
1122     my $self  = shift;
1123     my $Object = $self->__Value('ObjectType')->new($self->CurrentUser);
1124     $Object->Load($self->__Value('ObjectId'));
1125     return $Object;
1126 }
1127
1128 sub FriendlyObjectType {
1129     my $self = shift;
1130     my $type = $self->ObjectType or return undef;
1131     $type =~ s/^RT:://;
1132     return $self->loc($type);
1133 }
1134
1135 =head2 UpdateCustomFields
1136
1137     Takes a hash of
1138
1139     CustomField-<<Id>> => Value
1140         or
1141
1142     Object-RT::Transaction-CustomField-<<Id>> => Value parameters to update
1143     this transaction's custom fields
1144
1145 =cut
1146
1147 sub UpdateCustomFields {
1148     my $self = shift;
1149     my %args = (@_);
1150
1151     # This method used to have an API that took a hash of a single
1152     # value "ARGSRef", which was a reference to a hash of arguments.
1153     # This was insane. The next few lines of code preserve that API
1154     # while giving us something saner.
1155
1156     # TODO: 3.6: DEPRECATE OLD API
1157
1158     my $args;
1159
1160     if ($args{'ARGSRef'}) {
1161         $args = $args{ARGSRef};
1162     } else {
1163         $args = \%args;
1164     }
1165
1166     foreach my $arg ( keys %$args ) {
1167         next
1168           unless ( $arg =~
1169             /^(?:Object-RT::Transaction--)?CustomField-(\d+)/ );
1170         next if $arg =~ /-Magic$/;
1171         next if $arg =~ /-TimeUnits$/;
1172         my $cfid   = $1;
1173         my $values = $args->{$arg};
1174         foreach
1175           my $value ( UNIVERSAL::isa( $values, 'ARRAY' ) ? @$values : $values )
1176         {
1177             next unless length($value);
1178             $self->_AddCustomFieldValue(
1179                 Field             => $cfid,
1180                 Value             => $value,
1181                 RecordTransaction => 0,
1182             );
1183         }
1184     }
1185 }
1186
1187
1188
1189 =head2 CustomFieldValues
1190
1191  Do name => id mapping (if needed) before falling back to RT::Record's CustomFieldValues
1192
1193  See L<RT::Record>
1194
1195 =cut
1196
1197 sub CustomFieldValues {
1198     my $self  = shift;
1199     my $field = shift;
1200
1201     if ( UNIVERSAL::can( $self->Object, 'QueueObj' ) ) {
1202
1203         # XXX: $field could be undef when we want fetch values for all CFs
1204         #      do we want to cover this situation somehow here?
1205         unless ( defined $field && $field =~ /^\d+$/o ) {
1206             my $CFs = RT::CustomFields->new( $self->CurrentUser );
1207             $CFs->Limit( FIELD => 'Name', VALUE => $field );
1208             $CFs->LimitToLookupType($self->CustomFieldLookupType);
1209             $CFs->LimitToGlobalOrObjectId($self->Object->QueueObj->id);
1210             $field = $CFs->First->id if $CFs->First;
1211         }
1212     }
1213     return $self->SUPER::CustomFieldValues($field);
1214 }
1215
1216 # }}}
1217
1218 # {{{ sub CustomFieldLookupType
1219
1220 =head2 CustomFieldLookupType
1221
1222 Returns the RT::Transaction lookup type, which can
1223 be passed to RT::CustomField->Create() via the 'LookupType' hash key.
1224
1225 =cut
1226
1227 # }}}
1228
1229 sub CustomFieldLookupType {
1230     "RT::Queue-RT::Ticket-RT::Transaction";
1231 }
1232
1233
1234 =head2 DeferredRecipients($freq, $include_sent )
1235
1236 Takes the following arguments:
1237
1238 =over
1239
1240 =item * a string to indicate the frequency of digest delivery.  Valid values are "daily", "weekly", or "susp".
1241
1242 =item * an optional argument which, if true, will return addresses even if this notification has been marked as 'sent' for this transaction.
1243
1244 =back
1245
1246 Returns an array of users who should now receive the notification that
1247 was recorded in this transaction.  Returns an empty array if there were
1248 no deferred users, or if $include_sent was not specified and the deferred
1249 notifications have been sent.
1250
1251 =cut
1252
1253 sub DeferredRecipients {
1254     my $self = shift;
1255     my $freq = shift;
1256     my $include_sent = @_? shift : 0;
1257
1258     my $attr = $self->FirstAttribute('DeferredRecipients');
1259
1260     return () unless ($attr);
1261
1262     my $deferred = $attr->Content;
1263
1264     return () unless ( ref($deferred) eq 'HASH' && exists $deferred->{$freq} );
1265
1266     # Skip it.
1267
1268     for my $user (keys %{$deferred->{$freq}}) {
1269         if ($deferred->{$freq}->{$user}->{_sent} && !$include_sent) {
1270             delete $deferred->{$freq}->{$user}
1271         }
1272     }
1273     # Now get our users.  Easy.
1274
1275     return keys %{ $deferred->{$freq} };
1276 }
1277
1278
1279
1280 # Transactions don't change. by adding this cache config directive, we don't lose pathalogically on long tickets.
1281 sub _CacheConfig {
1282   {
1283      'cache_p'        => 1,
1284      'fast_update_p'  => 1,
1285      'cache_for_sec'  => 6000,
1286   }
1287 }
1288
1289
1290 =head2 ACLEquivalenceObjects
1291
1292 This method returns a list of objects for which a user's rights also apply
1293 to this Transaction.
1294
1295 This currently only applies to Transaction Custom Fields on Tickets, so we return
1296 the Ticket's Queue and the Ticket.
1297
1298 This method is called from L<RT::Principal/HasRight>.
1299
1300 =cut
1301
1302 sub ACLEquivalenceObjects {
1303     my $self = shift;
1304
1305     return unless $self->ObjectType eq 'RT::Ticket';
1306     my $object = $self->Object;
1307     return $object,$object->QueueObj;
1308
1309 }
1310
1311 1;