rt/lib/RT/Transaction_Overlay.pm

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