rt/lib/RT/Interface/Web_Vendor.pm

   1 # Copyright (c) 2004 Ivan Kohler <ivan-rt@420.am>
   2 # Copyright (c) 2008 Freeside Internet Services, Inc.
   3 #
   4 # This work is made available to you under the terms of Version 2 of
   5 # the GNU General Public License. A copy of that license should have
   6 # been provided with this software, but in any event can be snarfed
   7 # from www.gnu.org.
   8 #
   9 # This work is distributed in the hope that it will be useful, but
  10 # WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12 # General Public License for more details.
  13
  14 =head1 NAME
  15
  16 RT::Interface::Web_Vendor
  17
  18 =head1 SYNOPSIS
  19
  20 =head1 DESCRIPTION
  21
  22 Freeside vendor overlay for RT::Interface::Web.
  23
  24 =begin testing
  25
  26 use_ok(RT::Interface::Web_Vendor);
  27
  28 =end testing
  29
  30 =cut
  31
  32 #package RT::Interface::Web;
  33 #use strict;
  34
  35 package HTML::Mason::Commands;
  36 use strict;
  37 no warnings qw(redefine);
  38
  39 =head2 ProcessTicketCustomers
  40
  41 =cut
  42
  43 sub ProcessTicketCustomers {
  44     my %args = (
  45         TicketObj => undef,
  46         ARGSRef   => undef,
  47         Debug     => 0,
  48         @_
  49     );
  50     my @results = ();
  51
  52     my $Ticket  = $args{'TicketObj'};
  53     my $ARGSRef = $args{'ARGSRef'};
  54     my $Debug   = $args{'Debug'};
  55     my $me = 'ProcessTicketCustomers';
  56
  57     ### false laziness w/RT::Interface::Web::ProcessTicketLinks
  58     # Delete links that are gone gone gone.
  59     foreach my $arg ( keys %$ARGSRef ) {
  60         if ( $arg =~ /DeleteLink-(.*?)-(DependsOn|MemberOf|RefersTo)-(.*)$/ ) {
  61             my $base   = $1;
  62             my $type   = $2;
  63             my $target = $3;
  64
  65             push @results,
  66               "Trying to delete: Base: $base Target: $target  Type $type";
  67             my ( $val, $msg ) = $Ticket->DeleteLink( Base   => $base,
  68                                                      Type   => $type,
  69                                                      Target => $target );
  70
  71             push @results, $msg;
  72
  73         }
  74
  75     }
  76     ###
  77
  78     ###
  79     #find new services
  80     ###
  81
  82     my @svcnums = map  { /^Ticket-AddService-(\d+)$/; $1 }
  83                   grep { /^Ticket-AddService-(\d+)$/ && $ARGSRef->{$_} }
  84                   keys %$ARGSRef;
  85
  86     my @custnums;
  87     foreach my $svcnum (@svcnums) {
  88         my @link = ( 'Type'   => 'MemberOf',
  89                      'Target' => "freeside://freeside/cust_svc/$svcnum",
  90                    );
  91
  92         my( $val, $msg ) = $Ticket->AddLink(@link);
  93         push @results, $msg;
  94         next if !$val;
  95
  96     }
  97
  98     ###
  99     #find new customers
 100     ###
 101
 102     push @custnums, map  { /^Ticket-AddCustomer-(\d+)$/; $1 }
 103                     grep { /^Ticket-AddCustomer-(\d+)$/ && $ARGSRef->{$_} }
 104                     keys %$ARGSRef;
 105
 106     #my @delete_custnums =
 107     #  map  { /^Ticket-AddCustomer-(\d+)$/; $1 }
 108     #  grep { /^Ticket-AddCustomer-(\d+)$/ && $ARGSRef->{$_} }
 109     #  keys %$ARGSRef;
 110
 111     ###
 112     #figure out if we're going to auto-link requestors, and find them if so
 113     ###
 114
 115     my $num_cur_cust = $Ticket->Customers->Count;
 116     my $num_new_cust = scalar(@custnums);
 117     warn "$me: $num_cur_cust current customers / $num_new_cust new customers\n"
 118       if $Debug;
 119
 120     #if we're linking the first ticket to one customer
 121     my $link_requestors = ( $num_cur_cust == 0 && $num_new_cust == 1 );
 122     warn "$me: adding a single customer to a previously customerless".
 123          " ticket, so linking customers to requestor too\n"
 124       if $Debug && $link_requestors;
 125
 126     my @Requestors = ();
 127     if ( $link_requestors ) {
 128
 129       #find any requestors without customers
 130       @Requestors =
 131         grep { ! $_->Customers->Count }
 132              @{ $Ticket->Requestors->UserMembersObj->ItemsArrayRef };
 133
 134       warn "$me: found ". scalar(@Requestors). " requestors without".
 135            " customers; linking them\n"
 136         if $Debug;
 137
 138     }
 139
 140     ###
 141     #remove any declared non-customer addresses
 142     ###
 143
 144     my $exclude_regexp = RT->Config->Get('NonCustomerEmailRegexp');
 145     @Requestors = grep { not $_->EmailAddress =~ $exclude_regexp } @Requestors
 146       if defined $exclude_regexp;
 147
 148     ###
 149     #link ticket (and requestors) to customers
 150     ###
 151
 152     foreach my $custnum ( @custnums ) {
 153
 154       my @link = ( 'Type'   => 'MemberOf',
 155                    'Target' => "freeside://freeside/cust_main/$custnum",
 156                  );
 157
 158       my( $val, $msg ) = $Ticket->AddLink(@link);
 159       push @results, $msg;
 160
 161       #add customer links to requestors
 162       foreach my $Requestor ( @Requestors ) {
 163         my( $val, $msg ) = $Requestor->AddLink(@link);
 164         push @results, $msg;
 165         warn "$me: linking requestor to custnum $custnum: $msg\n"
 166           if $Debug > 1;
 167       }
 168
 169     }
 170
 171     return @results;
 172
 173 }
 174
 175 #false laziness w/above... eventually it should go away in favor of this
 176 sub ProcessObjectCustomers {
 177     my %args = (
 178         Object => undef,
 179         ARGSRef   => undef,
 180         @_
 181     );
 182     my @results = ();
 183
 184     my $Object  = $args{'Object'};
 185     my $ARGSRef = $args{'ARGSRef'};
 186
 187     ### false laziness w/RT::Interface::Web::ProcessTicketLinks
 188     # Delete links that are gone gone gone.
 189     foreach my $arg ( keys %$ARGSRef ) {
 190         if ( $arg =~ /DeleteLink-(.*?)-(DependsOn|MemberOf|RefersTo)-(.*)$/ ) {
 191             my $base   = $1;
 192             my $type   = $2;
 193             my $target = $3;
 194
 195             push @results,
 196               "Trying to delete: Base: $base Target: $target  Type $type";
 197             my ( $val, $msg ) = $Object->DeleteLink( Base   => $base,
 198                                                      Type   => $type,
 199                                                      Target => $target );
 200
 201             push @results, $msg;
 202
 203         }
 204
 205     }
 206     ###
 207
 208     #my @delete_custnums =
 209     #  map  { /^Object-AddCustomer-(\d+)$/; $1 }
 210     #  grep { /^Object-AddCustomer-(\d+)$/ && $ARGSRef->{$_} }
 211     #  keys %$ARGSRef;
 212
 213     my @custnums = map  { /^Object-AddCustomer-(\d+)$/; $1 }
 214                    grep { /^Object-AddCustomer-(\d+)$/ && $ARGSRef->{$_} }
 215                    keys %$ARGSRef;
 216
 217     foreach my $custnum ( @custnums ) {
 218       my( $val, $msg ) =
 219         $Object->AddLink( 'Type'   => 'MemberOf',
 220                           'Target' => "freeside://freeside/cust_main/$custnum",
 221                         );
 222       push @results, $msg;
 223     }
 224
 225     return @results;
 226
 227 }
 228
 229 =head2 ProcessTicketBasics ( TicketObj => $Ticket, ARGSRef => \%ARGS );
 230
 231 Updates all core ticket fields except Status, and returns an array of results
 232 messages.
 233
 234 =cut
 235
 236 sub ProcessTicketBasics {
 237
 238     my %args = (
 239         TicketObj => undef,
 240         ARGSRef   => undef,
 241         @_
 242     );
 243
 244     my $TicketObj = $args{'TicketObj'};
 245     my $ARGSRef   = $args{'ARGSRef'};
 246
 247     # {{{ Set basic fields
 248     my @attribs = qw(
 249         Subject
 250         FinalPriority
 251         Priority
 252         TimeEstimated
 253         TimeWorked
 254         TimeLeft
 255         Type
 256         Queue
 257         WillResolve
 258     );
 259
 260 # causes endless redirect loops and "WillResolve changed from Not set to Not set" on ticket view?
 261 #    # the UI for editing WillResolve through Ticket Basics should allow
 262 #    # setting it to null
 263 #    my $to_date = delete($ARGSRef->{'WillResolve_Date'});
 264 #    my $DateObj = RT::Date->new($session{'CurrentUser'});
 265 #    if ( $to_date ) {
 266 #        $DateObj->Set(Format => 'unknown', Value => $to_date);
 267 #    } else {
 268 #        $DateObj->Set(Value => 0);
 269 #    }
 270 #    $ARGSRef->{'WillResolve'} = $DateObj->ISO;
 271
 272     if ( $ARGSRef->{'Queue'} and ( $ARGSRef->{'Queue'} !~ /^(\d+)$/ ) ) {
 273         my $tempqueue = RT::Queue->new($RT::SystemUser);
 274         $tempqueue->Load( $ARGSRef->{'Queue'} );
 275         if ( $tempqueue->id ) {
 276             $ARGSRef->{'Queue'} = $tempqueue->id;
 277         }
 278     }
 279
 280     my @results = UpdateRecordObject(
 281         AttributesRef => \@attribs,
 282         Object        => $TicketObj,
 283         ARGSRef       => $ARGSRef,
 284     );
 285
 286     # We special case owner changing, so we can use ForceOwnerChange
 287     if ( $ARGSRef->{'Owner'} && ( $TicketObj->Owner != $ARGSRef->{'Owner'} ) ) {
 288         my ($ChownType);
 289         if ( $ARGSRef->{'ForceOwnerChange'} ) {
 290             $ChownType = "Force";
 291         } else {
 292             $ChownType = "Give";
 293         }
 294
 295         my ( $val, $msg ) = $TicketObj->SetOwner( $ARGSRef->{'Owner'}, $ChownType );
 296         push( @results, $msg );
 297     }
 298
 299     return (@results);
 300 }
 301
 302 =head2 ProcessTicketDates (TicketObj => RT::Ticket, ARGSRef => {})
 303
 304 Process updates to the Starts, Started, Told, Resolved, and WillResolve
 305 fields.
 306
 307 =cut
 308
 309 sub ProcessTicketDates {
 310     my %args = (
 311         TicketObj => undef,
 312         ARGSRef   => undef,
 313         @_
 314     );
 315
 316     my $Ticket  = $args{'TicketObj'};
 317     my $ARGSRef = $args{'ARGSRef'};
 318
 319     my (@results);
 320
 321     # {{{ Set date fields
 322     my @date_fields = qw(
 323         Told
 324         Resolved
 325         Starts
 326         Started
 327         Due
 328         WillResolve
 329     );
 330
 331     #Run through each field in this list. update the value if apropriate
 332     foreach my $field (@date_fields) {
 333         next unless exists $ARGSRef->{ $field . '_Date' };
 334         next if $ARGSRef->{ $field . '_Date' } eq '';
 335
 336         my ( $code, $msg );
 337
 338         my $DateObj = RT::Date->new( $session{'CurrentUser'} );
 339         $DateObj->Set(
 340             Format => 'unknown',
 341             Value  => $ARGSRef->{ $field . '_Date' }
 342         );
 343
 344         my $obj = $field . "Obj";
 345         if (    ( defined $DateObj->Unix )
 346             and ( $DateObj->Unix != $Ticket->$obj()->Unix() ) )
 347         {
 348             my $method = "Set$field";
 349             my ( $code, $msg ) = $Ticket->$method( $DateObj->ISO );
 350             push @results, "$msg";
 351         }
 352     }
 353
 354     # }}}
 355     return (@results);
 356 }
 357
 358 =head2 ProcessTicketStatus (TicketObj => RT::Ticket, ARGSRef => {})
 359
 360 Process updates to the 'Status' field of the ticket.  If the new value
 361 of Status is 'resolved', this will check required custom fields before
 362 allowing the update.
 363
 364 =cut
 365
 366 sub ProcessTicketStatus {
 367     my %args = (
 368         TicketObj => undef,
 369         ARGSRef   => undef,
 370         @_
 371     );
 372
 373     my $TicketObj = $args{'TicketObj'};
 374     my $ARGSRef   = $args{'ARGSRef'};
 375     my @results;
 376
 377     return () if !$ARGSRef->{'Status'};
 378
 379     if ( lc( $ARGSRef->{'Status'} ) eq 'resolved' ) {
 380         foreach my $field ( $TicketObj->MissingRequiredFields ) {
 381             push @results, loc('Missing required field: [_1]', $field->Name);
 382         }
 383     }
 384     if ( @results ) {
 385         $m->notes('RedirectToBasics' => 1);
 386         return @results;
 387     }
 388
 389     return UpdateRecordObject(
 390         AttributesRef => [ 'Status' ],
 391         Object        => $TicketObj,
 392         ARGSRef       => $ARGSRef,
 393     );
 394 }
 395
 396 =head2 ProcessUpdateMessage
 397
 398 Takes paramhash with fields ARGSRef, TicketObj and SkipSignatureOnly.
 399
 400 Don't write message if it only contains current user's signature and
 401 SkipSignatureOnly argument is true. Function anyway adds attachments
 402 and updates time worked field even if skips message. The default value
 403 is true.
 404
 405 =cut
 406
 407 # change from stock: if txn custom fields are set but there's no content
 408 # or attachment, create a Touch txn instead of doing nothing
 409
 410 sub ProcessUpdateMessage {
 411
 412     my %args = (
 413         ARGSRef           => undef,
 414         TicketObj         => undef,
 415         SkipSignatureOnly => 1,
 416         @_
 417     );
 418
 419     if ( $args{ARGSRef}->{'UpdateAttachments'}
 420         && !keys %{ $args{ARGSRef}->{'UpdateAttachments'} } )
 421     {
 422         delete $args{ARGSRef}->{'UpdateAttachments'};
 423     }
 424
 425     # Strip the signature
 426     $args{ARGSRef}->{UpdateContent} = RT::Interface::Web::StripContent(
 427         Content        => $args{ARGSRef}->{UpdateContent},
 428         ContentType    => $args{ARGSRef}->{UpdateContentType},
 429         StripSignature => $args{SkipSignatureOnly},
 430         CurrentUser    => $args{'TicketObj'}->CurrentUser,
 431     );
 432
 433     my %txn_customfields;
 434
 435     foreach my $key ( keys %{ $args{ARGSRef} } ) {
 436       if ( $key =~ /^(?:Object-RT::Transaction--)?CustomField-(\d+)/ ) {
 437         next if $key =~ /(TimeUnits|Magic)$/;
 438         $txn_customfields{$key} = $args{ARGSRef}->{$key};
 439       }
 440     }
 441
 442     # If, after stripping the signature, we have no message, create a
 443     # Touch transaction if necessary
 444     if (    not $args{ARGSRef}->{'UpdateAttachments'}
 445         and not length $args{ARGSRef}->{'UpdateContent'} )
 446     {
 447         #if ( $args{ARGSRef}->{'UpdateTimeWorked'} ) {
 448         #      $args{ARGSRef}->{TimeWorked} = $args{TicketObj}->TimeWorked +
 449         #          delete $args{ARGSRef}->{'UpdateTimeWorked'};
 450         #  }
 451
 452         my $timetaken = $args{ARGSRef}->{'UpdateTimeWorked'};
 453         if ( $timetaken or grep {length $_} values %txn_customfields ) {
 454             my ( $Transaction, $Description, $Object ) =
 455                 $args{TicketObj}->Touch(
 456                   CustomFields => \%txn_customfields,
 457                   TimeTaken => $timetaken
 458                 );
 459             return $Description;
 460         }
 461
 462         return;
 463     }
 464
 465     if ( $args{ARGSRef}->{'UpdateSubject'} eq $args{'TicketObj'}->Subject ) {
 466         $args{ARGSRef}->{'UpdateSubject'} = undef;
 467     }
 468
 469     my $Message = MakeMIMEEntity(
 470         Subject => $args{ARGSRef}->{'UpdateSubject'},
 471         Body    => $args{ARGSRef}->{'UpdateContent'},
 472         Type    => $args{ARGSRef}->{'UpdateContentType'},
 473     );
 474
 475     $Message->head->add( 'Message-ID' => Encode::encode_utf8(
 476         RT::Interface::Email::GenMessageId( Ticket => $args{'TicketObj'} )
 477     ) );
 478     my $old_txn = RT::Transaction->new( $session{'CurrentUser'} );
 479     if ( $args{ARGSRef}->{'QuoteTransaction'} ) {
 480         $old_txn->Load( $args{ARGSRef}->{'QuoteTransaction'} );
 481     } else {
 482         $old_txn = $args{TicketObj}->Transactions->First();
 483     }
 484
 485     if ( my $msg = $old_txn->Message->First ) {
 486         RT::Interface::Email::SetInReplyTo(
 487             Message   => $Message,
 488             InReplyTo => $msg
 489         );
 490     }
 491
 492     if ( $args{ARGSRef}->{'UpdateAttachments'} ) {
 493         $Message->make_multipart;
 494         $Message->add_part($_) foreach values %{ $args{ARGSRef}->{'UpdateAttachments'} };
 495     }
 496
 497     if ( $args{ARGSRef}->{'AttachTickets'} ) {
 498         require RT::Action::SendEmail;
 499         RT::Action::SendEmail->AttachTickets( RT::Action::SendEmail->AttachTickets,
 500             ref $args{ARGSRef}->{'AttachTickets'}
 501             ? @{ $args{ARGSRef}->{'AttachTickets'} }
 502             : ( $args{ARGSRef}->{'AttachTickets'} ) );
 503     }
 504
 505     my $bcc = $args{ARGSRef}->{'UpdateBcc'};
 506     my $cc  = $args{ARGSRef}->{'UpdateCc'};
 507
 508     my %message_args = (
 509         CcMessageTo  => $cc,
 510         BccMessageTo => $bcc,
 511         Sign         => $args{ARGSRef}->{'Sign'},
 512         Encrypt      => $args{ARGSRef}->{'Encrypt'},
 513         MIMEObj      => $Message,
 514         TimeTaken    => $args{ARGSRef}->{'UpdateTimeWorked'},
 515         CustomFields => \%txn_customfields,
 516     );
 517
 518     my @temp_squelch;
 519     foreach my $type (qw(Cc AdminCc)) {
 520         if (grep $_ eq $type || $_ eq ( $type . 's' ), @{ $args{ARGSRef}->{'SkipNotification'} || [] }) {
 521             push @temp_squelch, map $_->address, Email::Address->parse( $message_args{$type} );
 522             push @temp_squelch, $args{TicketObj}->$type->MemberEmailAddresses;
 523             push @temp_squelch, $args{TicketObj}->QueueObj->$type->MemberEmailAddresses;
 524         }
 525     }
 526     if (grep $_ eq 'Requestor' || $_ eq 'Requestors', @{ $args{ARGSRef}->{'SkipNotification'} || [] }) {
 527             push @temp_squelch, map $_->address, Email::Address->parse( $message_args{Requestor} );
 528             push @temp_squelch, $args{TicketObj}->Requestors->MemberEmailAddresses;
 529     }
 530
 531     if (@temp_squelch) {
 532         require RT::Action::SendEmail;
 533         RT::Action::SendEmail->SquelchMailTo( RT::Action::SendEmail->SquelchMailTo, @temp_squelch );
 534     }
 535
 536     unless ( $args{'ARGSRef'}->{'UpdateIgnoreAddressCheckboxes'} ) {
 537         foreach my $key ( keys %{ $args{ARGSRef} } ) {
 538             next unless $key =~ /^Update(Cc|Bcc)-(.*)$/;
 539
 540             my $var   = ucfirst($1) . 'MessageTo';
 541             my $value = $2;
 542             if ( $message_args{$var} ) {
 543                 $message_args{$var} .= ", $value";
 544             } else {
 545                 $message_args{$var} = $value;
 546             }
 547         }
 548     }
 549
 550     my @results;
 551     # Do the update via the appropriate Ticket method
 552     if ( $args{ARGSRef}->{'UpdateType'} =~ /^(private|public)$/ ) {
 553         my ( $Transaction, $Description, $Object ) =
 554             $args{TicketObj}->Comment(%message_args);
 555         push( @results, $Description );
 556         #$Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
 557     } elsif ( $args{ARGSRef}->{'UpdateType'} eq 'response' ) {
 558         my ( $Transaction, $Description, $Object ) =
 559             $args{TicketObj}->Correspond(%message_args);
 560         push( @results, $Description );
 561         #$Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
 562     } else {
 563         push( @results,
 564             loc("Update type was neither correspondence nor comment.") . " " . loc("Update not recorded.") );
 565     }
 566     return @results;
 567 }
 568
 569 sub default_FormatDate { $_[0]->AsString }
 570
 571 sub ProcessColumnMapValue {
 572     my $value = shift;
 573     my %args = ( Arguments => [],
 574                  Escape => 1,
 575                  FormatDate => \&default_FormatDate,
 576                  @_ );
 577
 578     if ( ref $value ) {
 579         if ( ref $value eq 'RT::Date' ) {
 580             return $args{FormatDate}->($value);
 581         } elsif ( UNIVERSAL::isa( $value, 'CODE' ) ) {
 582             my @tmp = $value->( @{ $args{'Arguments'} } );
 583             return ProcessColumnMapValue( ( @tmp > 1 ? \@tmp : $tmp[0] ), %args );
 584         } elsif ( UNIVERSAL::isa( $value, 'ARRAY' ) ) {
 585             return join '', map ProcessColumnMapValue( $_, %args ), @$value;
 586         } elsif ( UNIVERSAL::isa( $value, 'SCALAR' ) ) {
 587             return $$value;
 588         }
 589     }
 590
 591     return $m->interp->apply_escapes( $value, 'h' ) if $args{'Escape'};
 592     return $value;
 593 }
 594
 595
 596 1;
 597