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"
168 ## check if FS contact email exists, if not create it.
170 'table' => 'contact_email',
171 'hashref' => { 'emailaddress' => $Requestor->{'values'}->{'emailaddress'}, },
174 ## get first and last name for contact.
175 my ($fname, $lname) = (
176 split (/\@/, substr($Requestor->{'values'}->{'emailaddress'}, 0, index($Requestor->{'values'}->{'emailaddress'}, ".")))
179 use Lingua::EN::NameParse;
180 my $name = Lingua::EN::NameParse->new();
182 my $error = $name->parse($Requestor->{'values'}->{'realname'})
183 unless !$Requestor->{'values'}->{'realname'};
185 my %name_comps = $name->components unless !$Requestor->{'values'}->{'realname'} || $error;
187 $fname = $name_comps{given_name_1} || $name_comps{initials_1} unless !$name_comps{given_name_1} && !$name_comps{initials_1};
188 $lname = $name_comps{surname_1} unless !$name_comps{surname_1};
190 ## create the contact.
192 my $contact = new FS::contact {
193 'custnum' => $custnum,
196 'emailaddress' => $Requestor->{'values'}->{'emailaddress'},
197 'comment' => 'Auto created from RT requestor',
199 my $error = $contact->insert;
200 push @results, 'Created Freeside contact for requestor ' . $Requestor->{'values'}->{'emailaddress'}
211 #false laziness w/above... eventually it should go away in favor of this
212 sub ProcessObjectCustomers {
220 my $Object = $args{'Object'};
221 my $ARGSRef = $args{'ARGSRef'};
223 ### false laziness w/RT::Interface::Web::ProcessTicketLinks
224 # Delete links that are gone gone gone.
225 foreach my $arg ( keys %$ARGSRef ) {
226 if ( $arg =~ /DeleteLink-(.*?)-(DependsOn|MemberOf|RefersTo)-(.*)$/ ) {
232 "Trying to delete: Base: $base Target: $target Type $type";
233 my ( $val, $msg ) = $Object->DeleteLink( Base => $base,
244 #my @delete_custnums =
245 # map { /^Object-AddCustomer-(\d+)$/; $1 }
246 # grep { /^Object-AddCustomer-(\d+)$/ && $ARGSRef->{$_} }
249 my @custnums = map { /^Object-AddCustomer-(\d+)$/; $1 }
250 grep { /^Object-AddCustomer-(\d+)$/ && $ARGSRef->{$_} }
253 foreach my $custnum ( @custnums ) {
255 $Object->AddLink( 'Type' => 'MemberOf',
256 'Target' => "freeside://freeside/cust_main/$custnum",
265 =head2 ProcessTicketBasics ( TicketObj => $Ticket, ARGSRef => \%ARGS );
267 Updates all core ticket fields except Status, and returns an array of results
272 sub ProcessTicketBasics {
280 my $TicketObj = $args{'TicketObj'};
281 my $ARGSRef = $args{'ARGSRef'};
283 # {{{ Set basic fields
296 # the UI for editing WillResolve through Ticket Basics should allow
298 if ( exists $ARGSRef->{'WillResolve_Date'} ) {
299 my $to_date = delete($ARGSRef->{'WillResolve_Date'});
300 my $DateObj = RT::Date->new($session{'CurrentUser'});
302 $DateObj->Set(Format => 'unknown', Value => $to_date);
303 if ( $DateObj->Unix > time ) {
304 $ARGSRef->{'WillResolve'} = $DateObj->ISO;
306 warn "Ticket ".$TicketObj->Id.": WillResolve date '$to_date' not accepted.\n";
307 # and then don't set it in ARGSRef
309 } elsif ( $TicketObj and $TicketObj->WillResolveObj->Unix > 0 ) {
310 $DateObj->Set(Value => 0);
311 $ARGSRef->{'WillResolve'} = $DateObj->ISO;
315 if ( $ARGSRef->{'Queue'} and ( $ARGSRef->{'Queue'} !~ /^(\d+)$/ ) ) {
316 my $tempqueue = RT::Queue->new($RT::SystemUser);
317 $tempqueue->Load( $ARGSRef->{'Queue'} );
318 if ( $tempqueue->id ) {
319 $ARGSRef->{'Queue'} = $tempqueue->id;
323 # RT core _will_ allow Set transactions that change these
324 # fields to empty strings, but internally change the values
325 # to zero. This is sloppy and causes some problems.
326 foreach my $field (qw(TimeWorked TimeEstimated TimeLeft)) {
327 if (exists $ARGSRef->{$field}) {
328 $ARGSRef->{$field} =~ s/\s//g;
329 $ARGSRef->{$field} ||= 0;
333 my @results = UpdateRecordObject(
334 AttributesRef => \@attribs,
335 Object => $TicketObj,
339 # We special case owner changing, so we can use ForceOwnerChange
340 if ( $ARGSRef->{'Owner'} && ( $TicketObj->Owner != $ARGSRef->{'Owner'} ) ) {
342 if ( $ARGSRef->{'ForceOwnerChange'} ) {
343 $ChownType = "Force";
348 my ( $val, $msg ) = $TicketObj->SetOwner( $ARGSRef->{'Owner'}, $ChownType );
349 push( @results, $msg );
355 =head2 ProcessTicketDates (TicketObj => RT::Ticket, ARGSRef => {})
357 Process updates to the Starts, Started, Told, Resolved, and WillResolve
362 sub ProcessTicketDates {
369 my $Ticket = $args{'TicketObj'};
370 my $ARGSRef = $args{'ARGSRef'};
374 # {{{ Set date fields
375 my @date_fields = qw(
384 #Run through each field in this list. update the value if apropriate
385 foreach my $field (@date_fields) {
386 next unless exists $ARGSRef->{ $field . '_Date' };
387 next if $ARGSRef->{ $field . '_Date' } eq '';
391 my $DateObj = RT::Date->new( $session{'CurrentUser'} );
394 Value => $ARGSRef->{ $field . '_Date' }
397 if ( $field eq 'WillResolve'
398 and $DateObj->Unix > 0
399 and $DateObj->Unix <= time ) {
400 push @results, "Can't set WillResolve date in the past.";
404 my $obj = $field . "Obj";
405 if ( ( defined $DateObj->Unix )
406 and ( $DateObj->Unix != $Ticket->$obj()->Unix() ) )
408 my $method = "Set$field";
409 my ( $code, $msg ) = $Ticket->$method( $DateObj->ISO );
410 push @results, "$msg";
418 =head2 ProcessTicketStatus (TicketObj => RT::Ticket, ARGSRef => {})
420 Process updates to the 'Status' field of the ticket. If the new value
421 of Status is 'resolved', this will check required custom fields before
426 sub ProcessTicketStatus {
433 my $TicketObj = $args{'TicketObj'};
434 my $ARGSRef = $args{'ARGSRef'};
437 return () if !$ARGSRef->{'Status'};
439 if ( lc( $ARGSRef->{'Status'} ) eq 'resolved' ) {
440 foreach my $field ( $TicketObj->MissingRequiredFields ) {
441 push @results, loc('Missing required field: [_1]', $field->Name);
445 $m->notes('RedirectToBasics' => 1);
449 return UpdateRecordObject(
450 AttributesRef => [ 'Status' ],
451 Object => $TicketObj,
456 sub default_FormatDate { $_[0]->AsString }
458 sub ProcessColumnMapValue {
460 my %args = ( Arguments => [],
464 my $FormatDate = $m->notes('FormatDate') || \&default_FormatDate;
467 if ( ref $value eq 'RT::Date' ) {
468 return $FormatDate->($value);
469 } elsif ( UNIVERSAL::isa( $value, 'CODE' ) ) {
470 my @tmp = $value->( @{ $args{'Arguments'} } );
471 return ProcessColumnMapValue( ( @tmp > 1 ? \@tmp : $tmp[0] ), %args );
472 } elsif ( UNIVERSAL::isa( $value, 'ARRAY' ) ) {
473 return join '', map ProcessColumnMapValue( $_, %args ), @$value;
474 } elsif ( UNIVERSAL::isa( $value, 'SCALAR' ) ) {
479 return $m->interp->apply_escapes( $value, 'h' ) if $args{'Escape'};