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