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