rt/lib/RT/Transaction.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2016 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 base 'RT::Record';
  75 use strict;
  76 use warnings;
  77
  78
  79 use vars qw( %_BriefDescriptions $PreferredContentType );
  80
  81 use RT::Attachments;
  82 use RT::Scrips;
  83 use RT::Ruleset;
  84
  85 use HTML::FormatText::WithLinks::AndTables;
  86 use HTML::Scrubber;
  87
  88 # For EscapeHTML() and decode_entities()
  89 require RT::Interface::Web;
  90 require HTML::Entities;
  91
  92 sub Table {'Transactions'}
  93
  94 # {{{ sub Create
  95
  96 =head2 Create
  97
  98 Create a new transaction.
  99
 100 This routine should _never_ be called by anything other than RT::Ticket.
 101 It should not be called
 102 from client code. Ever. Not ever.  If you do this, we will hunt you down and break your kneecaps.
 103 Then the unpleasant stuff will start.
 104
 105 TODO: Document what gets passed to this
 106
 107 =cut
 108
 109 sub Create {
 110     my $self = shift;
 111     my %args = (
 112         id             => undef,
 113         TimeTaken      => 0,
 114         Type           => 'undefined',
 115         Data           => '',
 116         Field          => undef,
 117         OldValue       => undef,
 118         NewValue       => undef,
 119         MIMEObj        => undef,
 120         ActivateScrips => 1,
 121         CommitScrips   => 1,
 122         ObjectType     => 'RT::Ticket',
 123         ObjectId       => 0,
 124         ReferenceType  => undef,
 125         OldReference   => undef,
 126         NewReference   => undef,
 127         SquelchMailTo  => undef,
 128         CustomFields   => {},
 129         @_
 130     );
 131
 132     $args{ObjectId} ||= $args{Ticket};
 133
 134     #if we didn't specify a ticket, we need to bail
 135     unless ( $args{'ObjectId'} && $args{'ObjectType'}) {
 136         return ( 0, $self->loc( "Transaction->Create couldn't, as you didn't specify an object type and id"));
 137     }
 138
 139     #lets create our transaction
 140     my %params = (
 141         Type      => $args{'Type'},
 142         Data      => $args{'Data'},
 143         Field     => $args{'Field'},
 144         OldValue  => $args{'OldValue'},
 145         NewValue  => $args{'NewValue'},
 146         Created   => $args{'Created'},
 147         ObjectType => $args{'ObjectType'},
 148         ObjectId => $args{'ObjectId'},
 149         ReferenceType => $args{'ReferenceType'},
 150         OldReference => $args{'OldReference'},
 151         NewReference => $args{'NewReference'},
 152     );
 153
 154     # Parameters passed in during an import that we probably don't want to touch, otherwise
 155     foreach my $attr (qw(id Creator Created LastUpdated TimeTaken LastUpdatedBy)) {
 156         $params{$attr} = $args{$attr} if ($args{$attr});
 157     }
 158
 159     my $id = $self->SUPER::Create(%params);
 160     $self->Load($id);
 161     if ( defined $args{'MIMEObj'} ) {
 162         my ($id, $msg) = $self->_Attach( $args{'MIMEObj'} );
 163         unless ( $id ) {
 164             $RT::Logger->error("Couldn't add attachment: $msg");
 165             return ( 0, $self->loc("Couldn't add attachment") );
 166         }
 167     }
 168
 169     # Set up any custom fields passed at creation.  Has to happen
 170     # before scrips.
 171
 172     $self->UpdateCustomFields(%{ $args{'CustomFields'} });
 173
 174     $self->AddAttribute(
 175         Name    => 'SquelchMailTo',
 176         Content => RT::User->CanonicalizeEmailAddress($_)
 177     ) for @{$args{'SquelchMailTo'} || []};
 178
 179     my @return = ( $id, $self->loc("Transaction Created") );
 180
 181     return @return unless $args{'ObjectType'} eq 'RT::Ticket';
 182
 183     # Provide a way to turn off scrips if we need to
 184     unless ( $args{'ActivateScrips'} ) {
 185         $RT::Logger->debug('Skipping scrips for transaction #' .$self->Id);
 186         return @return;
 187     }
 188
 189     $self->{'scrips'} = RT::Scrips->new(RT->SystemUser);
 190
 191     $RT::Logger->debug('About to prepare scrips for transaction #' .$self->Id);
 192
 193     $self->{'scrips'}->Prepare(
 194         Stage       => 'TransactionCreate',
 195         Type        => $args{'Type'},
 196         Ticket      => $args{'ObjectId'},
 197         Transaction => $self->id,
 198     );
 199
 200    # Entry point of the rule system
 201    my $ticket = RT::Ticket->new(RT->SystemUser);
 202    $ticket->Load($args{'ObjectId'});
 203    my $txn = RT::Transaction->new($RT::SystemUser);
 204    $txn->Load($self->id);
 205
 206    my $rules = $self->{rules} = RT::Ruleset->FindAllRules(
 207         Stage       => 'TransactionCreate',
 208         Type        => $args{'Type'},
 209         TicketObj   => $ticket,
 210         TransactionObj => $txn,
 211    );
 212
 213     if ($args{'CommitScrips'} ) {
 214         $RT::Logger->debug('About to commit scrips for transaction #' .$self->Id);
 215         $self->{'scrips'}->Commit();
 216         RT::Ruleset->CommitRules($rules);
 217     }
 218
 219     return @return;
 220 }
 221
 222
 223 =head2 Scrips
 224
 225 Returns the Scrips object for this transaction.
 226 This routine is only useful on a freshly created transaction object.
 227 Scrips do not get persisted to the database with transactions.
 228
 229
 230 =cut
 231
 232
 233 sub Scrips {
 234     my $self = shift;
 235     return($self->{'scrips'});
 236 }
 237
 238
 239 =head2 Rules
 240
 241 Returns the array of Rule objects for this transaction.
 242 This routine is only useful on a freshly created transaction object.
 243 Rules do not get persisted to the database with transactions.
 244
 245
 246 =cut
 247
 248
 249 sub Rules {
 250     my $self = shift;
 251     return($self->{'rules'});
 252 }
 253
 254
 255
 256 =head2 Delete
 257
 258 Delete this transaction. Currently DOES NOT CHECK ACLS
 259
 260 =cut
 261
 262 sub Delete {
 263     my $self = shift;
 264
 265
 266     $RT::Handle->BeginTransaction();
 267
 268     my $attachments = $self->Attachments;
 269
 270     while (my $attachment = $attachments->Next) {
 271         my ($id, $msg) = $attachment->Delete();
 272         unless ($id) {
 273             $RT::Handle->Rollback();
 274             return($id, $self->loc("System Error: [_1]", $msg));
 275         }
 276     }
 277     my ($id,$msg) = $self->SUPER::Delete();
 278         unless ($id) {
 279             $RT::Handle->Rollback();
 280             return($id, $self->loc("System Error: [_1]", $msg));
 281         }
 282     $RT::Handle->Commit();
 283     return ($id,$msg);
 284 }
 285
 286
 287
 288
 289 =head2 Message
 290
 291 Returns the L<RT::Attachments> object which contains the "top-level" object
 292 attachment for this transaction.
 293
 294 =cut
 295
 296 sub Message {
 297     my $self = shift;
 298
 299     # XXX: Where is ACL check?
 300
 301     unless ( defined $self->{'message'} ) {
 302
 303         $self->{'message'} = RT::Attachments->new( $self->CurrentUser );
 304         $self->{'message'}->Limit(
 305             FIELD => 'TransactionId',
 306             VALUE => $self->Id
 307         );
 308         $self->{'message'}->ChildrenOf(0);
 309     } else {
 310         $self->{'message'}->GotoFirstItem;
 311     }
 312     return $self->{'message'};
 313 }
 314
 315
 316
 317 =head2 HasContent
 318
 319 Returns whether this transaction has attached mime objects.
 320
 321 =cut
 322
 323 sub HasContent {
 324     my $self = shift;
 325     my $type = $PreferredContentType || '';
 326     return !!$self->ContentObj( $type ? ( Type => $type) : () );
 327 }
 328
 329
 330
 331 =head2 Content PARAMHASH
 332
 333 If this transaction has attached mime objects, returns the body of the first
 334 textual part (as defined in RT::I18N::IsTextualContentType).  Otherwise,
 335 returns the message "This transaction appears to have no content".
 336
 337 Takes a paramhash.  If the $args{'Quote'} parameter is set, wraps this message
 338 at $args{'Wrap'}.  $args{'Wrap'} defaults to $RT::MessageBoxWidth - 2 or 70.
 339
 340 If $args{'Type'} is set to C<text/html>, this will return an HTML
 341 part of the message, if available.  Otherwise it looks for a text/plain
 342 part. If $args{'Type'} is missing, it defaults to the value of
 343 C<$RT::Transaction::PreferredContentType>, if that's missing too,
 344 defaults to textual.
 345
 346 =cut
 347
 348 sub Content {
 349     my $self = shift;
 350     my %args = (
 351         Type => $PreferredContentType || '',
 352         Quote => 0,
 353         Wrap  => 70,
 354         Wrap  => ( $RT::MessageBoxWidth || 72 ) - 2,
 355         @_
 356     );
 357
 358     my $content;
 359     if ( my $content_obj =
 360         $self->ContentObj( $args{Type} ? ( Type => $args{Type}) : () ) )
 361     {
 362         $content = $content_obj->Content ||'';
 363
 364         if ( lc $content_obj->ContentType eq 'text/html' ) {
 365             $content =~ s/(?:(<\/div>)|<p>|<br\s*\/?>|<div(\s+class="[^"]+")?>)\s*--\s+<br\s*\/?>.*?$/$1/s if $args{'Quote'};
 366
 367             if ($args{Type} ne 'text/html') {
 368                 $content = RT::Interface::Email::ConvertHTMLToText($content);
 369             } else {
 370                 # Scrub out <html>, <head>, <meta>, and <body>, and
 371                 # leave all else untouched.
 372                 my $scrubber = HTML::Scrubber->new();
 373                 $scrubber->rules(
 374                     html => 0,
 375                     head => 0,
 376                     meta => 0,
 377                     body => 0,
 378                 );
 379                 $scrubber->default( 1 => { '*' => 1 } );
 380                 $content = $scrubber->scrub( $content );
 381             }
 382         }
 383         else {
 384             $content =~ s/\n-- \n.*?$//s if $args{'Quote'};
 385             if ($args{Type} eq 'text/html') {
 386                 # Extremely simple text->html converter
 387                 $content =~ s/&/&#38;/g;
 388                 $content =~ s/</&lt;/g;
 389                 $content =~ s/>/&gt;/g;
 390                 $content = qq|<pre style="white-space: pre-wrap; font-family: monospace;">$content</pre>|;
 391             }
 392         }
 393     }
 394
 395     # If all else fails, return a message that we couldn't find any content
 396     else {
 397         $content = $self->loc('This transaction appears to have no content');
 398     }
 399
 400     if ( $args{'Quote'} ) {
 401         if ($args{Type} eq 'text/html') {
 402             $content = '<div class="gmail_quote">'
 403                 . $self->QuoteHeader
 404                 . '<br /><blockquote class="gmail_quote" type="cite">'
 405                 . $content
 406                 . '</blockquote></div><br /><br />';
 407         } else {
 408             $content = $self->ApplyQuoteWrap(content => $content,
 409                                              cols    => $args{'Wrap'} );
 410
 411             $content = $self->QuoteHeader . "\n$content\n\n";
 412         }
 413     }
 414
 415     return ($content);
 416 }
 417
 418 =head2 QuoteHeader
 419
 420 Returns text prepended to content when transaction is quoted
 421 (see C<Quote> argument in L</Content>). By default returns
 422 localized "On <date> <user name> wrote:\n".
 423
 424 =cut
 425
 426 sub QuoteHeader {
 427     my $self = shift;
 428     return $self->loc("On [_1], [_2] wrote:", $self->CreatedAsString, $self->CreatorObj->Name);
 429 }
 430
 431 =head2 ApplyQuoteWrap PARAMHASH
 432
 433 Wrapper to calculate wrap criteria and apply quote wrapping if needed.
 434
 435 =cut
 436
 437 sub ApplyQuoteWrap {
 438     my $self = shift;
 439     my %args = @_;
 440     my $content = $args{content};
 441
 442     # What's the longest line like?
 443     my $max = 0;
 444     foreach ( split ( /\n/, $args{content} ) ) {
 445         $max = length if length > $max;
 446     }
 447
 448     if ( $max > 76 ) {
 449         require Text::Quoted;
 450         require Text::Wrapper;
 451
 452         my $structure = Text::Quoted::extract($args{content});
 453         $content = $self->QuoteWrap(content_ref => $structure,
 454                                     cols        => $args{cols},
 455                                     max         => $max );
 456     }
 457
 458     $content =~ s/^/> /gm;  # use regex since string might be multi-line
 459     return $content;
 460 }
 461
 462 =head2 QuoteWrap PARAMHASH
 463
 464 Wrap the contents of transactions based on Wrap settings, maintaining
 465 the quote character from the original.
 466
 467 =cut
 468
 469 sub QuoteWrap {
 470     my $self = shift;
 471     my %args = @_;
 472     my $ref = $args{content_ref};
 473     my $final_string;
 474
 475     if ( ref $ref eq 'ARRAY' ){
 476         foreach my $array (@$ref){
 477             $final_string .= $self->QuoteWrap(content_ref => $array,
 478                                               cols        => $args{cols},
 479                                               max         => $args{max} );
 480         }
 481     }
 482     elsif ( ref $ref eq 'HASH' ){
 483         return $ref->{quoter} . "\n" if $ref->{empty}; # Blank line
 484
 485         my $col = $args{cols} - (length $ref->{quoter});
 486         my $wrapper = Text::Wrapper->new( columns => $col );
 487
 488         # Wrap on individual lines to honor incoming line breaks
 489         # Otherwise deliberate separate lines (like a list or a sig)
 490         # all get combined incorrectly into single paragraphs.
 491
 492         my @lines = split /\n/, $ref->{text};
 493         my $wrap = join '', map { $wrapper->wrap($_) } @lines;
 494         my $quoter = $ref->{quoter};
 495
 496         # Only add the space if actually quoting
 497         $quoter .= ' ' if length $quoter;
 498         $wrap =~ s/^/$quoter/mg;  # use regex since string might be multi-line
 499
 500         return $wrap;
 501     }
 502     else{
 503         $RT::Logger->warning("Can't apply quoting with $ref");
 504         return;
 505     }
 506     return $final_string;
 507 }
 508
 509
 510 =head2 Addresses
 511
 512 Returns a hashref of addresses related to this transaction. See L<RT::Attachment/Addresses> for details.
 513
 514 =cut
 515
 516 sub Addresses {
 517     my $self = shift;
 518
 519     if (my $attach = $self->Attachments->First) {
 520         return $attach->Addresses;
 521     }
 522     else {
 523         return {};
 524     }
 525
 526 }
 527
 528
 529
 530 =head2 ContentObj
 531
 532 Returns the RT::Attachment object which contains the content for this Transaction
 533
 534 =cut
 535
 536
 537 sub ContentObj {
 538     my $self = shift;
 539     my %args = ( Type => $PreferredContentType, Attachment => undef, @_ );
 540
 541     # If we don't have any content, return undef now.
 542     # Get the set of toplevel attachments to this transaction.
 543
 544     my $Attachment = $args{'Attachment'};
 545
 546     $Attachment ||= $self->Attachments->First;
 547
 548     return undef unless ($Attachment);
 549
 550     my $Attachments = $self->Attachments;
 551     while ( my $Attachment = $Attachments->Next ) {
 552         if ( my $content = _FindPreferredContentObj( %args, Attachment => $Attachment ) ) {
 553             return $content;
 554         }
 555     }
 556
 557     # If that fails, return the first top-level textual part which has some content.
 558     # We probably really want this to become "recurse, looking for the other type of
 559     # displayable".  For now, this maintains backcompat
 560     my $all_parts = $self->Attachments;
 561     while ( my $part = $all_parts->Next ) {
 562         next unless _IsDisplayableTextualContentType($part->ContentType)
 563         && $part->Content;
 564         return $part;
 565     }
 566
 567     return;
 568 }
 569
 570
 571 sub _FindPreferredContentObj {
 572     my %args = @_;
 573     my $Attachment = $args{Attachment};
 574
 575     # If we don't have any content, return undef now.
 576     return undef unless $Attachment;
 577
 578     # If it's a textual part, just return the body.
 579     if ( _IsDisplayableTextualContentType($Attachment->ContentType) ) {
 580         return ($Attachment);
 581     }
 582
 583     # If it's a multipart object, first try returning the first part with preferred
 584     # MIME type ('text/plain' by default).
 585
 586     elsif ( $Attachment->ContentType =~ m|^multipart/mixed|i ) {
 587         my $kids = $Attachment->Children;
 588         while (my $child = $kids->Next) {
 589             my $ret =  _FindPreferredContentObj(%args, Attachment => $child);
 590             return $ret if ($ret);
 591         }
 592     }
 593     elsif ( $Attachment->ContentType =~ m|^multipart/|i ) {
 594         if ( $args{Type} ) {
 595             my $plain_parts = $Attachment->Children;
 596             $plain_parts->ContentType( VALUE => $args{Type} );
 597             $plain_parts->LimitNotEmpty;
 598
 599             # If we actully found a part, return its content
 600             if ( my $first = $plain_parts->First ) {
 601                 return $first;
 602             }
 603         } else {
 604             my $parts = $Attachment->Children;
 605             $parts->LimitNotEmpty;
 606
 607             # If we actully found a part, return its content
 608             while (my $part = $parts->Next) {
 609                 next unless _IsDisplayableTextualContentType($part->ContentType);
 610                 return $part;
 611             }
 612
 613         }
 614     }
 615
 616     # If this is a message/rfc822 mail, we need to dig into it in order to find
 617     # the actual textual content
 618
 619     elsif ( $Attachment->ContentType =~ '^message/rfc822' ) {
 620         my $children = $Attachment->Children;
 621         while ( my $child = $children->Next ) {
 622             if ( my $content = _FindPreferredContentObj( %args, Attachment => $child ) ) {
 623                 return $content;
 624             }
 625         }
 626     }
 627
 628     # We found no content. suck
 629     return (undef);
 630 }
 631
 632 =head2 _IsDisplayableTextualContentType
 633
 634 We may need to pull this out to another module later, but for now, this
 635 is better than RT::I18N::IsTextualContentType because that believes that
 636 a message/rfc822 email is displayable, despite it having no content
 637
 638 =cut
 639
 640 sub _IsDisplayableTextualContentType {
 641     my $type = shift;
 642     ($type =~ m{^text/(?:plain|html)\b}i) ? 1 : 0;
 643 }
 644
 645
 646 =head2 Subject
 647
 648 If this transaction has attached mime objects, returns the first one's subject
 649 Otherwise, returns null
 650
 651 =cut
 652
 653 sub Subject {
 654     my $self = shift;
 655     return undef unless my $first = $self->Attachments->First;
 656     return $first->Subject;
 657 }
 658
 659
 660
 661 =head2 Attachments
 662
 663 Returns all the RT::Attachment objects which are attached
 664 to this transaction. Takes an optional parameter, which is
 665 a ContentType that Attachments should be restricted to.
 666
 667 =cut
 668
 669 sub Attachments {
 670     my $self = shift;
 671
 672     if ( $self->{'attachments'} ) {
 673         $self->{'attachments'}->GotoFirstItem;
 674         return $self->{'attachments'};
 675     }
 676
 677     $self->{'attachments'} = RT::Attachments->new( $self->CurrentUser );
 678
 679     unless ( $self->CurrentUserCanSee ) {
 680         $self->{'attachments'}->Limit(FIELD => 'id', VALUE => '0', SUBCLAUSE => 'acl');
 681         return $self->{'attachments'};
 682     }
 683
 684     $self->{'attachments'}->Limit( FIELD => 'TransactionId', VALUE => $self->Id );
 685
 686     # Get the self->{'attachments'} in the order they're put into
 687     # the database.  Arguably, we should be returning a tree
 688     # of self->{'attachments'}, not a set...but no current app seems to need
 689     # it.
 690
 691     $self->{'attachments'}->OrderBy( FIELD => 'id', ORDER => 'ASC' );
 692
 693     return $self->{'attachments'};
 694 }
 695
 696
 697
 698 =head2 _Attach
 699
 700 A private method used to attach a mime object to this transaction.
 701
 702 =cut
 703
 704 sub _Attach {
 705     my $self       = shift;
 706     my $MIMEObject = shift;
 707
 708     unless ( defined $MIMEObject ) {
 709         $RT::Logger->error("We can't attach a mime object if you don't give us one.");
 710         return ( 0, $self->loc("[_1]: no attachment specified", $self) );
 711     }
 712
 713     my $Attachment = RT::Attachment->new( $self->CurrentUser );
 714     my ($id, $msg) = $Attachment->Create(
 715         TransactionId => $self->Id,
 716         Attachment    => $MIMEObject
 717     );
 718     return ( $Attachment, $msg || $self->loc("Attachment created") );
 719 }
 720
 721
 722
 723 sub ContentAsMIME {
 724     my $self = shift;
 725
 726     # RT::Attachments doesn't limit ACLs as strictly as RT::Transaction does
 727     # since it has less information available without looking to it's parent
 728     # transaction.  Check ACLs here before we go any further.
 729     return unless $self->CurrentUserCanSee;
 730
 731     my $attachments = RT::Attachments->new( $self->CurrentUser );
 732     $attachments->OrderBy( FIELD => 'id', ORDER => 'ASC' );
 733     $attachments->Limit( FIELD => 'TransactionId', VALUE => $self->id );
 734     $attachments->Limit( FIELD => 'Parent',        VALUE => 0 );
 735     $attachments->RowsPerPage(1);
 736
 737     my $top = $attachments->First;
 738     return unless $top;
 739
 740     my $entity = MIME::Entity->build(
 741         Type        => 'message/rfc822',
 742         Description => 'transaction ' . $self->id,
 743         Data        => $top->ContentAsMIME(Children => 1)->as_string,
 744     );
 745
 746     return $entity;
 747 }
 748
 749
 750
 751 =head2 Description
 752
 753 Returns a text string which describes this transaction
 754
 755 =cut
 756
 757 sub Description {
 758     my $self = shift;
 759
 760     unless ( $self->CurrentUserCanSee ) {
 761         return ( $self->loc("Permission Denied") );
 762     }
 763
 764     unless ( defined $self->Type ) {
 765         return ( $self->loc("No transaction type specified"));
 766     }
 767
 768     return $self->loc("[_1] by [_2]", $self->BriefDescription , $self->CreatorObj->Name );
 769 }
 770
 771
 772
 773 =head2 BriefDescription
 774
 775 Returns a text string which briefly describes this transaction
 776
 777 =cut
 778
 779 {
 780     my $scrubber = HTML::Scrubber->new(default => 0); # deny everything
 781
 782     sub BriefDescription {
 783         my $self = shift;
 784         my $desc = $self->BriefDescriptionAsHTML;
 785            $desc = $scrubber->scrub($desc);
 786            $desc = HTML::Entities::decode_entities($desc);
 787         return $desc;
 788     }
 789 }
 790
 791 =head2 BriefDescriptionAsHTML
 792
 793 Returns an HTML string which briefly describes this transaction.
 794
 795 =cut
 796
 797 sub BriefDescriptionAsHTML {
 798     my $self = shift;
 799
 800     unless ( $self->CurrentUserCanSee ) {
 801         return ( $self->loc("Permission Denied") );
 802     }
 803
 804     my ($objecttype, $type, $field) = ($self->ObjectType, $self->Type, $self->Field);
 805
 806     unless ( defined $type ) {
 807         return $self->loc("No transaction type specified");
 808     }
 809
 810     my ($template, @params);
 811
 812     my @code = grep { ref eq 'CODE' } map { $_BriefDescriptions{$_} }
 813         ( $field
 814             ? ("$objecttype-$type-$field", "$type-$field")
 815             : () ),
 816         "$objecttype-$type", $type;
 817
 818     if (@code) {
 819         ($template, @params) = $code[0]->($self);
 820     }
 821
 822     unless ($template) {
 823         ($template, @params) = (
 824             "Default: [_1]/[_2] changed from [_3] to [_4]", #loc
 825             $type,
 826             $field,
 827             (
 828                 $self->OldValue
 829                 ? "'" . $self->OldValue . "'"
 830                 : $self->loc("(no value)")
 831             ),
 832             (
 833                 $self->NewValue
 834                 ? "'" . $self->NewValue . "'"
 835                 : $self->loc("(no value)")
 836             ),
 837         );
 838     }
 839     return $self->loc($template, $self->_ProcessReturnValues(@params));
 840 }
 841
 842 sub _ProcessReturnValues {
 843     my $self   = shift;
 844     my @values = @_;
 845     return map {
 846         if    (ref eq 'ARRAY')  { $_ = join "", $self->_ProcessReturnValues(@$_) }
 847         elsif (ref eq 'SCALAR') { $_ = $$_ }
 848         else                    { RT::Interface::Web::EscapeHTML(\$_) }
 849         $_
 850     } @values;
 851 }
 852
 853 sub _FormatPrincipal {
 854     my $self = shift;
 855     my $principal = shift;
 856     if ($principal->IsUser) {
 857         return $self->_FormatUser( $principal->Object );
 858     } else {
 859         return $self->loc("group [_1]", $principal->Object->Name);
 860     }
 861 }
 862
 863 sub _FormatUser {
 864     my $self = shift;
 865     my $user = shift;
 866     return [
 867         \'<span class="user" data-replace="user" data-user-id="', $user->id, \'">',
 868         $user->Format,
 869         \'</span>'
 870     ];
 871 }
 872
 873 %_BriefDescriptions = (
 874     Create => sub {
 875         my $self = shift;
 876         return ( "[_1] created", $self->FriendlyObjectType );   #loc()
 877     },
 878     Enabled => sub {
 879         my $self = shift;
 880         return ( "[_1] enabled", $self->Field ? $self->loc($self->Field) : $self->FriendlyObjectType );   #loc()
 881     },
 882     Disabled => sub {
 883         my $self = shift;
 884         return ( "[_1] disabled", $self->Field ? $self->loc($self->Field) : $self->FriendlyObjectType );  #loc()
 885     },
 886     Status => sub {
 887         my $self = shift;
 888         if ( $self->Field eq 'Status' ) {
 889             if ( $self->NewValue eq 'deleted' ) {
 890                 return ( "[_1] deleted", $self->FriendlyObjectType );   #loc()
 891             }
 892             else {
 893                 my $canon = $self->Object->DOES("RT::Record::Role::Status")
 894                     ? sub { $self->Object->LifecycleObj->CanonicalCase(@_) }
 895                     : sub { return $_[0] };
 896                 return (
 897                     "Status changed from [_1] to [_2]",
 898                     "'" . $self->loc( $canon->($self->OldValue) ) . "'",
 899                     "'" . $self->loc( $canon->($self->NewValue) ) . "'"
 900                 );   # loc()
 901             }
 902         }
 903
 904         # Generic:
 905         my $no_value = $self->loc("(no value)");
 906         return (
 907             "[_1] changed from [_2] to [_3]",
 908             $self->Field,
 909             ( $self->OldValue ? "'" . $self->OldValue . "'" : $no_value ),
 910             "'" . $self->NewValue . "'"
 911         ); #loc()
 912     },
 913     SystemError => sub {
 914         my $self = shift;
 915         return $self->Data // ("System error"); #loc()
 916     },
 917     AttachmentTruncate => sub {
 918         my $self = shift;
 919         if ( defined $self->Data ) {
 920             return ( "File '[_1]' truncated because its size ([_2] bytes) exceeded configured maximum size setting ([_3] bytes).",
 921                 $self->Data, $self->OldValue, $self->NewValue ); #loc()
 922         }
 923         else {
 924             return ( "Content truncated because its size ([_1] bytes) exceeded configured maximum size setting ([_2] bytes).",
 925                 $self->OldValue, $self->NewValue ); #loc()
 926         }
 927     },
 928     AttachmentDrop => sub {
 929         my $self = shift;
 930         if ( defined $self->Data ) {
 931             return ( "File '[_1]' dropped because its size ([_2] bytes) exceeded configured maximum size setting ([_3] bytes).",
 932                 $self->Data, $self->OldValue, $self->NewValue ); #loc()
 933         }
 934         else {
 935             return ( "Content dropped because its size ([_1] bytes) exceeded configured maximum size setting ([_2] bytes).",
 936                 $self->OldValue, $self->NewValue ); #loc()
 937         }
 938     },
 939     AttachmentError => sub {
 940         my $self = shift;
 941         if ( defined $self->Data ) {
 942             return ( "File '[_1]' insert failed. See error log for details.", $self->Data ); #loc()
 943         }
 944         else {
 945             return ( "Content insert failed. See error log for details." ); #loc()
 946         }
 947     },
 948     "Forward Transaction" => sub {
 949         my $self = shift;
 950         my $recipients = join ", ", map {
 951             RT::User->Format( Address => $_, CurrentUser => $self->CurrentUser )
 952         } RT::EmailParser->ParseEmailAddress($self->Data);
 953
 954         return ( "Forwarded [_3]Transaction #[_1][_4] to [_2]",
 955             $self->Field, $recipients,
 956             [\'<a href="#txn-', $self->Field, \'">'], \'</a>'); #loc()
 957     },
 958     "Forward Ticket" => sub {
 959         my $self = shift;
 960         my $recipients = join ", ", map {
 961             RT::User->Format( Address => $_, CurrentUser => $self->CurrentUser )
 962         } RT::EmailParser->ParseEmailAddress($self->Data);
 963
 964         return ( "Forwarded Ticket to [_1]", $recipients ); #loc()
 965     },
 966     CommentEmailRecord => sub {
 967         my $self = shift;
 968         return ("Outgoing email about a comment recorded"); #loc()
 969     },
 970     EmailRecord => sub {
 971         my $self = shift;
 972         return ("Outgoing email recorded"); #loc()
 973     },
 974     Correspond => sub {
 975         my $self = shift;
 976         return ("Correspondence added");    #loc()
 977     },
 978     Comment => sub {
 979         my $self = shift;
 980         return ("Comments added");          #loc()
 981     },
 982     CustomField => sub {
 983         my $self = shift;
 984         my $field = $self->loc('CustomField');
 985
 986         my $cf;
 987         if ( $self->Field ) {
 988             $cf = RT::CustomField->new( $self->CurrentUser );
 989             $cf->SetContextObject( $self->Object );
 990             $cf->Load( $self->Field );
 991             $field = $cf->Name();
 992             $field = $self->loc('a custom field') if !defined($field);
 993         }
 994
 995         my $new = $self->NewValue;
 996         my $old = $self->OldValue;
 997
 998         if ( $cf ) {
 999
1000             if ( $cf->Type eq 'DateTime' ) {
1001                 if ($old) {
1002                     my $date = RT::Date->new( $self->CurrentUser );
1003                     $date->Set( Format => 'ISO', Value => $old );
1004                     $old = $date->AsString;
1005                 }
1006
1007                 if ($new) {
1008                     my $date = RT::Date->new( $self->CurrentUser );
1009                     $date->Set( Format => 'ISO', Value => $new );
1010                     $new = $date->AsString;
1011                 }
1012             }
1013             elsif ( $cf->Type eq 'Date' ) {
1014                 if ($old) {
1015                     my $date = RT::Date->new( $self->CurrentUser );
1016                     $date->Set(
1017                         Format   => 'unknown',
1018                         Value    => $old,
1019                         Timezone => 'UTC',
1020                     );
1021                     $old = $date->AsString( Time => 0, Timezone => 'UTC' );
1022                 }
1023
1024                 if ($new) {
1025                     my $date = RT::Date->new( $self->CurrentUser );
1026                     $date->Set(
1027                         Format   => 'unknown',
1028                         Value    => $new,
1029                         Timezone => 'UTC',
1030                     );
1031                     $new = $date->AsString( Time => 0, Timezone => 'UTC' );
1032                 }
1033             }
1034         }
1035
1036         if ( !defined($old) || $old eq '' ) {
1037             return ("[_1] [_2] added", $field, $new);   #loc()
1038         }
1039         elsif ( !defined($new) || $new eq '' ) {
1040             return ("[_1] [_2] deleted", $field, $old); #loc()
1041         }
1042         else {
1043             return ("[_1] [_2] changed to [_3]", $field, $old, $new);   #loc()
1044         }
1045     },
1046     Untake => sub {
1047         my $self = shift;
1048         return ("Untaken"); #loc()
1049     },
1050     Take => sub {
1051         my $self = shift;
1052         return ("Taken"); #loc()
1053     },
1054     Force => sub {
1055         my $self = shift;
1056         my $Old = RT::User->new( $self->CurrentUser );
1057         $Old->Load( $self->OldValue );
1058         my $New = RT::User->new( $self->CurrentUser );
1059         $New->Load( $self->NewValue );
1060
1061         return ("Owner forcibly changed from [_1] to [_2]",
1062                 map { $self->_FormatUser($_) } $Old, $New);  #loc()
1063     },
1064     Steal => sub {
1065         my $self = shift;
1066         my $Old = RT::User->new( $self->CurrentUser );
1067         $Old->Load( $self->OldValue );
1068         return ("Stolen from [_1]", $self->_FormatUser($Old));   #loc()
1069     },
1070     Give => sub {
1071         my $self = shift;
1072         my $New = RT::User->new( $self->CurrentUser );
1073         $New->Load( $self->NewValue );
1074         return ( "Given to [_1]", $self->_FormatUser($New));    #loc()
1075     },
1076     AddWatcher => sub {
1077         my $self = shift;
1078         my $principal = RT::Principal->new($self->CurrentUser);
1079         $principal->Load($self->NewValue);
1080         return ( "[_1] [_2] added", $self->loc($self->Field), $self->_FormatPrincipal($principal));    #loc()
1081     },
1082     DelWatcher => sub {
1083         my $self = shift;
1084         my $principal = RT::Principal->new($self->CurrentUser);
1085         $principal->Load($self->OldValue);
1086         return ( "[_1] [_2] deleted", $self->loc($self->Field), $self->_FormatPrincipal($principal));  #loc()
1087     },
1088     SetWatcher => sub {
1089         my $self = shift;
1090         my $principal = RT::Principal->new($self->CurrentUser);
1091         $principal->Load($self->NewValue);
1092         return ( "[_1] set to [_2]", $self->loc($self->Field), $self->_FormatPrincipal($principal));  #loc()
1093     },
1094     Subject => sub {
1095         my $self = shift;
1096         return ( "Subject changed to [_1]", $self->Data );  #loc()
1097     },
1098     AddLink => sub {
1099         my $self = shift;
1100         my $value;
1101         if ( $self->NewValue ) {
1102             my $URI = RT::URI->new( $self->CurrentUser );
1103             if ( $URI->FromURI( $self->NewValue ) ) {
1104                 $value = [
1105                     \'<a href="', $URI->AsHREF, \'">',
1106                     $URI->AsString,
1107                     \'</a>'
1108                 ];
1109             }
1110             else {
1111                 $value = $self->NewValue;
1112             }
1113
1114             if ( $self->Field eq 'DependsOn' ) {
1115                 return ( "Dependency on [_1] added", $value );  #loc()
1116             }
1117             elsif ( $self->Field eq 'DependedOnBy' ) {
1118                 return ( "Dependency by [_1] added", $value );  #loc()
1119             }
1120             elsif ( $self->Field eq 'RefersTo' ) {
1121                 return ( "Reference to [_1] added", $value );   #loc()
1122             }
1123             elsif ( $self->Field eq 'ReferredToBy' ) {
1124                 return ( "Reference by [_1] added", $value );   #loc()
1125             }
1126             elsif ( $self->Field eq 'MemberOf' ) {
1127                 return ( "Membership in [_1] added", $value );  #loc()
1128             }
1129             elsif ( $self->Field eq 'HasMember' ) {
1130                 return ( "Member [_1] added", $value );         #loc()
1131             }
1132             elsif ( $self->Field eq 'MergedInto' ) {
1133                 return ( "Merged into [_1]", $value );          #loc()
1134             }
1135         }
1136         else {
1137             return ( "[_1]", $self->Data ); #loc()
1138         }
1139     },
1140     DeleteLink => sub {
1141         my $self = shift;
1142         my $value;
1143         if ( $self->OldValue ) {
1144             my $URI = RT::URI->new( $self->CurrentUser );
1145             if ( $URI->FromURI( $self->OldValue ) ) {
1146                 $value = [
1147                     \'<a href="', $URI->AsHREF, \'">',
1148                     $URI->AsString,
1149                     \'</a>'
1150                 ];
1151             }
1152             else {
1153                 $value = $self->OldValue;
1154             }
1155
1156             if ( $self->Field eq 'DependsOn' ) {
1157                 return ( "Dependency on [_1] deleted", $value );    #loc()
1158             }
1159             elsif ( $self->Field eq 'DependedOnBy' ) {
1160                 return ( "Dependency by [_1] deleted", $value );    #loc()
1161             }
1162             elsif ( $self->Field eq 'RefersTo' ) {
1163                 return ( "Reference to [_1] deleted", $value );     #loc()
1164             }
1165             elsif ( $self->Field eq 'ReferredToBy' ) {
1166                 return ( "Reference by [_1] deleted", $value );     #loc()
1167             }
1168             elsif ( $self->Field eq 'MemberOf' ) {
1169                 return ( "Membership in [_1] deleted", $value );    #loc()
1170             }
1171             elsif ( $self->Field eq 'HasMember' ) {
1172                 return ( "Member [_1] deleted", $value );           #loc()
1173             }
1174         }
1175         else {
1176             return ( "[_1]", $self->Data ); #loc()
1177         }
1178     },
1179     Told => sub {
1180         my $self = shift;
1181         if ( $self->Field eq 'Told' ) {
1182             my $t1 = RT::Date->new($self->CurrentUser);
1183             $t1->Set(Format => 'ISO', Value => $self->NewValue);
1184             my $t2 = RT::Date->new($self->CurrentUser);
1185             $t2->Set(Format => 'ISO', Value => $self->OldValue);
1186             return ( "[_1] changed from [_2] to [_3]", $self->loc($self->Field), $t2->AsString, $t1->AsString );    #loc()
1187         }
1188         else {
1189             return ( "[_1] changed from [_2] to [_3]",
1190                     $self->loc($self->Field),
1191                     ($self->OldValue? "'".$self->OldValue ."'" : $self->loc("(no value)")) , "'". $self->NewValue."'" );  #loc()
1192         }
1193     },
1194     Set => sub {
1195         my $self = shift;
1196         if ( $self->Field eq 'Password' ) {
1197             return ('Password changed');    #loc()
1198         }
1199         elsif ( $self->Field eq 'Queue' ) {
1200             my $q1 = RT::Queue->new( $self->CurrentUser );
1201             $q1->Load( $self->OldValue );
1202             my $q2 = RT::Queue->new( $self->CurrentUser );
1203             $q2->Load( $self->NewValue );
1204             return ("[_1] changed from [_2] to [_3]",
1205                     $self->loc($self->Field), $q1->Name // '#'.$q1->id, $q2->Name // '#'.$q2->id); #loc()
1206         }
1207
1208         # Write the date/time change at local time:
1209         elsif ($self->Field =~  /^(?:Due|Starts|Started|Told|WillResolve)$/) {
1210             my $t1 = RT::Date->new($self->CurrentUser);
1211             $t1->Set(Format => 'ISO', Value => $self->NewValue);
1212             my $t2 = RT::Date->new($self->CurrentUser);
1213             $t2->Set(Format => 'ISO', Value => $self->OldValue);
1214             return ( "[_1] changed from [_2] to [_3]", $self->loc($self->Field), $t2->AsString, $t1->AsString );    #loc()
1215         }
1216         elsif ( $self->Field eq 'Owner' ) {
1217             my $Old = RT::User->new( $self->CurrentUser );
1218             $Old->Load( $self->OldValue );
1219             my $New = RT::User->new( $self->CurrentUser );
1220             $New->Load( $self->NewValue );
1221
1222             if ( $Old->id == RT->Nobody->id ) {
1223                 if ( $New->id == $self->Creator ) {
1224                     return ("Taken");   #loc()
1225                 }
1226                 else {
1227                     return ( "Given to [_1]", $self->_FormatUser($New) );    #loc()
1228                 }
1229             }
1230             else {
1231                 if ( $New->id == $self->Creator ) {
1232                     return ("Stolen from [_1]",  $self->_FormatUser($Old) );   #loc()
1233                 }
1234                 elsif ( $Old->id == $self->Creator ) {
1235                     if ( $New->id == RT->Nobody->id ) {
1236                         return ("Untaken"); #loc()
1237                     }
1238                     else {
1239                         return ( "Given to [_1]", $self->_FormatUser($New) ); #loc()
1240                     }
1241                 }
1242                 else {
1243                     return (
1244                         "Owner forcibly changed from [_1] to [_2]",
1245                         map { $self->_FormatUser($_) } $Old, $New
1246                     );   #loc()
1247                 }
1248             }
1249         }
1250         else {
1251             return ( "[_1] changed from [_2] to [_3]",
1252                     $self->loc($self->Field),
1253                     ($self->OldValue? "'".$self->OldValue ."'" : $self->loc("(no value)")),
1254                     ($self->NewValue? "'".$self->NewValue ."'" : $self->loc("(no value)")));  #loc()
1255         }
1256     },
1257     "Set-TimeWorked" => sub {
1258         my $self = shift;
1259         my $old  = $self->OldValue || 0;
1260         my $new  = $self->NewValue || 0;
1261         my $duration = $new - $old;
1262         if ($duration < 0) {
1263             return ("Adjusted time worked by [quant,_1,minute,minutes]", $duration); # loc()
1264         }
1265         elsif ($duration < 60) {
1266             return ("Worked [quant,_1,minute,minutes]", $duration); # loc()
1267         } else {
1268             return ("Worked [quant,_1,hour,hours] ([quant,_2,minute,minutes])", sprintf("%.1f", $duration / 60), $duration); # loc()
1269         }
1270     },
1271     PurgeTransaction => sub {
1272         my $self = shift;
1273         return ("Transaction [_1] purged", $self->Data);    #loc()
1274     },
1275     AddReminder => sub {
1276         my $self = shift;
1277         my $ticket = RT::Ticket->new($self->CurrentUser);
1278         $ticket->Load($self->NewValue);
1279         if ( $ticket->CurrentUserHasRight('ShowTicket') ) {
1280             my $subject = [
1281                 \'<a href="', RT->Config->Get('WebPath'),
1282                 "/Ticket/Reminders.html?id=", $self->ObjectId,
1283                 "#reminder-", $ticket->id, \'">', $ticket->Subject, \'</a>'
1284             ];
1285             return ("Reminder '[_1]' added", $subject); #loc()
1286         } else {
1287             return ("Reminder added"); #loc()
1288         }
1289     },
1290     OpenReminder => sub {
1291         my $self = shift;
1292         my $ticket = RT::Ticket->new($self->CurrentUser);
1293         $ticket->Load($self->NewValue);
1294         if ( $ticket->CurrentUserHasRight('ShowTicket') ) {
1295             my $subject = [
1296                 \'<a href="', RT->Config->Get('WebPath'),
1297                 "/Ticket/Reminders.html?id=", $self->ObjectId,
1298                 "#reminder-", $ticket->id, \'">', $ticket->Subject, \'</a>'
1299             ];
1300             return ("Reminder '[_1]' reopened", $subject);  #loc()
1301         } else {
1302             return ("Reminder reopened");  #loc()
1303         }
1304     },
1305     ResolveReminder => sub {
1306         my $self = shift;
1307         my $ticket = RT::Ticket->new($self->CurrentUser);
1308         $ticket->Load($self->NewValue);
1309         if ( $ticket->CurrentUserHasRight('ShowTicket') ) {
1310             my $subject = [
1311                 \'<a href="', RT->Config->Get('WebPath'),
1312                 "/Ticket/Reminders.html?id=", $self->ObjectId,
1313                 "#reminder-", $ticket->id, \'">', $ticket->Subject, \'</a>'
1314             ];
1315             return ("Reminder '[_1]' completed", $subject); #loc()
1316         } else {
1317             return ("Reminder completed"); #loc()
1318         }
1319     }
1320 );
1321
1322
1323
1324
1325 =head2 IsInbound
1326
1327 Returns true if the creator of the transaction is a requestor of the ticket.
1328 Returns false otherwise
1329
1330 =cut
1331
1332 sub IsInbound {
1333     my $self = shift;
1334     $self->ObjectType eq 'RT::Ticket' or return undef;
1335     return ( $self->TicketObj->IsRequestor( $self->CreatorObj->PrincipalId ) );
1336 }
1337
1338
1339
1340 sub _OverlayAccessible {
1341     {
1342
1343           ObjectType => { public => 1},
1344           ObjectId => { public => 1},
1345
1346     }
1347 };
1348
1349
1350
1351
1352 sub _Set {
1353     my $self = shift;
1354     return ( 0, $self->loc('Transactions are immutable') );
1355 }
1356
1357
1358
1359 =head2 _Value
1360
1361 Takes the name of a table column.
1362 Returns its value as a string, if the user passes an ACL check
1363
1364 =cut
1365
1366 sub _Value {
1367     my $self  = shift;
1368     my $field = shift;
1369
1370     #if the field is public, return it.
1371     if ( $self->_Accessible( $field, 'public' ) ) {
1372         return $self->SUPER::_Value( $field );
1373     }
1374
1375     unless ( $self->CurrentUserCanSee ) {
1376         return undef;
1377     }
1378
1379     return $self->SUPER::_Value( $field );
1380 }
1381
1382
1383 =head2 CurrentUserCanSee
1384
1385 Returns true if current user has rights to see this particular transaction.
1386
1387 This fact depends on type of the transaction, type of an object the transaction
1388 is attached to and may be other conditions, so this method is prefered over
1389 custom implementations.
1390
1391 It always returns true if current user is system user.
1392
1393 =cut
1394
1395 sub CurrentUserCanSee {
1396     my $self = shift;
1397
1398     return 1 if $self->CurrentUser->PrincipalObj->Id == RT->SystemUser->Id;
1399
1400     # Make sure the user can see the custom field before showing that it changed
1401     my $type = $self->__Value('Type');
1402     if ( $type eq 'CustomField' and my $cf_id = $self->__Value('Field') ) {
1403         my $cf = RT::CustomField->new( $self->CurrentUser );
1404         $cf->SetContextObject( $self->Object );
1405         $cf->Load( $cf_id );
1406         return 0 unless $cf->CurrentUserHasRight('SeeCustomField');
1407     }
1408
1409     # Transactions that might have changed the ->Object's visibility to
1410     # the current user are marked readable
1411     return 1 if $self->{ _object_is_readable };
1412
1413     # Defer to the object in question
1414     return $self->Object->CurrentUserCanSee("Transaction", $self);
1415 }
1416
1417
1418 sub Ticket {
1419     my $self = shift;
1420     return $self->ObjectId;
1421 }
1422
1423 sub TicketObj {
1424     my $self = shift;
1425     return $self->Object;
1426 }
1427
1428 sub OldValue {
1429     my $self = shift;
1430     if ( my $Object = $self->OldReferenceObject ) {
1431         return $Object->Content;
1432     }
1433     else {
1434         return $self->_Value('OldValue');
1435     }
1436 }
1437
1438 sub NewValue {
1439     my $self = shift;
1440     if ( my $Object = $self->NewReferenceObject ) {
1441         return $Object->Content;
1442     }
1443     else {
1444         return $self->_Value('NewValue');
1445     }
1446 }
1447
1448 sub Object {
1449     my $self  = shift;
1450     my $Object = $self->__Value('ObjectType')->new($self->CurrentUser);
1451     $Object->Load($self->__Value('ObjectId'));
1452     return $Object;
1453 }
1454
1455 =head2 NewReferenceObject
1456
1457 =head2 OldReferenceObject
1458
1459 Returns an object of the class specified by the column C<ReferenceType> and
1460 loaded with the id specified by the column C<NewReference> or C<OldReference>.
1461 C<ReferenceType> is assumed to be an L<RT::Record> subclass.
1462
1463 The object may be unloaded (check C<< $object->id >>) if the reference is
1464 corrupt (such as if the referenced record was improperly deleted).
1465
1466 Returns undef if either C<ReferenceType> or C<NewReference>/C<OldReference> is
1467 false.
1468
1469 =cut
1470
1471 sub NewReferenceObject { $_[0]->_ReferenceObject("New") }
1472 sub OldReferenceObject { $_[0]->_ReferenceObject("Old") }
1473
1474 sub _ReferenceObject {
1475     my $self  = shift;
1476     my $which = shift;
1477     my $type  = $self->__Value("ReferenceType");
1478     my $id    = $self->__Value("${which}Reference");
1479     return unless $type and $id;
1480
1481     my $object = $type->new($self->CurrentUser);
1482     $object->Load( $id );
1483     return $object;
1484 }
1485
1486 sub FriendlyObjectType {
1487     my $self = shift;
1488     return $self->loc( $self->Object->RecordType );
1489 }
1490
1491 =head2 UpdateCustomFields
1492
1493 Takes a hash of:
1494
1495     CustomField-C<Id> => Value
1496
1497 or:
1498
1499     Object-RT::Transaction-CustomField-C<Id> => Value
1500
1501 parameters to update this transaction's custom fields.
1502
1503 =cut
1504
1505 sub UpdateCustomFields {
1506     my $self = shift;
1507     my %args = (@_);
1508
1509     # This method used to have an API that took a hash of a single
1510     # value "ARGSRef", which was a reference to a hash of arguments.
1511     # This was insane. The next few lines of code preserve that API
1512     # while giving us something saner.
1513     my $args;
1514     if ($args{'ARGSRef'}) {
1515         RT->Deprecated( Arguments => "ARGSRef", Remove => "4.4" );
1516         $args = $args{ARGSRef};
1517     } else {
1518         $args = \%args;
1519     }
1520
1521     foreach my $arg ( keys %$args ) {
1522         next
1523           unless ( $arg =~
1524             /^(?:Object-RT::Transaction--)?CustomField-(\d+)/ );
1525         next if $arg =~ /-Magic$/;
1526         next if $arg =~ /-TimeUnits$/;
1527         my $cfid   = $1;
1528         my $values = $args->{$arg};
1529         my $cf = $self->LoadCustomFieldByIdentifier($cfid);
1530         next unless $cf->ObjectTypeFromLookupType($cf->__Value('LookupType'))->isa(ref $self);
1531         foreach
1532           my $value ( UNIVERSAL::isa( $values, 'ARRAY' ) ? @$values : $values )
1533         {
1534             next unless (defined($value) && length($value));
1535             $self->_AddCustomFieldValue(
1536                 Field             => $cfid,
1537                 Value             => $value,
1538                 RecordTransaction => 0,
1539             );
1540         }
1541     }
1542 }
1543
1544 =head2 LoadCustomFieldByIdentifier
1545
1546 Finds and returns the custom field of the given name for the
1547 transaction, overriding L<RT::Record/LoadCustomFieldByIdentifier> to
1548 look for queue-specific CFs before global ones.
1549
1550 =cut
1551
1552 sub LoadCustomFieldByIdentifier {
1553     my $self  = shift;
1554     my $field = shift;
1555
1556     return $self->SUPER::LoadCustomFieldByIdentifier($field)
1557         if ref $field or $field =~ /^\d+$/;
1558
1559     return $self->SUPER::LoadCustomFieldByIdentifier($field)
1560         unless UNIVERSAL::can( $self->Object, 'QueueObj' );
1561
1562     my $CFs = RT::CustomFields->new( $self->CurrentUser );
1563     $CFs->SetContextObject( $self->Object );
1564     $CFs->Limit( FIELD => 'Name', VALUE => $field, CASESENSITIVE => 0 );
1565     $CFs->LimitToLookupType($self->CustomFieldLookupType);
1566     $CFs->LimitToGlobalOrObjectId($self->Object->QueueObj->id);
1567     return $CFs->First || RT::CustomField->new( $self->CurrentUser );
1568 }
1569
1570 =head2 CustomFieldLookupType
1571
1572 Returns the RT::Transaction lookup type, which can
1573 be passed to RT::CustomField->Create() via the 'LookupType' hash key.
1574
1575 =cut
1576
1577
1578 sub CustomFieldLookupType {
1579     "RT::Queue-RT::Ticket-RT::Transaction";
1580 }
1581
1582
1583 =head2 SquelchMailTo
1584
1585 Similar to Ticket class SquelchMailTo method - returns a list of
1586 transaction's squelched addresses.  As transactions are immutable, the
1587 list of squelched recipients cannot be modified after creation.
1588
1589 =cut
1590
1591 sub SquelchMailTo {
1592     my $self = shift;
1593     return () unless $self->CurrentUserCanSee;
1594     return $self->Attributes->Named('SquelchMailTo');
1595 }
1596
1597 =head2 Recipients
1598
1599 Returns the list of email addresses (as L<Email::Address> objects)
1600 that this transaction would send mail to.  There may be duplicates.
1601
1602 =cut
1603
1604 sub Recipients {
1605     my $self = shift;
1606     my @recipients;
1607     foreach my $scrip ( @{ $self->Scrips->Prepared } ) {
1608         my $action = $scrip->ActionObj->Action;
1609         next unless $action->isa('RT::Action::SendEmail');
1610
1611         foreach my $type (qw(To Cc Bcc)) {
1612             push @recipients, $action->$type();
1613         }
1614     }
1615
1616     if ( $self->Rules ) {
1617         for my $rule (@{$self->Rules}) {
1618             next unless $rule->{hints} && $rule->{hints}{class} eq 'SendEmail';
1619             my $data = $rule->{hints}{recipients};
1620             foreach my $type (qw(To Cc Bcc)) {
1621                 push @recipients, map {Email::Address->new($_)} @{$data->{$type}};
1622             }
1623         }
1624     }
1625     return @recipients;
1626 }
1627
1628 =head2 DeferredRecipients($freq, $include_sent )
1629
1630 Takes the following arguments:
1631
1632 =over
1633
1634 =item * a string to indicate the frequency of digest delivery.  Valid values are "daily", "weekly", or "susp".
1635
1636 =item * an optional argument which, if true, will return addresses even if this notification has been marked as 'sent' for this transaction.
1637
1638 =back
1639
1640 Returns an array of users who should now receive the notification that
1641 was recorded in this transaction.  Returns an empty array if there were
1642 no deferred users, or if $include_sent was not specified and the deferred
1643 notifications have been sent.
1644
1645 =cut
1646
1647 sub DeferredRecipients {
1648     my $self = shift;
1649     my $freq = shift;
1650     my $include_sent = @_? shift : 0;
1651
1652     my $attr = $self->FirstAttribute('DeferredRecipients');
1653
1654     return () unless ($attr);
1655
1656     my $deferred = $attr->Content;
1657
1658     return () unless ( ref($deferred) eq 'HASH' && exists $deferred->{$freq} );
1659
1660     # Skip it.
1661
1662     for my $user (keys %{$deferred->{$freq}}) {
1663         if ($deferred->{$freq}->{$user}->{_sent} && !$include_sent) {
1664             delete $deferred->{$freq}->{$user}
1665         }
1666     }
1667     # Now get our users.  Easy.
1668
1669     return keys %{ $deferred->{$freq} };
1670 }
1671
1672
1673
1674 # Transactions don't change. by adding this cache config directive, we don't lose pathalogically on long tickets.
1675 sub _CacheConfig {
1676   {
1677      'cache_for_sec'  => 6000,
1678   }
1679 }
1680
1681
1682 =head2 ACLEquivalenceObjects
1683
1684 This method returns a list of objects for which a user's rights also apply
1685 to this Transaction.
1686
1687 This currently only applies to Transaction Custom Fields on Tickets, so we return
1688 the Ticket's Queue and the Ticket.
1689
1690 This method is called from L<RT::Principal/HasRight>.
1691
1692 =cut
1693
1694 sub ACLEquivalenceObjects {
1695     my $self = shift;
1696
1697     return unless $self->ObjectType eq 'RT::Ticket';
1698     my $object = $self->Object;
1699     return $object,$object->QueueObj;
1700
1701 }
1702
1703
1704
1705
1706
1707 =head2 id
1708
1709 Returns the current value of id.
1710 (In the database, id is stored as int(11).)
1711
1712
1713 =cut
1714
1715
1716 =head2 ObjectType
1717
1718 Returns the current value of ObjectType.
1719 (In the database, ObjectType is stored as varchar(64).)
1720
1721
1722
1723 =head2 SetObjectType VALUE
1724
1725
1726 Set ObjectType to VALUE.
1727 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1728 (In the database, ObjectType will be stored as a varchar(64).)
1729
1730
1731 =cut
1732
1733
1734 =head2 ObjectId
1735
1736 Returns the current value of ObjectId.
1737 (In the database, ObjectId is stored as int(11).)
1738
1739
1740
1741 =head2 SetObjectId VALUE
1742
1743
1744 Set ObjectId to VALUE.
1745 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1746 (In the database, ObjectId will be stored as a int(11).)
1747
1748
1749 =cut
1750
1751
1752 =head2 TimeTaken
1753
1754 Returns the current value of TimeTaken.
1755 (In the database, TimeTaken is stored as int(11).)
1756
1757
1758
1759 =head2 SetTimeTaken VALUE
1760
1761
1762 Set TimeTaken to VALUE.
1763 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1764 (In the database, TimeTaken will be stored as a int(11).)
1765
1766
1767 =cut
1768
1769
1770 =head2 Type
1771
1772 Returns the current value of Type.
1773 (In the database, Type is stored as varchar(20).)
1774
1775
1776
1777 =head2 SetType VALUE
1778
1779
1780 Set Type to VALUE.
1781 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1782 (In the database, Type will be stored as a varchar(20).)
1783
1784
1785 =cut
1786
1787
1788 =head2 Field
1789
1790 Returns the current value of Field.
1791 (In the database, Field is stored as varchar(40).)
1792
1793
1794
1795 =head2 SetField VALUE
1796
1797
1798 Set Field to VALUE.
1799 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1800 (In the database, Field will be stored as a varchar(40).)
1801
1802
1803 =cut
1804
1805
1806 =head2 OldValue
1807
1808 Returns the current value of OldValue.
1809 (In the database, OldValue is stored as varchar(255).)
1810
1811
1812
1813 =head2 SetOldValue VALUE
1814
1815
1816 Set OldValue to VALUE.
1817 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1818 (In the database, OldValue will be stored as a varchar(255).)
1819
1820
1821 =cut
1822
1823
1824 =head2 NewValue
1825
1826 Returns the current value of NewValue.
1827 (In the database, NewValue is stored as varchar(255).)
1828
1829
1830
1831 =head2 SetNewValue VALUE
1832
1833
1834 Set NewValue to VALUE.
1835 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1836 (In the database, NewValue will be stored as a varchar(255).)
1837
1838
1839 =cut
1840
1841
1842 =head2 ReferenceType
1843
1844 Returns the current value of ReferenceType.
1845 (In the database, ReferenceType is stored as varchar(255).)
1846
1847
1848
1849 =head2 SetReferenceType VALUE
1850
1851
1852 Set ReferenceType to VALUE.
1853 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1854 (In the database, ReferenceType will be stored as a varchar(255).)
1855
1856
1857 =cut
1858
1859
1860 =head2 OldReference
1861
1862 Returns the current value of OldReference.
1863 (In the database, OldReference is stored as int(11).)
1864
1865
1866
1867 =head2 SetOldReference VALUE
1868
1869
1870 Set OldReference to VALUE.
1871 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1872 (In the database, OldReference will be stored as a int(11).)
1873
1874
1875 =cut
1876
1877
1878 =head2 NewReference
1879
1880 Returns the current value of NewReference.
1881 (In the database, NewReference is stored as int(11).)
1882
1883
1884
1885 =head2 SetNewReference VALUE
1886
1887
1888 Set NewReference to VALUE.
1889 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1890 (In the database, NewReference will be stored as a int(11).)
1891
1892
1893 =cut
1894
1895
1896 =head2 Data
1897
1898 Returns the current value of Data.
1899 (In the database, Data is stored as varchar(255).)
1900
1901
1902
1903 =head2 SetData VALUE
1904
1905
1906 Set Data to VALUE.
1907 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1908 (In the database, Data will be stored as a varchar(255).)
1909
1910
1911 =cut
1912
1913
1914 =head2 Creator
1915
1916 Returns the current value of Creator.
1917 (In the database, Creator is stored as int(11).)
1918
1919
1920 =cut
1921
1922
1923 =head2 Created
1924
1925 Returns the current value of Created.
1926 (In the database, Created is stored as datetime.)
1927
1928
1929 =cut
1930
1931
1932
1933 sub _CoreAccessible {
1934     {
1935
1936         id =>
1937                 {read => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => ''},
1938         ObjectType =>
1939                 {read => 1, write => 1, sql_type => 12, length => 64,  is_blob => 0,  is_numeric => 0,  type => 'varchar(64)', default => ''},
1940         ObjectId =>
1941                 {read => 1, write => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => '0'},
1942         TimeTaken =>
1943                 {read => 1, write => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => '0'},
1944         Type =>
1945                 {read => 1, write => 1, sql_type => 12, length => 20,  is_blob => 0,  is_numeric => 0,  type => 'varchar(20)', default => ''},
1946         Field =>
1947                 {read => 1, write => 1, sql_type => 12, length => 40,  is_blob => 0,  is_numeric => 0,  type => 'varchar(40)', default => ''},
1948         OldValue =>
1949                 {read => 1, write => 1, sql_type => 12, length => 255,  is_blob => 0,  is_numeric => 0,  type => 'varchar(255)', default => ''},
1950         NewValue =>
1951                 {read => 1, write => 1, sql_type => 12, length => 255,  is_blob => 0,  is_numeric => 0,  type => 'varchar(255)', default => ''},
1952         ReferenceType =>
1953                 {read => 1, write => 1, sql_type => 12, length => 255,  is_blob => 0,  is_numeric => 0,  type => 'varchar(255)', default => ''},
1954         OldReference =>
1955                 {read => 1, write => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => ''},
1956         NewReference =>
1957                 {read => 1, write => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => ''},
1958         Data =>
1959                 {read => 1, write => 1, sql_type => 12, length => 255,  is_blob => 0,  is_numeric => 0,  type => 'varchar(255)', default => ''},
1960         Creator =>
1961                 {read => 1, auto => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => '0'},
1962         Created =>
1963                 {read => 1, auto => 1, sql_type => 11, length => 0,  is_blob => 0,  is_numeric => 0,  type => 'datetime', default => ''},
1964
1965  }
1966 };
1967
1968 sub FindDependencies {
1969     my $self = shift;
1970     my ($walker, $deps) = @_;
1971
1972     $self->SUPER::FindDependencies($walker, $deps);
1973
1974     $deps->Add( out => $self->Object );
1975     $deps->Add( in => $self->Attachments );
1976
1977     my $type = $self->Type;
1978     if ($type eq "CustomField") {
1979         my $cf = RT::CustomField->new( RT->SystemUser );
1980         $cf->Load( $self->Field );
1981         $deps->Add( out => $cf );
1982     } elsif ($type =~ /^(Take|Untake|Force|Steal|Give)$/) {
1983         for my $field (qw/OldValue NewValue/) {
1984             my $user = RT::User->new( RT->SystemUser );
1985             $user->Load( $self->$field );
1986             $deps->Add( out => $user );
1987         }
1988     } elsif ($type eq "DelWatcher") {
1989         my $principal = RT::Principal->new( RT->SystemUser );
1990         $principal->Load( $self->OldValue );
1991         $deps->Add( out => $principal->Object );
1992     } elsif ($type eq "AddWatcher") {
1993         my $principal = RT::Principal->new( RT->SystemUser );
1994         $principal->Load( $self->NewValue );
1995         $deps->Add( out => $principal->Object );
1996     } elsif ($type eq "DeleteLink") {
1997         if ($self->OldValue) {
1998             my $base = RT::URI->new( $self->CurrentUser );
1999             $base->FromURI( $self->OldValue );
2000             $deps->Add( out => $base->Object ) if $base->Resolver and $base->Object;
2001         }
2002     } elsif ($type eq "AddLink") {
2003         if ($self->NewValue) {
2004             my $base = RT::URI->new( $self->CurrentUser );
2005             $base->FromURI( $self->NewValue );
2006             $deps->Add( out => $base->Object ) if $base->Resolver and $base->Object;
2007         }
2008     } elsif ($type eq "Set" and $self->Field eq "Queue") {
2009         for my $field (qw/OldValue NewValue/) {
2010             my $queue = RT::Queue->new( RT->SystemUser );
2011             $queue->Load( $self->$field );
2012             $deps->Add( out => $queue );
2013         }
2014     } elsif ($type =~ /^(Add|Open|Resolve)Reminder$/) {
2015         my $ticket = RT::Ticket->new( RT->SystemUser );
2016         $ticket->Load( $self->NewValue );
2017         $deps->Add( out => $ticket );
2018     }
2019 }
2020
2021 sub __DependsOn {
2022     my $self = shift;
2023     my %args = (
2024         Shredder => undef,
2025         Dependencies => undef,
2026         @_,
2027     );
2028     my $deps = $args{'Dependencies'};
2029
2030     $deps->_PushDependencies(
2031         BaseObject => $self,
2032         Flags => RT::Shredder::Constants::DEPENDS_ON,
2033         TargetObjects => $self->Attachments,
2034         Shredder => $args{'Shredder'}
2035     );
2036
2037     return $self->SUPER::__DependsOn( %args );
2038 }
2039
2040 sub Serialize {
2041     my $self = shift;
2042     my %args = (@_);
2043     my %store = $self->SUPER::Serialize(@_);
2044
2045     my $type = $store{Type};
2046     if ($type eq "CustomField") {
2047         my $cf = RT::CustomField->new( RT->SystemUser );
2048         $cf->Load( $store{Field} );
2049         $store{Field} = \($cf->UID);
2050     } elsif ($type =~ /^(Take|Untake|Force|Steal|Give)$/) {
2051         for my $field (qw/OldValue NewValue/) {
2052             my $user = RT::User->new( RT->SystemUser );
2053             $user->Load( $store{$field} );
2054             $store{$field} = \($user->UID);
2055         }
2056     } elsif ($type eq "DelWatcher") {
2057         my $principal = RT::Principal->new( RT->SystemUser );
2058         $principal->Load( $store{OldValue} );
2059         $store{OldValue} = \($principal->UID);
2060     } elsif ($type eq "AddWatcher") {
2061         my $principal = RT::Principal->new( RT->SystemUser );
2062         $principal->Load( $store{NewValue} );
2063         $store{NewValue} = \($principal->UID);
2064     } elsif ($type eq "DeleteLink") {
2065         if ($store{OldValue}) {
2066             my $base = RT::URI->new( $self->CurrentUser );
2067             $base->FromURI( $store{OldValue} );
2068             $store{OldValue} = \($base->Object->UID) if $base->Resolver and $base->Object;
2069         }
2070     } elsif ($type eq "AddLink") {
2071         if ($store{NewValue}) {
2072             my $base = RT::URI->new( $self->CurrentUser );
2073             $base->FromURI( $store{NewValue} );
2074             $store{NewValue} = \($base->Object->UID) if $base->Resolver and $base->Object;
2075         }
2076     } elsif ($type eq "Set" and $store{Field} eq "Queue") {
2077         for my $field (qw/OldValue NewValue/) {
2078             my $queue = RT::Queue->new( RT->SystemUser );
2079             $queue->Load( $store{$field} );
2080             $store{$field} = \($queue->UID);
2081         }
2082     } elsif ($type =~ /^(Add|Open|Resolve)Reminder$/) {
2083         my $ticket = RT::Ticket->new( RT->SystemUser );
2084         $ticket->Load( $store{NewValue} );
2085         $store{NewValue} = \($ticket->UID);
2086     }
2087
2088     return %store;
2089 }
2090
2091 sub PreInflate {
2092     my $class = shift;
2093     my ($importer, $uid, $data) = @_;
2094
2095     if ($data->{Object} and ref $data->{Object}) {
2096         my $on_uid = ${ $data->{Object} };
2097         return if $importer->ShouldSkipTransaction($on_uid);
2098     }
2099
2100     if ($data->{Type} eq "DeleteLink" and ref $data->{OldValue}) {
2101         my $uid = ${ $data->{OldValue} };
2102         my $obj = $importer->LookupObj( $uid );
2103         $data->{OldValue} = $obj->URI;
2104     } elsif ($data->{Type} eq "AddLink" and ref $data->{NewValue}) {
2105         my $uid = ${ $data->{NewValue} };
2106         my $obj = $importer->LookupObj( $uid );
2107         $data->{NewValue} = $obj->URI;
2108     }
2109
2110     return $class->SUPER::PreInflate( $importer, $uid, $data );
2111 }
2112
2113 RT::Base->_ImportOverlays();
2114
2115 1;