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