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