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