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     # the UI for editing WillResolve through Ticket Basics should allow
 261     # setting it to null
 262     if ( exists $ARGSRef->{'WillResolve_Date'} ) {
 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           if ( $DateObj->Unix > time ) {
 268             $ARGSRef->{'WillResolve'} = $DateObj->ISO;
 269           } else {
 270             warn "Ticket ".$TicketObj->Id.": WillResolve date '$to_date' not accepted.\n";
 271             # and then don't set it in ARGSRef
 272           }
 273       } elsif ( $TicketObj and $TicketObj->WillResolveObj->Unix > 0 ) {
 274           $DateObj->Set(Value => 0);
 275           $ARGSRef->{'WillResolve'} = $DateObj->ISO;
 276       }
 277     }
 278
 279     if ( $ARGSRef->{'Queue'} and ( $ARGSRef->{'Queue'} !~ /^(\d+)$/ ) ) {
 280         my $tempqueue = RT::Queue->new($RT::SystemUser);
 281         $tempqueue->Load( $ARGSRef->{'Queue'} );
 282         if ( $tempqueue->id ) {
 283             $ARGSRef->{'Queue'} = $tempqueue->id;
 284         }
 285     }
 286
 287     my @results = UpdateRecordObject(
 288         AttributesRef => \@attribs,
 289         Object        => $TicketObj,
 290         ARGSRef       => $ARGSRef,
 291     );
 292
 293     # We special case owner changing, so we can use ForceOwnerChange
 294     if ( $ARGSRef->{'Owner'} && ( $TicketObj->Owner != $ARGSRef->{'Owner'} ) ) {
 295         my ($ChownType);
 296         if ( $ARGSRef->{'ForceOwnerChange'} ) {
 297             $ChownType = "Force";
 298         } else {
 299             $ChownType = "Give";
 300         }
 301
 302         my ( $val, $msg ) = $TicketObj->SetOwner( $ARGSRef->{'Owner'}, $ChownType );
 303         push( @results, $msg );
 304     }
 305
 306     return (@results);
 307 }
 308
 309 =head2 ProcessTicketDates (TicketObj => RT::Ticket, ARGSRef => {})
 310
 311 Process updates to the Starts, Started, Told, Resolved, and WillResolve
 312 fields.
 313
 314 =cut
 315
 316 sub ProcessTicketDates {
 317     my %args = (
 318         TicketObj => undef,
 319         ARGSRef   => undef,
 320         @_
 321     );
 322
 323     my $Ticket  = $args{'TicketObj'};
 324     my $ARGSRef = $args{'ARGSRef'};
 325
 326     my (@results);
 327
 328     # {{{ Set date fields
 329     my @date_fields = qw(
 330         Told
 331         Resolved
 332         Starts
 333         Started
 334         Due
 335         WillResolve
 336     );
 337
 338     #Run through each field in this list. update the value if apropriate
 339     foreach my $field (@date_fields) {
 340         next unless exists $ARGSRef->{ $field . '_Date' };
 341         next if $ARGSRef->{ $field . '_Date' } eq '';
 342
 343         my ( $code, $msg );
 344
 345         my $DateObj = RT::Date->new( $session{'CurrentUser'} );
 346         $DateObj->Set(
 347             Format => 'unknown',
 348             Value  => $ARGSRef->{ $field . '_Date' }
 349         );
 350
 351         if ( $field eq 'WillResolve'
 352               and $DateObj->Unix > 0
 353               and $DateObj->Unix <= time ) {
 354             push @results, "Can't set WillResolve date in the past.";
 355             next;
 356         }
 357
 358         my $obj = $field . "Obj";
 359         if (    ( defined $DateObj->Unix )
 360             and ( $DateObj->Unix != $Ticket->$obj()->Unix() ) )
 361         {
 362             my $method = "Set$field";
 363             my ( $code, $msg ) = $Ticket->$method( $DateObj->ISO );
 364             push @results, "$msg";
 365         }
 366     }
 367
 368     # }}}
 369     return (@results);
 370 }
 371
 372 =head2 ProcessTicketStatus (TicketObj => RT::Ticket, ARGSRef => {})
 373
 374 Process updates to the 'Status' field of the ticket.  If the new value
 375 of Status is 'resolved', this will check required custom fields before
 376 allowing the update.
 377
 378 =cut
 379
 380 sub ProcessTicketStatus {
 381     my %args = (
 382         TicketObj => undef,
 383         ARGSRef   => undef,
 384         @_
 385     );
 386
 387     my $TicketObj = $args{'TicketObj'};
 388     my $ARGSRef   = $args{'ARGSRef'};
 389     my @results;
 390
 391     return () if !$ARGSRef->{'Status'};
 392
 393     if ( lc( $ARGSRef->{'Status'} ) eq 'resolved' ) {
 394         foreach my $field ( $TicketObj->MissingRequiredFields ) {
 395             push @results, loc('Missing required field: [_1]', $field->Name);
 396         }
 397     }
 398     if ( @results ) {
 399         $m->notes('RedirectToBasics' => 1);
 400         return @results;
 401     }
 402
 403     return UpdateRecordObject(
 404         AttributesRef => [ 'Status' ],
 405         Object        => $TicketObj,
 406         ARGSRef       => $ARGSRef,
 407     );
 408 }
 409
 410 =head2 ProcessUpdateMessage
 411
 412 Takes paramhash with fields ARGSRef, TicketObj and SkipSignatureOnly.
 413
 414 Don't write message if it only contains current user's signature and
 415 SkipSignatureOnly argument is true. Function anyway adds attachments
 416 and updates time worked field even if skips message. The default value
 417 is true.
 418
 419 =cut
 420
 421 # change from stock: if txn custom fields are set but there's no content
 422 # or attachment, create a Touch txn instead of doing nothing
 423
 424 sub ProcessUpdateMessage {
 425
 426     my %args = (
 427         ARGSRef           => undef,
 428         TicketObj         => undef,
 429         SkipSignatureOnly => 1,
 430         @_
 431     );
 432
 433     if ( $args{ARGSRef}->{'UpdateAttachments'}
 434         && !keys %{ $args{ARGSRef}->{'UpdateAttachments'} } )
 435     {
 436         delete $args{ARGSRef}->{'UpdateAttachments'};
 437     }
 438
 439     # Strip the signature
 440     $args{ARGSRef}->{UpdateContent} = RT::Interface::Web::StripContent(
 441         Content        => $args{ARGSRef}->{UpdateContent},
 442         ContentType    => $args{ARGSRef}->{UpdateContentType},
 443         StripSignature => $args{SkipSignatureOnly},
 444         CurrentUser    => $args{'TicketObj'}->CurrentUser,
 445     );
 446
 447     my %txn_customfields;
 448
 449     foreach my $key ( keys %{ $args{ARGSRef} } ) {
 450       if ( $key =~ /^(?:Object-RT::Transaction--)?CustomField-(\d+)/ ) {
 451         next if $key =~ /(TimeUnits|Magic)$/;
 452         $txn_customfields{$key} = $args{ARGSRef}->{$key};
 453       }
 454     }
 455
 456     # If, after stripping the signature, we have no message, create a
 457     # Touch transaction if necessary
 458     if (    not $args{ARGSRef}->{'UpdateAttachments'}
 459         and not length $args{ARGSRef}->{'UpdateContent'} )
 460     {
 461         #if ( $args{ARGSRef}->{'UpdateTimeWorked'} ) {
 462         #      $args{ARGSRef}->{TimeWorked} = $args{TicketObj}->TimeWorked +
 463         #          delete $args{ARGSRef}->{'UpdateTimeWorked'};
 464         #  }
 465
 466         my $timetaken = $args{ARGSRef}->{'UpdateTimeWorked'};
 467         if ( $timetaken or grep {length $_} values %txn_customfields ) {
 468             my ( $Transaction, $Description, $Object ) =
 469                 $args{TicketObj}->Touch(
 470                   CustomFields => \%txn_customfields,
 471                   TimeTaken => $timetaken
 472                 );
 473             return $Description;
 474         }
 475
 476         return;
 477     }
 478
 479     if ( $args{ARGSRef}->{'UpdateSubject'} eq $args{'TicketObj'}->Subject ) {
 480         $args{ARGSRef}->{'UpdateSubject'} = undef;
 481     }
 482
 483     my $Message = MakeMIMEEntity(
 484         Subject => $args{ARGSRef}->{'UpdateSubject'},
 485         Body    => $args{ARGSRef}->{'UpdateContent'},
 486         Type    => $args{ARGSRef}->{'UpdateContentType'},
 487     );
 488
 489     $Message->head->add( 'Message-ID' => Encode::encode_utf8(
 490         RT::Interface::Email::GenMessageId( Ticket => $args{'TicketObj'} )
 491     ) );
 492     my $old_txn = RT::Transaction->new( $session{'CurrentUser'} );
 493     if ( $args{ARGSRef}->{'QuoteTransaction'} ) {
 494         $old_txn->Load( $args{ARGSRef}->{'QuoteTransaction'} );
 495     } else {
 496         $old_txn = $args{TicketObj}->Transactions->First();
 497     }
 498
 499     if ( my $msg = $old_txn->Message->First ) {
 500         RT::Interface::Email::SetInReplyTo(
 501             Message   => $Message,
 502             InReplyTo => $msg
 503         );
 504     }
 505
 506     if ( $args{ARGSRef}->{'UpdateAttachments'} ) {
 507         $Message->make_multipart;
 508         $Message->add_part($_) foreach values %{ $args{ARGSRef}->{'UpdateAttachments'} };
 509     }
 510
 511     if ( $args{ARGSRef}->{'AttachTickets'} ) {
 512         require RT::Action::SendEmail;
 513         RT::Action::SendEmail->AttachTickets( RT::Action::SendEmail->AttachTickets,
 514             ref $args{ARGSRef}->{'AttachTickets'}
 515             ? @{ $args{ARGSRef}->{'AttachTickets'} }
 516             : ( $args{ARGSRef}->{'AttachTickets'} ) );
 517     }
 518
 519     my $bcc = $args{ARGSRef}->{'UpdateBcc'};
 520     my $cc  = $args{ARGSRef}->{'UpdateCc'};
 521
 522     my %message_args = (
 523         CcMessageTo  => $cc,
 524         BccMessageTo => $bcc,
 525         Sign         => $args{ARGSRef}->{'Sign'},
 526         Encrypt      => $args{ARGSRef}->{'Encrypt'},
 527         MIMEObj      => $Message,
 528         TimeTaken    => $args{ARGSRef}->{'UpdateTimeWorked'},
 529         CustomFields => \%txn_customfields,
 530     );
 531
 532     my @temp_squelch;
 533     foreach my $type (qw(Cc AdminCc)) {
 534         if (grep $_ eq $type || $_ eq ( $type . 's' ), @{ $args{ARGSRef}->{'SkipNotification'} || [] }) {
 535             push @temp_squelch, map $_->address, Email::Address->parse( $message_args{$type} );
 536             push @temp_squelch, $args{TicketObj}->$type->MemberEmailAddresses;
 537             push @temp_squelch, $args{TicketObj}->QueueObj->$type->MemberEmailAddresses;
 538         }
 539     }
 540     if (grep $_ eq 'Requestor' || $_ eq 'Requestors', @{ $args{ARGSRef}->{'SkipNotification'} || [] }) {
 541             push @temp_squelch, map $_->address, Email::Address->parse( $message_args{Requestor} );
 542             push @temp_squelch, $args{TicketObj}->Requestors->MemberEmailAddresses;
 543     }
 544
 545     if (@temp_squelch) {
 546         require RT::Action::SendEmail;
 547         RT::Action::SendEmail->SquelchMailTo( RT::Action::SendEmail->SquelchMailTo, @temp_squelch );
 548     }
 549
 550     unless ( $args{'ARGSRef'}->{'UpdateIgnoreAddressCheckboxes'} ) {
 551         foreach my $key ( keys %{ $args{ARGSRef} } ) {
 552             next unless $key =~ /^Update(Cc|Bcc)-(.*)$/;
 553
 554             my $var   = ucfirst($1) . 'MessageTo';
 555             my $value = $2;
 556             if ( $message_args{$var} ) {
 557                 $message_args{$var} .= ", $value";
 558             } else {
 559                 $message_args{$var} = $value;
 560             }
 561         }
 562     }
 563
 564     my @results;
 565     # Do the update via the appropriate Ticket method
 566     if ( $args{ARGSRef}->{'UpdateType'} =~ /^(private|public)$/ ) {
 567         my ( $Transaction, $Description, $Object ) =
 568             $args{TicketObj}->Comment(%message_args);
 569         push( @results, $Description );
 570         #$Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
 571     } elsif ( $args{ARGSRef}->{'UpdateType'} eq 'response' ) {
 572         my ( $Transaction, $Description, $Object ) =
 573             $args{TicketObj}->Correspond(%message_args);
 574         push( @results, $Description );
 575         #$Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
 576     } else {
 577         push( @results,
 578             loc("Update type was neither correspondence nor comment.") . " " . loc("Update not recorded.") );
 579     }
 580     return @results;
 581 }
 582
 583 sub default_FormatDate { $_[0]->AsString }
 584
 585 sub ProcessColumnMapValue {
 586     my $value = shift;
 587     my %args = ( Arguments => [],
 588                  Escape => 1,
 589                  FormatDate => \&default_FormatDate,
 590                  @_ );
 591
 592     if ( ref $value ) {
 593         if ( ref $value eq 'RT::Date' ) {
 594             return $args{FormatDate}->($value);
 595         } elsif ( UNIVERSAL::isa( $value, 'CODE' ) ) {
 596             my @tmp = $value->( @{ $args{'Arguments'} } );
 597             return ProcessColumnMapValue( ( @tmp > 1 ? \@tmp : $tmp[0] ), %args );
 598         } elsif ( UNIVERSAL::isa( $value, 'ARRAY' ) ) {
 599             return join '', map ProcessColumnMapValue( $_, %args ), @$value;
 600         } elsif ( UNIVERSAL::isa( $value, 'SCALAR' ) ) {
 601             return $$value;
 602         }
 603     }
 604
 605     return $m->interp->apply_escapes( $value, 'h' ) if $args{'Escape'};
 606     return $value;
 607 }
 608
 609
 610 1;
 611