rt/lib/RT/Transaction_Overlay.pm

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