rt/lib/RT/Transaction.pm

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