1 # Copyright (c) 2004 Ivan Kohler <ivan-rt@420.am>
2 # Copyright (c) 2008 Freeside Internet Services, Inc.
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
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.
16 RT::Interface::Web_Vendor
22 Freeside vendor overlay for RT::Interface::Web.
26 use_ok(RT::Interface::Web_Vendor);
32 #package RT::Interface::Web;
35 package HTML::Mason::Commands;
37 no warnings qw(redefine);
39 =head2 ProcessTicketCustomers
43 sub ProcessTicketCustomers {
52 my $Ticket = $args{'TicketObj'};
53 my $ARGSRef = $args{'ARGSRef'};
54 my $Debug = $args{'Debug'};
55 my $me = 'ProcessTicketCustomers';
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)-(.*)$/ ) {
66 "Trying to delete: Base: $base Target: $target Type $type";
67 my ( $val, $msg ) = $Ticket->DeleteLink( Base => $base,
82 my @svcnums = map { /^Ticket-AddService-(\d+)$/; $1 }
83 grep { /^Ticket-AddService-(\d+)$/ && $ARGSRef->{$_} }
87 foreach my $svcnum (@svcnums) {
88 my @link = ( 'Type' => 'MemberOf',
89 'Target' => "freeside://freeside/cust_svc/$svcnum",
92 my( $val, $msg ) = $Ticket->AddLink(@link);
102 push @custnums, map { /^Ticket-AddCustomer-(\d+)$/; $1 }
103 grep { /^Ticket-AddCustomer-(\d+)$/ && $ARGSRef->{$_} }
106 #my @delete_custnums =
107 # map { /^Ticket-AddCustomer-(\d+)$/; $1 }
108 # grep { /^Ticket-AddCustomer-(\d+)$/ && $ARGSRef->{$_} }
112 #figure out if we're going to auto-link requestors, and find them if so
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"
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;
127 if ( $link_requestors ) {
129 #find any requestors without customers
131 grep { ! $_->Customers->Count }
132 @{ $Ticket->Requestors->UserMembersObj->ItemsArrayRef };
134 warn "$me: found ". scalar(@Requestors). " requestors without".
135 " customers; linking them\n"
141 #remove any declared non-customer addresses
144 my $exclude_regexp = RT->Config->Get('NonCustomerEmailRegexp');
145 @Requestors = grep { not $_->EmailAddress =~ $exclude_regexp } @Requestors
146 if defined $exclude_regexp;
149 #link ticket (and requestors) to customers
152 foreach my $custnum ( @custnums ) {
154 my @link = ( 'Type' => 'MemberOf',
155 'Target' => "freeside://freeside/cust_main/$custnum",
158 my( $val, $msg ) = $Ticket->AddLink(@link);
161 #add customer links to requestors
162 foreach my $Requestor ( @Requestors ) {
163 my( $val, $msg ) = $Requestor->AddLink(@link);
165 warn "$me: linking requestor to custnum $custnum: $msg\n"
175 #false laziness w/above... eventually it should go away in favor of this
176 sub ProcessObjectCustomers {
184 my $Object = $args{'Object'};
185 my $ARGSRef = $args{'ARGSRef'};
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)-(.*)$/ ) {
196 "Trying to delete: Base: $base Target: $target Type $type";
197 my ( $val, $msg ) = $Object->DeleteLink( Base => $base,
208 #my @delete_custnums =
209 # map { /^Object-AddCustomer-(\d+)$/; $1 }
210 # grep { /^Object-AddCustomer-(\d+)$/ && $ARGSRef->{$_} }
213 my @custnums = map { /^Object-AddCustomer-(\d+)$/; $1 }
214 grep { /^Object-AddCustomer-(\d+)$/ && $ARGSRef->{$_} }
217 foreach my $custnum ( @custnums ) {
219 $Object->AddLink( 'Type' => 'MemberOf',
220 'Target' => "freeside://freeside/cust_main/$custnum",
229 =head2 ProcessTicketBasics ( TicketObj => $Ticket, ARGSRef => \%ARGS );
231 Updates all core ticket fields except Status, and returns an array of results
236 sub ProcessTicketBasics {
244 my $TicketObj = $args{'TicketObj'};
245 my $ARGSRef = $args{'ARGSRef'};
247 # {{{ Set basic fields
260 # the UI for editing WillResolve through Ticket Basics should allow
262 if ( exists $ARGSRef->{'WillResolve_Date'} ) {
263 my $to_date = delete($ARGSRef->{'WillResolve_Date'});
264 my $DateObj = RT::Date->new($session{'CurrentUser'});
266 $DateObj->Set(Format => 'unknown', Value => $to_date);
267 if ( $DateObj->Unix > time ) {
268 $ARGSRef->{'WillResolve'} = $DateObj->ISO;
270 warn "Ticket ".$TicketObj->Id.": WillResolve date '$to_date' not accepted.\n";
271 # and then don't set it in ARGSRef
273 } elsif ( $TicketObj and $TicketObj->WillResolveObj->Unix > 0 ) {
274 $DateObj->Set(Value => 0);
275 $ARGSRef->{'WillResolve'} = $DateObj->ISO;
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;
287 my @results = UpdateRecordObject(
288 AttributesRef => \@attribs,
289 Object => $TicketObj,
293 # We special case owner changing, so we can use ForceOwnerChange
294 if ( $ARGSRef->{'Owner'} && ( $TicketObj->Owner != $ARGSRef->{'Owner'} ) ) {
296 if ( $ARGSRef->{'ForceOwnerChange'} ) {
297 $ChownType = "Force";
302 my ( $val, $msg ) = $TicketObj->SetOwner( $ARGSRef->{'Owner'}, $ChownType );
303 push( @results, $msg );
309 =head2 ProcessTicketDates (TicketObj => RT::Ticket, ARGSRef => {})
311 Process updates to the Starts, Started, Told, Resolved, and WillResolve
316 sub ProcessTicketDates {
323 my $Ticket = $args{'TicketObj'};
324 my $ARGSRef = $args{'ARGSRef'};
328 # {{{ Set date fields
329 my @date_fields = qw(
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 '';
345 my $DateObj = RT::Date->new( $session{'CurrentUser'} );
348 Value => $ARGSRef->{ $field . '_Date' }
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.";
358 my $obj = $field . "Obj";
359 if ( ( defined $DateObj->Unix )
360 and ( $DateObj->Unix != $Ticket->$obj()->Unix() ) )
362 my $method = "Set$field";
363 my ( $code, $msg ) = $Ticket->$method( $DateObj->ISO );
364 push @results, "$msg";
372 =head2 ProcessTicketStatus (TicketObj => RT::Ticket, ARGSRef => {})
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
380 sub ProcessTicketStatus {
387 my $TicketObj = $args{'TicketObj'};
388 my $ARGSRef = $args{'ARGSRef'};
391 return () if !$ARGSRef->{'Status'};
393 if ( lc( $ARGSRef->{'Status'} ) eq 'resolved' ) {
394 foreach my $field ( $TicketObj->MissingRequiredFields ) {
395 push @results, loc('Missing required field: [_1]', $field->Name);
399 $m->notes('RedirectToBasics' => 1);
403 return UpdateRecordObject(
404 AttributesRef => [ 'Status' ],
405 Object => $TicketObj,
410 =head2 ProcessUpdateMessage
412 Takes paramhash with fields ARGSRef, TicketObj and SkipSignatureOnly.
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
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
424 sub ProcessUpdateMessage {
429 SkipSignatureOnly => 1,
433 if ( $args{ARGSRef}->{'UpdateAttachments'}
434 && !keys %{ $args{ARGSRef}->{'UpdateAttachments'} } )
436 delete $args{ARGSRef}->{'UpdateAttachments'};
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,
447 my %txn_customfields;
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};
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'} )
461 #if ( $args{ARGSRef}->{'UpdateTimeWorked'} ) {
462 # $args{ARGSRef}->{TimeWorked} = $args{TicketObj}->TimeWorked +
463 # delete $args{ARGSRef}->{'UpdateTimeWorked'};
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
479 if ( $args{ARGSRef}->{'UpdateSubject'} eq $args{'TicketObj'}->Subject ) {
480 $args{ARGSRef}->{'UpdateSubject'} = undef;
483 my $Message = MakeMIMEEntity(
484 Subject => $args{ARGSRef}->{'UpdateSubject'},
485 Body => $args{ARGSRef}->{'UpdateContent'},
486 Type => $args{ARGSRef}->{'UpdateContentType'},
489 $Message->head->add( 'Message-ID' => Encode::encode_utf8(
490 RT::Interface::Email::GenMessageId( Ticket => $args{'TicketObj'} )
492 my $old_txn = RT::Transaction->new( $session{'CurrentUser'} );
493 if ( $args{ARGSRef}->{'QuoteTransaction'} ) {
494 $old_txn->Load( $args{ARGSRef}->{'QuoteTransaction'} );
496 $old_txn = $args{TicketObj}->Transactions->First();
499 if ( my $msg = $old_txn->Message->First ) {
500 RT::Interface::Email::SetInReplyTo(
506 if ( $args{ARGSRef}->{'UpdateAttachments'} ) {
507 $Message->make_multipart;
508 $Message->add_part($_) foreach values %{ $args{ARGSRef}->{'UpdateAttachments'} };
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'} ) );
519 my $bcc = $args{ARGSRef}->{'UpdateBcc'};
520 my $cc = $args{ARGSRef}->{'UpdateCc'};
524 BccMessageTo => $bcc,
525 Sign => $args{ARGSRef}->{'Sign'},
526 Encrypt => $args{ARGSRef}->{'Encrypt'},
528 TimeTaken => $args{ARGSRef}->{'UpdateTimeWorked'},
529 CustomFields => \%txn_customfields,
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;
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;
546 require RT::Action::SendEmail;
547 RT::Action::SendEmail->SquelchMailTo( RT::Action::SendEmail->SquelchMailTo, @temp_squelch );
550 unless ( $args{'ARGSRef'}->{'UpdateIgnoreAddressCheckboxes'} ) {
551 foreach my $key ( keys %{ $args{ARGSRef} } ) {
552 next unless $key =~ /^Update(Cc|Bcc)-(.*)$/;
554 my $var = ucfirst($1) . 'MessageTo';
556 if ( $message_args{$var} ) {
557 $message_args{$var} .= ", $value";
559 $message_args{$var} = $value;
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;
578 loc("Update type was neither correspondence nor comment.") . " " . loc("Update not recorded.") );
583 sub default_FormatDate { $_[0]->AsString }
585 sub ProcessColumnMapValue {
587 my %args = ( Arguments => [],
589 FormatDate => \&default_FormatDate,
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' ) ) {
605 return $m->interp->apply_escapes( $value, 'h' ) if $args{'Escape'};