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