Upgrade to 4.0.8 with mod of ExternalAuth + absolute paths to ticket-menu.
[usit-rt.git] / lib / RT / Action / CreateTickets.pm
CommitLineData
84fb5b46
MKG
1# BEGIN BPS TAGGED BLOCK {{{
2#
3# COPYRIGHT:
4#
5# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
6# <sales@bestpractical.com>
7#
8# (Except where explicitly superseded by other copyright notices)
9#
10#
11# LICENSE:
12#
13# This work is made available to you under the terms of Version 2 of
14# the GNU General Public License. A copy of that license should have
15# been provided with this software, but in any event can be snarfed
16# from www.gnu.org.
17#
18# This work is distributed in the hope that it will be useful, but
19# WITHOUT ANY WARRANTY; without even the implied warranty of
20# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21# General Public License for more details.
22#
23# You should have received a copy of the GNU General Public License
24# along with this program; if not, write to the Free Software
25# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
26# 02110-1301 or visit their web page on the internet at
27# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
28#
29#
30# CONTRIBUTION SUBMISSION POLICY:
31#
32# (The following paragraph is not intended to limit the rights granted
33# to you to modify and distribute this software under the terms of
34# the GNU General Public License and is only of importance to you if
35# you choose to contribute your changes and enhancements to the
36# community by submitting them to Best Practical Solutions, LLC.)
37#
38# By intentionally submitting any modifications, corrections or
39# derivatives to this work, or any other work intended for use with
40# Request Tracker, to Best Practical Solutions, LLC, you confirm that
41# you are the copyright holder for those contributions and you grant
42# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
43# royalty-free, perpetual, license to use, copy, create derivative
44# works based on those contributions, and sublicense and distribute
45# those contributions and any derivatives thereof.
46#
47# END BPS TAGGED BLOCK }}}
48
49package RT::Action::CreateTickets;
50use base 'RT::Action';
51
52use strict;
53use warnings;
54
55use MIME::Entity;
56
57=head1 NAME
58
59 RT::Action::CreateTickets
60
61Create one or more tickets according to an externally supplied template.
62
63
64=head1 SYNOPSIS
65
66 ===Create-Ticket codereview
67 Subject: Code review for {$Tickets{'TOP'}->Subject}
68 Depended-On-By: TOP
69 Content: Someone has created a ticket. you should review and approve it,
70 so they can finish their work
71 ENDOFCONTENT
72
73=head1 DESCRIPTION
74
75
76Using the "CreateTickets" ScripAction and mandatory dependencies, RT now has
77the ability to model complex workflow. When a ticket is created in a queue
78that has a "CreateTickets" scripaction, that ScripAction parses its "Template"
79
80
81
82=head2 FORMAT
83
84CreateTickets uses the template as a template for an ordered set of tickets
85to create. The basic format is as follows:
86
87
88 ===Create-Ticket: identifier
89 Param: Value
90 Param2: Value
91 Param3: Value
92 Content: Blah
93 blah
94 blah
95 ENDOFCONTENT
96 ===Create-Ticket: id2
97 Param: Value
98 Content: Blah
99 ENDOFCONTENT
100
101
102Each ===Create-Ticket: section is evaluated as its own
103Text::Template object, which means that you can embed snippets
104of perl inside the Text::Template using {} delimiters, but that
105such sections absolutely can not span a ===Create-Ticket boundary.
106
107After each ticket is created, it's stuffed into a hash called %Tickets
108so as to be available during the creation of other tickets during the
109same ScripAction, using the key 'create-identifier', where
110C<identifier> is the id you put after C<===Create-Ticket:>. The hash
111is prepopulated with the ticket which triggered the ScripAction as
112$Tickets{'TOP'}; you can also access that ticket using the shorthand
113TOP.
114
115A simple example:
116
117 ===Create-Ticket: codereview
118 Subject: Code review for {$Tickets{'TOP'}->Subject}
119 Depended-On-By: TOP
120 Content: Someone has created a ticket. you should review and approve it,
121 so they can finish their work
122 ENDOFCONTENT
123
124
125
126A convoluted example
127
128 ===Create-Ticket: approval
129 { # Find out who the administrators of the group called "HR"
130 # of which the creator of this ticket is a member
131 my $name = "HR";
132
133 my $groups = RT::Groups->new(RT->SystemUser);
134 $groups->LimitToUserDefinedGroups();
135 $groups->Limit(FIELD => "Name", OPERATOR => "=", VALUE => "$name");
136 $groups->WithMember($TransactionObj->CreatorObj->Id);
137
138 my $groupid = $groups->First->Id;
139
140 my $adminccs = RT::Users->new(RT->SystemUser);
141 $adminccs->WhoHaveRight(
142 Right => "AdminGroup",
143 Object =>$groups->First,
144 IncludeSystemRights => undef,
145 IncludeSuperusers => 0,
146 IncludeSubgroupMembers => 0,
147 );
148
149 my @admins;
150 while (my $admin = $adminccs->Next) {
151 push (@admins, $admin->EmailAddress);
152 }
153 }
154 Queue: ___Approvals
155 Type: approval
156 AdminCc: {join ("\nAdminCc: ",@admins) }
157 Depended-On-By: TOP
158 Refers-To: TOP
159 Subject: Approval for ticket: {$Tickets{"TOP"}->Id} - {$Tickets{"TOP"}->Subject}
160 Due: {time + 86400}
161 Content-Type: text/plain
162 Content: Your approval is requested for the ticket {$Tickets{"TOP"}->Id}: {$Tickets{"TOP"}->Subject}
163 Blah
164 Blah
165 ENDOFCONTENT
166 ===Create-Ticket: two
167 Subject: Manager approval
168 Type: approval
169 Depended-On-By: TOP
170 Refers-To: {$Tickets{"create-approval"}->Id}
171 Queue: ___Approvals
172 Content-Type: text/plain
173 Content:
174 Your approval is requred for this ticket, too.
175 ENDOFCONTENT
176
177=head2 Acceptable fields
178
179A complete list of acceptable fields for this beastie:
180
181
182 * Queue => Name or id# of a queue
183 Subject => A text string
184 ! Status => A valid status. defaults to 'new'
185 Due => Dates can be specified in seconds since the epoch
186 to be handled literally or in a semi-free textual
187 format which RT will attempt to parse.
188
189
190
191 Starts =>
192 Started =>
193 Resolved =>
194 Owner => Username or id of an RT user who can and should own
195 this ticket; forces the owner if necessary
196 + Requestor => Email address
197 + Cc => Email address
198 + AdminCc => Email address
199 + RequestorGroup => Group name
200 + CcGroup => Group name
201 + AdminCcGroup => Group name
202 TimeWorked =>
203 TimeEstimated =>
204 TimeLeft =>
205 InitialPriority =>
206 FinalPriority =>
207 Type =>
208 +! DependsOn =>
209 +! DependedOnBy =>
210 +! RefersTo =>
211 +! ReferredToBy =>
212 +! Members =>
213 +! MemberOf =>
214 Content => content. Can extend to multiple lines. Everything
215 within a template after a Content: header is treated
216 as content until we hit a line containing only
217 ENDOFCONTENT
218 ContentType => the content-type of the Content field. Defaults to
219 'text/plain'
220 UpdateType => 'correspond' or 'comment'; used in conjunction with
221 'content' if this is an update. Defaults to
222 'correspond'
223
224 CustomField-<id#> => custom field value
225 CF-name => custom field value
226 CustomField-name => custom field value
227
228Fields marked with an * are required.
229
230Fields marked with a + may have multiple values, simply
231by repeating the fieldname on a new line with an additional value.
232
233Fields marked with a ! are postponed to be processed after all
234tickets in the same actions are created. Except for 'Status', those
235field can also take a ticket name within the same action (i.e.
236the identifiers after ===Create-Ticket), instead of raw Ticket ID
237numbers.
238
239When parsed, field names are converted to lowercase and have -s stripped.
240Refers-To, RefersTo, refersto, refers-to and r-e-f-er-s-tO will all
241be treated as the same thing.
242
243
244
245
246=head1 AUTHOR
247
248Jesse Vincent <jesse@bestpractical.com>
249
250=head1 SEE ALSO
251
252perl(1).
253
254=cut
255
256my %LINKTYPEMAP = (
257 MemberOf => {
258 Type => 'MemberOf',
259 Mode => 'Target',
260 },
261 Parents => {
262 Type => 'MemberOf',
263 Mode => 'Target',
264 },
265 Members => {
266 Type => 'MemberOf',
267 Mode => 'Base',
268 },
269 Children => {
270 Type => 'MemberOf',
271 Mode => 'Base',
272 },
273 HasMember => {
274 Type => 'MemberOf',
275 Mode => 'Base',
276 },
277 RefersTo => {
278 Type => 'RefersTo',
279 Mode => 'Target',
280 },
281 ReferredToBy => {
282 Type => 'RefersTo',
283 Mode => 'Base',
284 },
285 DependsOn => {
286 Type => 'DependsOn',
287 Mode => 'Target',
288 },
289 DependedOnBy => {
290 Type => 'DependsOn',
291 Mode => 'Base',
292 },
293
294);
295
296
297#Do what we need to do and send it out.
298sub Commit {
299 my $self = shift;
300
301 # Create all the tickets we care about
302 return (1) unless $self->TicketObj->Type eq 'ticket';
303
304 $self->CreateByTemplate( $self->TicketObj );
305 $self->UpdateByTemplate( $self->TicketObj );
306 return (1);
307}
308
309
310
311sub Prepare {
312 my $self = shift;
313
314 unless ( $self->TemplateObj ) {
315 $RT::Logger->warning("No template object handed to $self");
316 }
317
318 unless ( $self->TransactionObj ) {
319 $RT::Logger->warning("No transaction object handed to $self");
320
321 }
322
323 unless ( $self->TicketObj ) {
324 $RT::Logger->warning("No ticket object handed to $self");
325
326 }
327
328 my $active = 0;
329 if ( $self->TemplateObj->Type eq 'Perl' ) {
330 $active = 1;
331 } else {
332 RT->Logger->info(sprintf(
333 "Template #%d is type %s. You most likely want to use a Perl template instead.",
334 $self->TemplateObj->id, $self->TemplateObj->Type
335 ));
336 }
337
338 $self->Parse(
339 Content => $self->TemplateObj->Content,
340 _ActiveContent => $active,
341 );
342 return 1;
343
344}
345
346
347
348sub CreateByTemplate {
349 my $self = shift;
350 my $top = shift;
351
352 $RT::Logger->debug("In CreateByTemplate");
353
354 my @results;
355
356 # XXX: cargo cult programming that works. i'll be back.
357
358 local %T::Tickets = %T::Tickets;
359 local $T::TOP = $T::TOP;
360 local $T::ID = $T::ID;
361 $T::Tickets{'TOP'} = $T::TOP = $top if $top;
362 local $T::TransactionObj = $self->TransactionObj;
363
364 my $ticketargs;
365 my ( @links, @postponed );
366 foreach my $template_id ( @{ $self->{'create_tickets'} } ) {
367 $RT::Logger->debug("Workflow: processing $template_id of $T::TOP")
368 if $T::TOP;
369
370 $T::ID = $template_id;
371 @T::AllID = @{ $self->{'create_tickets'} };
372
373 ( $T::Tickets{$template_id}, $ticketargs )
374 = $self->ParseLines( $template_id, \@links, \@postponed );
375
376 # Now we have a %args to work with.
377 # Make sure we have at least the minimum set of
378 # reasonable data and do our thang
379
380 my ( $id, $transid, $msg )
381 = $T::Tickets{$template_id}->Create(%$ticketargs);
382
383 foreach my $res ( split( '\n', $msg ) ) {
384 push @results,
385 $T::Tickets{$template_id}
386 ->loc( "Ticket [_1]", $T::Tickets{$template_id}->Id ) . ': '
387 . $res;
388 }
389 if ( !$id ) {
390 if ( $self->TicketObj ) {
391 $msg = "Couldn't create related ticket $template_id for "
392 . $self->TicketObj->Id . " "
393 . $msg;
394 } else {
395 $msg = "Couldn't create ticket $template_id " . $msg;
396 }
397
398 $RT::Logger->error($msg);
399 next;
400 }
401
402 $RT::Logger->debug("Assigned $template_id with $id");
403 $T::Tickets{$template_id}->SetOriginObj( $self->TicketObj )
404 if $self->TicketObj
405 && $T::Tickets{$template_id}->can('SetOriginObj');
406
407 }
408
409 $self->PostProcess( \@links, \@postponed );
410
411 return @results;
412}
413
414sub UpdateByTemplate {
415 my $self = shift;
416 my $top = shift;
417
418 # XXX: cargo cult programming that works. i'll be back.
419
420 my @results;
421 local %T::Tickets = %T::Tickets;
422 local $T::ID = $T::ID;
423
424 my $ticketargs;
425 my ( @links, @postponed );
426 foreach my $template_id ( @{ $self->{'update_tickets'} } ) {
427 $RT::Logger->debug("Update Workflow: processing $template_id");
428
429 $T::ID = $template_id;
430 @T::AllID = @{ $self->{'update_tickets'} };
431
432 ( $T::Tickets{$template_id}, $ticketargs )
433 = $self->ParseLines( $template_id, \@links, \@postponed );
434
435 # Now we have a %args to work with.
436 # Make sure we have at least the minimum set of
437 # reasonable data and do our thang
438
439 my @attribs = qw(
440 Subject
441 FinalPriority
442 Priority
443 TimeEstimated
444 TimeWorked
445 TimeLeft
446 Status
447 Queue
448 Due
449 Starts
450 Started
451 Resolved
452 );
453
454 my $id = $template_id;
455 $id =~ s/update-(\d+).*/$1/;
456 my ($loaded, $msg) = $T::Tickets{$template_id}->LoadById($id);
457
458 unless ( $loaded ) {
459 $RT::Logger->error("Couldn't update ticket $template_id: " . $msg);
460 push @results, $self->loc( "Couldn't load ticket '[_1]'", $id );
461 next;
462 }
463
464 my $current = $self->GetBaseTemplate( $T::Tickets{$template_id} );
465
466 $template_id =~ m/^update-(.*)/;
467 my $base_id = "base-$1";
468 my $base = $self->{'templates'}->{$base_id};
469 if ($base) {
470 $base =~ s/\r//g;
471 $base =~ s/\n+$//;
472 $current =~ s/\n+$//;
473
474 # If we have no base template, set what we can.
475 if ( $base ne $current ) {
476 push @results,
477 "Could not update ticket "
478 . $T::Tickets{$template_id}->Id
479 . ": Ticket has changed";
480 next;
481 }
482 }
483 push @results, $T::Tickets{$template_id}->Update(
484 AttributesRef => \@attribs,
485 ARGSRef => $ticketargs
486 );
487
488 if ( $ticketargs->{'Owner'} ) {
489 ($id, $msg) = $T::Tickets{$template_id}->SetOwner($ticketargs->{'Owner'}, "Force");
490 push @results, $msg unless $msg eq $self->loc("That user already owns that ticket");
491 }
492
493 push @results,
494 $self->UpdateWatchers( $T::Tickets{$template_id}, $ticketargs );
495
496 push @results,
497 $self->UpdateCustomFields( $T::Tickets{$template_id}, $ticketargs );
498
499 next unless $ticketargs->{'MIMEObj'};
500 if ( $ticketargs->{'UpdateType'} =~ /^(private|comment)$/i ) {
501 my ( $Transaction, $Description, $Object )
502 = $T::Tickets{$template_id}->Comment(
503 BccMessageTo => $ticketargs->{'Bcc'},
504 MIMEObj => $ticketargs->{'MIMEObj'},
505 TimeTaken => $ticketargs->{'TimeWorked'}
506 );
507 push( @results,
508 $T::Tickets{$template_id}
509 ->loc( "Ticket [_1]", $T::Tickets{$template_id}->id )
510 . ': '
511 . $Description );
512 } elsif ( $ticketargs->{'UpdateType'} =~ /^(public|response|correspond)$/i ) {
513 my ( $Transaction, $Description, $Object )
514 = $T::Tickets{$template_id}->Correspond(
515 BccMessageTo => $ticketargs->{'Bcc'},
516 MIMEObj => $ticketargs->{'MIMEObj'},
517 TimeTaken => $ticketargs->{'TimeWorked'}
518 );
519 push( @results,
520 $T::Tickets{$template_id}
521 ->loc( "Ticket [_1]", $T::Tickets{$template_id}->id )
522 . ': '
523 . $Description );
524 } else {
525 push(
526 @results,
527 $T::Tickets{$template_id}->loc(
528 "Update type was neither correspondence nor comment.")
529 . " "
530 . $T::Tickets{$template_id}->loc("Update not recorded.")
531 );
532 }
533 }
534
535 $self->PostProcess( \@links, \@postponed );
536
537 return @results;
538}
539
540=head2 Parse TEMPLATE_CONTENT, DEFAULT_QUEUE, DEFAULT_REQEUESTOR ACTIVE
541
542Parse a template from TEMPLATE_CONTENT
543
544If $active is set to true, then we'll use Text::Template to parse the templates,
545allowing you to embed active perl in your templates.
546
547=cut
548
549sub Parse {
550 my $self = shift;
551 my %args = (
552 Content => undef,
553 Queue => undef,
554 Requestor => undef,
555 _ActiveContent => undef,
556 @_
557 );
558
559 if ( $args{'_ActiveContent'} ) {
560 $self->{'UsePerlTextTemplate'} = 1;
561 } else {
562
563 $self->{'UsePerlTextTemplate'} = 0;
564 }
565
566 if ( substr( $args{'Content'}, 0, 3 ) eq '===' ) {
567 $self->_ParseMultilineTemplate(%args);
568 } elsif ( $args{'Content'} =~ /(?:\t|,)/i ) {
569 $self->_ParseXSVTemplate(%args);
dab09ea8
MKG
570 } else {
571 RT->Logger->error("Invalid Template Content (Couldn't find ===, and is not a csv/tsv template) - unable to parse: $args{Content}");
84fb5b46
MKG
572 }
573}
574
575=head2 _ParseMultilineTemplate
576
577Parses mulitline templates. Things like:
578
579 ===Create-Ticket ...
580
581Takes the same arguments as Parse
582
583=cut
584
585sub _ParseMultilineTemplate {
586 my $self = shift;
587 my %args = (@_);
588
589 my $template_id;
590 require Encode;
591 require utf8;
592 my ( $queue, $requestor );
593 $RT::Logger->debug("Line: ===");
594 foreach my $line ( split( /\n/, $args{'Content'} ) ) {
595 $line =~ s/\r$//;
596 $RT::Logger->debug( "Line: " . utf8::is_utf8($line)
597 ? Encode::encode_utf8($line)
598 : $line );
599 if ( $line =~ /^===/ ) {
600 if ( $template_id && !$queue && $args{'Queue'} ) {
601 $self->{'templates'}->{$template_id}
602 .= "Queue: $args{'Queue'}\n";
603 }
604 if ( $template_id && !$requestor && $args{'Requestor'} ) {
605 $self->{'templates'}->{$template_id}
606 .= "Requestor: $args{'Requestor'}\n";
607 }
608 $queue = 0;
609 $requestor = 0;
610 }
611 if ( $line =~ /^===Create-Ticket: (.*)$/ ) {
612 $template_id = "create-$1";
613 $RT::Logger->debug("**** Create ticket: $template_id");
614 push @{ $self->{'create_tickets'} }, $template_id;
615 } elsif ( $line =~ /^===Update-Ticket: (.*)$/ ) {
616 $template_id = "update-$1";
617 $RT::Logger->debug("**** Update ticket: $template_id");
618 push @{ $self->{'update_tickets'} }, $template_id;
619 } elsif ( $line =~ /^===Base-Ticket: (.*)$/ ) {
620 $template_id = "base-$1";
621 $RT::Logger->debug("**** Base ticket: $template_id");
622 push @{ $self->{'base_tickets'} }, $template_id;
623 } elsif ( $line =~ /^===#.*$/ ) { # a comment
624 next;
625 } else {
626 if ( $line =~ /^Queue:(.*)/i ) {
627 $queue = 1;
628 my $value = $1;
629 $value =~ s/^\s//;
630 $value =~ s/\s$//;
631 if ( !$value && $args{'Queue'} ) {
632 $value = $args{'Queue'};
633 $line = "Queue: $value";
634 }
635 }
636 if ( $line =~ /^Requestors?:(.*)/i ) {
637 $requestor = 1;
638 my $value = $1;
639 $value =~ s/^\s//;
640 $value =~ s/\s$//;
641 if ( !$value && $args{'Requestor'} ) {
642 $value = $args{'Requestor'};
643 $line = "Requestor: $value";
644 }
645 }
646 $self->{'templates'}->{$template_id} .= $line . "\n";
647 }
648 }
649 if ( $template_id && !$queue && $args{'Queue'} ) {
650 $self->{'templates'}->{$template_id} .= "Queue: $args{'Queue'}\n";
651 }
652 }
653
654sub ParseLines {
655 my $self = shift;
656 my $template_id = shift;
657 my $links = shift;
658 my $postponed = shift;
659
660 my $content = $self->{'templates'}->{$template_id};
661
662 if ( $self->{'UsePerlTextTemplate'} ) {
663
664 $RT::Logger->debug(
665 "Workflow: evaluating\n$self->{templates}{$template_id}");
666
667 my $template = Text::Template->new(
668 TYPE => 'STRING',
669 SOURCE => $content
670 );
671
672 my $err;
673 $content = $template->fill_in(
674 PACKAGE => 'T',
675 BROKEN => sub {
676 $err = {@_}->{error};
677 }
678 );
679
680 $RT::Logger->debug("Workflow: yielding $content");
681
682 if ($err) {
683 $RT::Logger->error( "Ticket creation failed: " . $err );
684 while ( my ( $k, $v ) = each %T::X ) {
685 $RT::Logger->debug(
686 "Eliminating $template_id from ${k}'s parents.");
687 delete $v->{$template_id};
688 }
689 next;
690 }
691 }
692
693 my $TicketObj ||= RT::Ticket->new( $self->CurrentUser );
694
695 my %args;
696 my %original_tags;
697 my @lines = ( split( /\n/, $content ) );
698 while ( defined( my $line = shift @lines ) ) {
699 if ( $line =~ /^(.*?):(?:\s+)(.*?)(?:\s*)$/ ) {
700 my $value = $2;
701 my $original_tag = $1;
702 my $tag = lc($original_tag);
703 $tag =~ s/-//g;
704 $tag =~ s/^(requestor|cc|admincc)s?$/$1/i;
705
706 $original_tags{$tag} = $original_tag;
707
708 if ( ref( $args{$tag} ) )
709 { #If it's an array, we want to push the value
710 push @{ $args{$tag} }, $value;
711 } elsif ( defined( $args{$tag} ) )
712 { #if we're about to get a second value, make it an array
713 $args{$tag} = [ $args{$tag}, $value ];
714 } else { #if there's nothing there, just set the value
715 $args{$tag} = $value;
716 }
717
718 if ( $tag =~ /^content$/i ) { #just build up the content
719 # convert it to an array
720 $args{$tag} = defined($value) ? [ $value . "\n" ] : [];
721 while ( defined( my $l = shift @lines ) ) {
722 last if ( $l =~ /^ENDOFCONTENT\s*$/ );
723 push @{ $args{'content'} }, $l . "\n";
724 }
725 } else {
726 # if it's not content, strip leading and trailing spaces
727 if ( $args{$tag} ) {
728 $args{$tag} =~ s/^\s+//g;
729 $args{$tag} =~ s/\s+$//g;
730 }
731 if (
732 ($tag =~ /^(requestor|cc|admincc)(group)?$/i
733 or grep {lc $_ eq $tag} keys %LINKTYPEMAP)
734 and $args{$tag} =~ /,/
735 ) {
736 $args{$tag} = [ split /,\s*/, $args{$tag} ];
737 }
738 }
739 }
740 }
741
742 foreach my $date (qw(due starts started resolved)) {
743 my $dateobj = RT::Date->new( $self->CurrentUser );
744 next unless $args{$date};
745 if ( $args{$date} =~ /^\d+$/ ) {
746 $dateobj->Set( Format => 'unix', Value => $args{$date} );
747 } else {
748 eval {
749 $dateobj->Set( Format => 'iso', Value => $args{$date} );
750 };
751 if ($@ or $dateobj->Unix <= 0) {
752 $dateobj->Set( Format => 'unknown', Value => $args{$date} );
753 }
754 }
755 $args{$date} = $dateobj->ISO;
756 }
757
758 foreach my $role (qw(requestor cc admincc)) {
759 next unless my $value = $args{ $role . 'group' };
760
761 my $group = RT::Group->new( $self->CurrentUser );
762 $group->LoadUserDefinedGroup( $value );
763 unless ( $group->id ) {
764 $RT::Logger->error("Couldn't load group '$value'");
765 next;
766 }
767
768 $args{ $role } = $args{ $role } ? [$args{ $role }] : []
769 unless ref $args{ $role };
770 push @{ $args{ $role } }, $group->PrincipalObj->id;
771 }
772
773 $args{'requestor'} ||= $self->TicketObj->Requestors->MemberEmailAddresses
774 if $self->TicketObj;
775
776 $args{'type'} ||= 'ticket';
777
778 my %ticketargs = (
779 Queue => $args{'queue'},
780 Subject => $args{'subject'},
781 Status => $args{'status'} || 'new',
782 Due => $args{'due'},
783 Starts => $args{'starts'},
784 Started => $args{'started'},
785 Resolved => $args{'resolved'},
786 Owner => $args{'owner'},
787 Requestor => $args{'requestor'},
788 Cc => $args{'cc'},
789 AdminCc => $args{'admincc'},
790 TimeWorked => $args{'timeworked'},
791 TimeEstimated => $args{'timeestimated'},
792 TimeLeft => $args{'timeleft'},
793 InitialPriority => $args{'initialpriority'} || 0,
794 FinalPriority => $args{'finalpriority'} || 0,
795 SquelchMailTo => $args{'squelchmailto'},
796 Type => $args{'type'},
797 );
798
799 if ( $args{content} ) {
800 my $mimeobj = MIME::Entity->new();
801 $mimeobj->build(
802 Type => $args{'contenttype'} || 'text/plain',
803 Data => $args{'content'}
804 );
805 $ticketargs{MIMEObj} = $mimeobj;
806 $ticketargs{UpdateType} = $args{'updatetype'} || 'correspond';
807 }
808
809 foreach my $tag ( keys(%args) ) {
810 # if the tag was added later, skip it
811 my $orig_tag = $original_tags{$tag} or next;
812 if ( $orig_tag =~ /^customfield-?(\d+)$/i ) {
813 $ticketargs{ "CustomField-" . $1 } = $args{$tag};
814 } elsif ( $orig_tag =~ /^(?:customfield|cf)-?(.+)$/i ) {
815 my $cf = RT::CustomField->new( $self->CurrentUser );
816 $cf->LoadByName( Name => $1, Queue => $ticketargs{Queue} );
817 $cf->LoadByName( Name => $1, Queue => 0 ) unless $cf->id;
818 next unless $cf->id;
819 $ticketargs{ "CustomField-" . $cf->id } = $args{$tag};
820 } elsif ($orig_tag) {
821 my $cf = RT::CustomField->new( $self->CurrentUser );
822 $cf->LoadByName( Name => $orig_tag, Queue => $ticketargs{Queue} );
823 $cf->LoadByName( Name => $orig_tag, Queue => 0 ) unless $cf->id;
824 next unless $cf->id;
825 $ticketargs{ "CustomField-" . $cf->id } = $args{$tag};
826
827 }
828 }
829
830 $self->GetDeferred( \%args, $template_id, $links, $postponed );
831
832 return $TicketObj, \%ticketargs;
833}
834
835
836=head2 _ParseXSVTemplate
837
838Parses a tab or comma delimited template. Should only ever be called by Parse
839
840=cut
841
842sub _ParseXSVTemplate {
843 my $self = shift;
844 my %args = (@_);
845
846 use Regexp::Common qw(delimited);
847 my($first, $content) = split(/\r?\n/, $args{'Content'}, 2);
848
849 my $delimiter;
850 if ( $first =~ /\t/ ) {
851 $delimiter = "\t";
852 } else {
853 $delimiter = ',';
854 }
855 my @fields = split( /$delimiter/, $first );
856
857 my $delimiter_re = qr[$delimiter];
858 my $justquoted = qr[$RE{quoted}];
859
860 # Used to generate automatic template ids
861 my $autoid = 1;
862
863 LINE:
864 while ($content) {
865 $content =~ s/^(\s*\r?\n)+//;
866
867 # Keep track of Queue and Requestor, so we can provide defaults
868 my $queue;
869 my $requestor;
870
871 # The template for this line
872 my $template;
873
874 # What column we're on
875 my $i = 0;
876
877 # If the last iteration was the end of the line
878 my $EOL = 0;
879
880 # The template id
881 my $template_id;
882
883 COLUMN:
884 while (not $EOL and length $content and $content =~ s/^($justquoted|.*?)($delimiter_re|$)//smix) {
885 $EOL = not $2;
886
887 # Strip off quotes, if they exist
888 my $value = $1;
889 if ( $value =~ /^$RE{delimited}{-delim=>qq{\'\"}}$/ ) {
890 substr( $value, 0, 1 ) = "";
891 substr( $value, -1, 1 ) = "";
892 }
893
894 # What column is this?
895 my $field = $fields[$i++];
896 next COLUMN unless $field =~ /\S/;
897 $field =~ s/^\s//;
898 $field =~ s/\s$//;
899
900 if ( $field =~ /^id$/i ) {
901 # Special case if this is the ID column
902 if ( $value =~ /^\d+$/ ) {
903 $template_id = 'update-' . $value;
904 push @{ $self->{'update_tickets'} }, $template_id;
905 } elsif ( $value =~ /^#base-(\d+)$/ ) {
906 $template_id = 'base-' . $1;
907 push @{ $self->{'base_tickets'} }, $template_id;
908 } elsif ( $value =~ /\S/ ) {
909 $template_id = 'create-' . $value;
910 push @{ $self->{'create_tickets'} }, $template_id;
911 }
912 } else {
913 # Some translations
914 if ( $field =~ /^Body$/i
915 || $field =~ /^Data$/i
916 || $field =~ /^Message$/i )
917 {
918 $field = 'Content';
919 } elsif ( $field =~ /^Summary$/i ) {
920 $field = 'Subject';
921 } elsif ( $field =~ /^Queue$/i ) {
922 # Note that we found a queue
923 $queue = 1;
924 $value ||= $args{'Queue'};
925 } elsif ( $field =~ /^Requestors?$/i ) {
926 $field = 'Requestor'; # Remove plural
927 # Note that we found a requestor
928 $requestor = 1;
929 $value ||= $args{'Requestor'};
930 }
931
932 # Tack onto the end of the template
933 $template .= $field . ": ";
934 $template .= (defined $value ? $value : "");
935 $template .= "\n";
936 $template .= "ENDOFCONTENT\n"
937 if $field =~ /^Content$/i;
938 }
939 }
940
941 # Ignore blank lines
942 next unless $template;
943
944 # If we didn't find a queue of requestor, tack on the defaults
945 if ( !$queue && $args{'Queue'} ) {
946 $template .= "Queue: $args{'Queue'}\n";
947 }
948 if ( !$requestor && $args{'Requestor'} ) {
949 $template .= "Requestor: $args{'Requestor'}\n";
950 }
951
952 # If we never found an ID, come up with one
953 unless ($template_id) {
954 $autoid++ while exists $self->{'templates'}->{"create-auto-$autoid"};
955 $template_id = "create-auto-$autoid";
956 # Also, it's a ticket to create
957 push @{ $self->{'create_tickets'} }, $template_id;
958 }
959
960 # Save the template we generated
961 $self->{'templates'}->{$template_id} = $template;
962
963 }
964}
965
966sub GetDeferred {
967 my $self = shift;
968 my $args = shift;
969 my $id = shift;
970 my $links = shift;
971 my $postponed = shift;
972
973 # Deferred processing
974 push @$links,
975 (
976 $id,
977 { DependsOn => $args->{'dependson'},
978 DependedOnBy => $args->{'dependedonby'},
979 RefersTo => $args->{'refersto'},
980 ReferredToBy => $args->{'referredtoby'},
981 Children => $args->{'children'},
982 Parents => $args->{'parents'},
983 }
984 );
985
986 push @$postponed, (
987
988 # Status is postponed so we don't violate dependencies
989 $id, { Status => $args->{'status'}, }
990 );
991}
992
993sub GetUpdateTemplate {
994 my $self = shift;
995 my $t = shift;
996
997 my $string;
998 $string .= "Queue: " . $t->QueueObj->Name . "\n";
999 $string .= "Subject: " . $t->Subject . "\n";
1000 $string .= "Status: " . $t->Status . "\n";
1001 $string .= "UpdateType: correspond\n";
1002 $string .= "Content: \n";
1003 $string .= "ENDOFCONTENT\n";
1004 $string .= "Due: " . $t->DueObj->AsString . "\n";
1005 $string .= "Starts: " . $t->StartsObj->AsString . "\n";
1006 $string .= "Started: " . $t->StartedObj->AsString . "\n";
1007 $string .= "Resolved: " . $t->ResolvedObj->AsString . "\n";
1008 $string .= "Owner: " . $t->OwnerObj->Name . "\n";
1009 $string .= "Requestor: " . $t->RequestorAddresses . "\n";
1010 $string .= "Cc: " . $t->CcAddresses . "\n";
1011 $string .= "AdminCc: " . $t->AdminCcAddresses . "\n";
1012 $string .= "TimeWorked: " . $t->TimeWorked . "\n";
1013 $string .= "TimeEstimated: " . $t->TimeEstimated . "\n";
1014 $string .= "TimeLeft: " . $t->TimeLeft . "\n";
1015 $string .= "InitialPriority: " . $t->Priority . "\n";
1016 $string .= "FinalPriority: " . $t->FinalPriority . "\n";
1017
1018 foreach my $type ( sort keys %LINKTYPEMAP ) {
1019
1020 # don't display duplicates
1021 if ( $type eq "HasMember"
1022 || $type eq "Members"
1023 || $type eq "MemberOf" )
1024 {
1025 next;
1026 }
1027 $string .= "$type: ";
1028
1029 my $mode = $LINKTYPEMAP{$type}->{Mode};
1030 my $method = $LINKTYPEMAP{$type}->{Type};
1031
1032 my $links = '';
1033 while ( my $link = $t->$method->Next ) {
1034 $links .= ", " if $links;
1035
1036 my $object = $mode . "Obj";
1037 my $member = $link->$object;
1038 $links .= $member->Id if $member;
1039 }
1040 $string .= $links;
1041 $string .= "\n";
1042 }
1043
1044 return $string;
1045}
1046
1047sub GetBaseTemplate {
1048 my $self = shift;
1049 my $t = shift;
1050
1051 my $string;
1052 $string .= "Queue: " . $t->Queue . "\n";
1053 $string .= "Subject: " . $t->Subject . "\n";
1054 $string .= "Status: " . $t->Status . "\n";
1055 $string .= "Due: " . $t->DueObj->Unix . "\n";
1056 $string .= "Starts: " . $t->StartsObj->Unix . "\n";
1057 $string .= "Started: " . $t->StartedObj->Unix . "\n";
1058 $string .= "Resolved: " . $t->ResolvedObj->Unix . "\n";
1059 $string .= "Owner: " . $t->Owner . "\n";
1060 $string .= "Requestor: " . $t->RequestorAddresses . "\n";
1061 $string .= "Cc: " . $t->CcAddresses . "\n";
1062 $string .= "AdminCc: " . $t->AdminCcAddresses . "\n";
1063 $string .= "TimeWorked: " . $t->TimeWorked . "\n";
1064 $string .= "TimeEstimated: " . $t->TimeEstimated . "\n";
1065 $string .= "TimeLeft: " . $t->TimeLeft . "\n";
1066 $string .= "InitialPriority: " . $t->Priority . "\n";
1067 $string .= "FinalPriority: " . $t->FinalPriority . "\n";
1068
1069 return $string;
1070}
1071
1072sub GetCreateTemplate {
1073 my $self = shift;
1074
1075 my $string;
1076
1077 $string .= "Queue: General\n";
1078 $string .= "Subject: \n";
1079 $string .= "Status: new\n";
1080 $string .= "Content: \n";
1081 $string .= "ENDOFCONTENT\n";
1082 $string .= "Due: \n";
1083 $string .= "Starts: \n";
1084 $string .= "Started: \n";
1085 $string .= "Resolved: \n";
1086 $string .= "Owner: \n";
1087 $string .= "Requestor: \n";
1088 $string .= "Cc: \n";
1089 $string .= "AdminCc:\n";
1090 $string .= "TimeWorked: \n";
1091 $string .= "TimeEstimated: \n";
1092 $string .= "TimeLeft: \n";
1093 $string .= "InitialPriority: \n";
1094 $string .= "FinalPriority: \n";
1095
1096 foreach my $type ( keys %LINKTYPEMAP ) {
1097
1098 # don't display duplicates
1099 if ( $type eq "HasMember"
1100 || $type eq 'Members'
1101 || $type eq 'MemberOf' )
1102 {
1103 next;
1104 }
1105 $string .= "$type: \n";
1106 }
1107 return $string;
1108}
1109
1110sub UpdateWatchers {
1111 my $self = shift;
1112 my $ticket = shift;
1113 my $args = shift;
1114
1115 my @results;
1116
1117 foreach my $type (qw(Requestor Cc AdminCc)) {
1118 my $method = $type . 'Addresses';
1119 my $oldaddr = $ticket->$method;
1120
1121 # Skip unless we have a defined field
1122 next unless defined $args->{$type};
1123 my $newaddr = $args->{$type};
1124
1125 my @old = split( /,\s*/, $oldaddr );
1126 my @new;
1127 for (ref $newaddr ? @{$newaddr} : split( /,\s*/, $newaddr )) {
1128 # Sometimes these are email addresses, sometimes they're
1129 # users. Try to guess which is which, as we want to deal
1130 # with email addresses if at all possible.
1131 if (/^\S+@\S+$/) {
1132 push @new, $_;
1133 } else {
1134 # It doesn't look like an email address. Try to load it.
1135 my $user = RT::User->new($self->CurrentUser);
1136 $user->Load($_);
1137 if ($user->Id) {
1138 push @new, $user->EmailAddress;
1139 } else {
1140 push @new, $_;
1141 }
1142 }
1143 }
1144
1145 my %oldhash = map { $_ => 1 } @old;
1146 my %newhash = map { $_ => 1 } @new;
1147
1148 my @add = grep( !defined $oldhash{$_}, @new );
1149 my @delete = grep( !defined $newhash{$_}, @old );
1150
1151 foreach (@add) {
1152 my ( $val, $msg ) = $ticket->AddWatcher(
1153 Type => $type,
1154 Email => $_
1155 );
1156
1157 push @results,
1158 $ticket->loc( "Ticket [_1]", $ticket->Id ) . ': ' . $msg;
1159 }
1160
1161 foreach (@delete) {
1162 my ( $val, $msg ) = $ticket->DeleteWatcher(
1163 Type => $type,
1164 Email => $_
1165 );
1166 push @results,
1167 $ticket->loc( "Ticket [_1]", $ticket->Id ) . ': ' . $msg;
1168 }
1169 }
1170 return @results;
1171}
1172
1173sub UpdateCustomFields {
1174 my $self = shift;
1175 my $ticket = shift;
1176 my $args = shift;
1177
1178 my @results;
1179 foreach my $arg (keys %{$args}) {
1180 next unless $arg =~ /^CustomField-(\d+)$/;
1181 my $cf = $1;
1182
1183 my $CustomFieldObj = RT::CustomField->new($self->CurrentUser);
1184 $CustomFieldObj->SetContextObject( $ticket );
1185 $CustomFieldObj->LoadById($cf);
1186
1187 my @values;
1188 if ($CustomFieldObj->Type =~ /text/i) { # Both Text and Wikitext
1189 @values = ($args->{$arg});
1190 } else {
1191 @values = split /\n/, $args->{$arg};
1192 }
1193
1194 if ( ($CustomFieldObj->Type eq 'Freeform'
1195 && ! $CustomFieldObj->SingleValue) ||
1196 $CustomFieldObj->Type =~ /text/i) {
1197 foreach my $val (@values) {
1198 $val =~ s/\r//g;
1199 }
1200 }
1201
1202 foreach my $value (@values) {
1203 next unless length($value);
1204 my ( $val, $msg ) = $ticket->AddCustomFieldValue(
1205 Field => $cf,
1206 Value => $value
1207 );
1208 push ( @results, $msg );
1209 }
1210 }
1211 return @results;
1212}
1213
1214sub PostProcess {
1215 my $self = shift;
1216 my $links = shift;
1217 my $postponed = shift;
1218
1219 # postprocessing: add links
1220
1221 while ( my $template_id = shift(@$links) ) {
1222 my $ticket = $T::Tickets{$template_id};
1223 $RT::Logger->debug( "Handling links for " . $ticket->Id );
1224 my %args = %{ shift(@$links) };
1225
1226 foreach my $type ( keys %LINKTYPEMAP ) {
1227 next unless ( defined $args{$type} );
1228 foreach my $link (
1229 ref( $args{$type} ) ? @{ $args{$type} } : ( $args{$type} ) )
1230 {
1231 next unless $link;
1232
1233 if ( $link =~ /^TOP$/i ) {
1234 $RT::Logger->debug( "Building $type link for $link: "
1235 . $T::Tickets{TOP}->Id );
1236 $link = $T::Tickets{TOP}->Id;
1237
1238 } elsif ( $link !~ m/^\d+$/ ) {
1239 my $key = "create-$link";
1240 if ( !exists $T::Tickets{$key} ) {
1241 $RT::Logger->debug(
1242 "Skipping $type link for $key (non-existent)");
1243 next;
1244 }
1245 $RT::Logger->debug( "Building $type link for $link: "
1246 . $T::Tickets{$key}->Id );
1247 $link = $T::Tickets{$key}->Id;
1248 } else {
1249 $RT::Logger->debug("Building $type link for $link");
1250 }
1251
1252 my ( $wval, $wmsg ) = $ticket->AddLink(
1253 Type => $LINKTYPEMAP{$type}->{'Type'},
1254 $LINKTYPEMAP{$type}->{'Mode'} => $link,
1255 Silent => 1
1256 );
1257
1258 $RT::Logger->warning("AddLink thru $link failed: $wmsg")
1259 unless $wval;
1260
1261 # push @non_fatal_errors, $wmsg unless ($wval);
1262 }
1263
1264 }
1265 }
1266
1267 # postponed actions -- Status only, currently
1268 while ( my $template_id = shift(@$postponed) ) {
1269 my $ticket = $T::Tickets{$template_id};
1270 $RT::Logger->debug( "Handling postponed actions for " . $ticket->id );
1271 my %args = %{ shift(@$postponed) };
1272 $ticket->SetStatus( $args{Status} ) if defined $args{Status};
1273 }
1274
1275}
1276
1277RT::Base->_ImportOverlays();
1278
12791;
1280