Master to 4.2.8
[usit-rt.git] / lib / RT / Action / CreateTickets.pm
1 # BEGIN BPS TAGGED BLOCK {{{
2 #
3 # COPYRIGHT:
4 #
5 # This software is Copyright (c) 1996-2014 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
49 package RT::Action::CreateTickets;
50 use base 'RT::Action';
51
52 use strict;
53 use warnings;
54
55 use MIME::Entity;
56 use RT::Link;
57
58 =head1 NAME
59
60 RT::Action::CreateTickets - Create one or more tickets according to an externally supplied template
61
62 =head1 SYNOPSIS
63
64  ===Create-Ticket: codereview
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
73 The CreateTickets ScripAction allows you to create automated workflows in RT,
74 creating new tickets in response to actions and conditions from other
75 tickets.
76
77 =head2 Format
78
79 CreateTickets uses the RT template configured in the scrip as a template
80 for an ordered set of tickets to create. The basic format is as follows:
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
95 As shown, you can put one or more C<===Create-Ticket:> sections in
96 a template. Each C<===Create-Ticket:> section is evaluated as its own
97 L<Text::Template> object, which means that you can embed snippets
98 of Perl inside the L<Text::Template> using C<{}> delimiters, but that
99 such sections absolutely can not span a C<===Create-Ticket:> boundary.
100
101 Note that each C<Value> must come right after the C<Param> on the same
102 line. The C<Content:> param can extend over multiple lines, but the text
103 of the first line must start right after C<Content:>. Don't try to start
104 your C<Content:> section with a newline.
105
106 After each ticket is created, it's stuffed into a hash called C<%Tickets>
107 making it available during the creation of other tickets during the
108 same ScripAction. The hash key for each ticket is C<create-[identifier]>,
109 where C<[identifier]> is the value you put after C<===Create-Ticket:>.  The hash
110 is prepopulated with the ticket which triggered the ScripAction as
111 C<$Tickets{'TOP'}>. You can also access that ticket using the shorthand
112 C<TOP>.
113
114 A 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
123 A convoluted example:
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";
129
130     my $groups = RT::Groups->new(RT->SystemUser);
131     $groups->LimitToUserDefinedGroups();
132     $groups->Limit(FIELD => "Name", OPERATOR => "=", VALUE => $name, CASESENSITIVE => 0);
133     $groups->WithMember($TransactionObj->CreatorObj->Id);
134
135     my $groupid = $groups->First->Id;
136
137     my $adminccs = RT::Users->new(RT->SystemUser);
138     $adminccs->WhoHaveRight(
139         Right => "AdminGroup",
140         Object =>$groups->First,
141         IncludeSystemRights => undef,
142         IncludeSuperusers => 0,
143         IncludeSubgroupMembers => 0,
144     );
145
146      our @admins;
147      while (my $admin = $adminccs->Next) {
148          push (@admins, $admin->EmailAddress);
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
170  Content: Your approval is requred for this ticket, too.
171  ENDOFCONTENT
172
173 As shown above, you can include a block with Perl code to set up some
174 values for the new tickets. If you want to access a variable in the
175 template section after the block, you must scope it with C<our> rather
176 than C<my>. Just as with other RT templates, you can also include
177 Perl code in the template sections using C<{}>.
178
179 =head2 Acceptable Fields
180
181 A complete list of acceptable fields:
182
183     *  Queue           => Name or id# of a queue
184        Subject         => A text string
185      ! Status          => A valid status. Defaults to 'new'
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.
189        Starts          =>
190        Started         =>
191        Resolved        =>
192        Owner           => Username or id of an RT user who can and should own
193                           this ticket; forces the owner if necessary
194    +   Requestor       => Email address
195    +   Cc              => Email address
196    +   AdminCc         => Email address
197    +   RequestorGroup  => Group name
198    +   CcGroup         => Group name
199    +   AdminCcGroup    => Group name
200        TimeWorked      =>
201        TimeEstimated   =>
202        TimeLeft        =>
203        InitialPriority =>
204        FinalPriority   =>
205        Type            =>
206     +! DependsOn       =>
207     +! DependedOnBy    =>
208     +! RefersTo        =>
209     +! ReferredToBy    =>
210     +! Members         =>
211     +! MemberOf        =>
212        Content         => Content. Can extend to multiple lines. Everything
213                           within a template after a Content: header is treated
214                           as content until we hit a line containing only
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
226 Fields marked with an C<*> are required.
227
228 Fields marked with a C<+> may have multiple values, simply
229 by repeating the fieldname on a new line with an additional value.
230
231 Fields marked with a C<!> have processing postponed until after all
232 tickets in the same actions are created.  Except for C<Status>, those
233 fields can also take a ticket name within the same action (i.e.
234 the identifiers after C<===Create-Ticket:>), instead of raw ticket ID
235 numbers.
236
237 When parsed, field names are converted to lowercase and have hyphens stripped.
238 C<Refers-To>, C<RefersTo>, C<refersto>, C<refers-to> and C<r-e-f-er-s-tO> will
239 all be treated as the same thing.
240
241 =head1 METHODS
242
243 =cut
244
245 #Do what we need to do and send it out.
246 sub 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
259 sub 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
296 sub 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");
351     }
352
353     $self->PostProcess( \@links, \@postponed );
354
355     return @results;
356 }
357
358 sub 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
484 =head2 Parse
485
486 Takes (in order) template content, a default queue, a default requestor, and
487 active (a boolean flag).
488
489 Parses a template in the template content, defaulting queue and requestor if
490 unspecified in the template to the values provided as arguments.
491
492 If the active flag is true, then we'll use L<Text::Template> to parse the
493 templates, allowing you to embed active Perl in your templates.
494
495 =cut
496
497 sub 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);
518     } else {
519         RT->Logger->error("Invalid Template Content (Couldn't find ===, and is not a csv/tsv template) - unable to parse: $args{Content}");
520     }
521 }
522
523 =head2 _ParseMultilineTemplate
524
525 Parses mulitline templates. Things like:
526
527  ===Create-Ticket: ...
528
529 Takes the same arguments as L</Parse>.
530
531 =cut
532
533 sub _ParseMultilineTemplate {
534     my $self = shift;
535     my %args = (@_);
536
537     my $template_id;
538     my ( $queue, $requestor );
539         $RT::Logger->debug("Line: ===");
540         foreach my $line ( split( /\n/, $args{'Content'} ) ) {
541             $line =~ s/\r$//;
542             $RT::Logger->debug( "Line: $line" );
543             if ( $line =~ /^===/ ) {
544                 if ( $template_id && !$queue && $args{'Queue'} ) {
545                     $self->{'templates'}->{$template_id}
546                         .= "Queue: $args{'Queue'}\n";
547                 }
548                 if ( $template_id && !$requestor && $args{'Requestor'} ) {
549                     $self->{'templates'}->{$template_id}
550                         .= "Requestor: $args{'Requestor'}\n";
551                 }
552                 $queue     = 0;
553                 $requestor = 0;
554             }
555             if ( $line =~ /^===Create-Ticket: (.*)$/ ) {
556                 $template_id = "create-$1";
557                 $RT::Logger->debug("****  Create ticket: $template_id");
558                 push @{ $self->{'create_tickets'} }, $template_id;
559             } elsif ( $line =~ /^===Update-Ticket: (.*)$/ ) {
560                 $template_id = "update-$1";
561                 $RT::Logger->debug("****  Update ticket: $template_id");
562                 push @{ $self->{'update_tickets'} }, $template_id;
563             } elsif ( $line =~ /^===Base-Ticket: (.*)$/ ) {
564                 $template_id = "base-$1";
565                 $RT::Logger->debug("****  Base ticket: $template_id");
566                 push @{ $self->{'base_tickets'} }, $template_id;
567             } elsif ( $line =~ /^===#.*$/ ) {    # a comment
568                 next;
569             } else {
570                 if ( $line =~ /^Queue:(.*)/i ) {
571                     $queue = 1;
572                     my $value = $1;
573                     $value =~ s/^\s//;
574                     $value =~ s/\s$//;
575                     if ( !$value && $args{'Queue'} ) {
576                         $value = $args{'Queue'};
577                         $line  = "Queue: $value";
578                     }
579                 }
580                 if ( $line =~ /^Requestors?:(.*)/i ) {
581                     $requestor = 1;
582                     my $value = $1;
583                     $value =~ s/^\s//;
584                     $value =~ s/\s$//;
585                     if ( !$value && $args{'Requestor'} ) {
586                         $value = $args{'Requestor'};
587                         $line  = "Requestor: $value";
588                     }
589                 }
590                 $self->{'templates'}->{$template_id} .= $line . "\n";
591             }
592         }
593         if ( $template_id && !$queue && $args{'Queue'} ) {
594             $self->{'templates'}->{$template_id} .= "Queue: $args{'Queue'}\n";
595         }
596     }
597
598 sub ParseLines {
599     my $self        = shift;
600     my $template_id = shift;
601     my $links       = shift;
602     my $postponed   = shift;
603
604     my $content = $self->{'templates'}->{$template_id};
605
606     if ( $self->{'UsePerlTextTemplate'} ) {
607
608         $RT::Logger->debug(
609             "Workflow: evaluating\n$self->{templates}{$template_id}");
610
611         my $template = Text::Template->new(
612             TYPE   => 'STRING',
613             SOURCE => $content
614         );
615
616         my $err;
617         $content = $template->fill_in(
618             PACKAGE => 'T',
619             BROKEN  => sub {
620                 $err = {@_}->{error};
621             }
622         );
623
624         $RT::Logger->debug("Workflow: yielding $content");
625
626         if ($err) {
627             $RT::Logger->error( "Ticket creation failed: " . $err );
628             next;
629         }
630     }
631
632     my $TicketObj ||= RT::Ticket->new( $self->CurrentUser );
633
634     my %args;
635     my %original_tags;
636     my @lines = ( split( /\n/, $content ) );
637     while ( defined( my $line = shift @lines ) ) {
638         if ( $line =~ /^(.*?):(?:\s+)(.*?)(?:\s*)$/ ) {
639             my $value = $2;
640             my $original_tag = $1;
641             my $tag   = lc($original_tag);
642             $tag =~ s/-//g;
643             $tag =~ s/^(requestor|cc|admincc)s?$/$1/i;
644
645             $original_tags{$tag} = $original_tag;
646
647             if ( ref( $args{$tag} ) )
648             {    #If it's an array, we want to push the value
649                 push @{ $args{$tag} }, $value;
650             } elsif ( defined( $args{$tag} ) )
651             {    #if we're about to get a second value, make it an array
652                 $args{$tag} = [ $args{$tag}, $value ];
653             } else {    #if there's nothing there, just set the value
654                 $args{$tag} = $value;
655             }
656
657             if ( $tag =~ /^content$/i ) {    #just build up the content
658                                           # convert it to an array
659                 $args{$tag} = defined($value) ? [ $value . "\n" ] : [];
660                 while ( defined( my $l = shift @lines ) ) {
661                     last if ( $l =~ /^ENDOFCONTENT\s*$/ );
662                     push @{ $args{'content'} }, $l . "\n";
663                 }
664             } else {
665                 # if it's not content, strip leading and trailing spaces
666                 if ( $args{$tag} ) {
667                     $args{$tag} =~ s/^\s+//g;
668                     $args{$tag} =~ s/\s+$//g;
669                 }
670                 if (
671                     ($tag =~ /^(requestor|cc|admincc)(group)?$/i
672                         or grep {lc $_ eq $tag} keys %RT::Link::TYPEMAP)
673                     and $args{$tag} =~ /,/
674                 ) {
675                     $args{$tag} = [ split /,\s*/, $args{$tag} ];
676                 }
677             }
678         }
679     }
680
681     foreach my $date (qw(due starts started resolved)) {
682         my $dateobj = RT::Date->new( $self->CurrentUser );
683         next unless $args{$date};
684         if ( $args{$date} =~ /^\d+$/ ) {
685             $dateobj->Set( Format => 'unix', Value => $args{$date} );
686         } else {
687             eval {
688                 $dateobj->Set( Format => 'iso', Value => $args{$date} );
689             };
690             if ($@ or not $dateobj->IsSet) {
691                 $dateobj->Set( Format => 'unknown', Value => $args{$date} );
692             }
693         }
694         $args{$date} = $dateobj->ISO;
695     }
696
697     foreach my $role (qw(requestor cc admincc)) {
698         next unless my $value = $args{ $role . 'group' };
699
700         my $group = RT::Group->new( $self->CurrentUser );
701         $group->LoadUserDefinedGroup( $value );
702         unless ( $group->id ) {
703             $RT::Logger->error("Couldn't load group '$value'");
704             next;
705         }
706
707         $args{ $role } = $args{ $role } ? [$args{ $role }] : []
708             unless ref $args{ $role };
709         push @{ $args{ $role } }, $group->PrincipalObj->id;
710     }
711
712     $args{'requestor'} ||= $self->TicketObj->Requestors->MemberEmailAddresses
713         if $self->TicketObj;
714
715     $args{'type'} ||= 'ticket';
716
717     my %ticketargs = (
718         Queue           => $args{'queue'},
719         Subject         => $args{'subject'},
720         Status          => $args{'status'} || 'new',
721         Due             => $args{'due'},
722         Starts          => $args{'starts'},
723         Started         => $args{'started'},
724         Resolved        => $args{'resolved'},
725         Owner           => $args{'owner'},
726         Requestor       => $args{'requestor'},
727         Cc              => $args{'cc'},
728         AdminCc         => $args{'admincc'},
729         TimeWorked      => $args{'timeworked'},
730         TimeEstimated   => $args{'timeestimated'},
731         TimeLeft        => $args{'timeleft'},
732         InitialPriority => $args{'initialpriority'} || 0,
733         FinalPriority   => $args{'finalpriority'} || 0,
734         SquelchMailTo   => $args{'squelchmailto'},
735         Type            => $args{'type'},
736     );
737
738     if ( $args{content} ) {
739         my $mimeobj = MIME::Entity->build(
740             Type    => $args{'contenttype'} || 'text/plain',
741             Charset => 'UTF-8',
742             Data    => [ map {Encode::encode( "UTF-8", $_ )} @{$args{'content'}} ],
743         );
744         $ticketargs{MIMEObj} = $mimeobj;
745         $ticketargs{UpdateType} = $args{'updatetype'} || 'correspond';
746     }
747
748     foreach my $tag ( keys(%args) ) {
749         # if the tag was added later, skip it
750         my $orig_tag = $original_tags{$tag} or next;
751         if ( $orig_tag =~ /^customfield-?(\d+)$/i ) {
752             $ticketargs{ "CustomField-" . $1 } = $args{$tag};
753         } elsif ( $orig_tag =~ /^(?:customfield|cf)-?(.+)$/i ) {
754             my $cf = RT::CustomField->new( $self->CurrentUser );
755             $cf->LoadByName(
756                 Name          => $1,
757                 LookupType    => RT::Ticket->CustomFieldLookupType,
758                 ObjectId      => $ticketargs{Queue},
759                 IncludeGlobal => 1,
760             );
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(
766                 Name          => $orig_tag,
767                 LookupType    => RT::Ticket->CustomFieldLookupType,
768                 ObjectId      => $ticketargs{Queue},
769                 IncludeGlobal => 1,
770             );
771             next unless $cf->id;
772             $ticketargs{ "CustomField-" . $cf->id } = $args{$tag};
773
774         }
775     }
776
777     $self->GetDeferred( \%args, $template_id, $links, $postponed );
778
779     return $TicketObj, \%ticketargs;
780 }
781
782
783 =head2 _ParseXSVTemplate
784
785 Parses a tab or comma delimited template. Should only ever be called by
786 L</Parse>.
787
788 =cut
789
790 sub _ParseXSVTemplate {
791     my $self = shift;
792     my %args = (@_);
793
794     use Regexp::Common qw(delimited);
795     my($first, $content) = split(/\r?\n/, $args{'Content'}, 2);
796
797     my $delimiter;
798     if ( $first =~ /\t/ ) {
799         $delimiter = "\t";
800     } else {
801         $delimiter = ',';
802     }
803     my @fields = split( /$delimiter/, $first );
804
805     my $delimiter_re = qr[$delimiter];
806     my $justquoted = qr[$RE{quoted}];
807
808     # Used to generate automatic template ids
809     my $autoid = 1;
810
811   LINE:
812     while ($content) {
813         $content =~ s/^(\s*\r?\n)+//;
814
815         # Keep track of Queue and Requestor, so we can provide defaults
816         my $queue;
817         my $requestor;
818
819         # The template for this line
820         my $template;
821
822         # What column we're on
823         my $i = 0;
824
825         # If the last iteration was the end of the line
826         my $EOL = 0;
827
828         # The template id
829         my $template_id;
830
831       COLUMN:
832         while (not $EOL and length $content and $content =~ s/^($justquoted|.*?)($delimiter_re|$)//smix) {
833             $EOL = not $2;
834
835             # Strip off quotes, if they exist
836             my $value = $1;
837             if ( $value =~ /^$RE{delimited}{-delim=>qq{\'\"}}$/ ) {
838                 substr( $value, 0,  1 ) = "";
839                 substr( $value, -1, 1 ) = "";
840             }
841
842             # What column is this?
843             my $field = $fields[$i++];
844             next COLUMN unless $field =~ /\S/;
845             $field =~ s/^\s//;
846             $field =~ s/\s$//;
847
848             if ( $field =~ /^id$/i ) {
849                 # Special case if this is the ID column
850                 if ( $value =~ /^\d+$/ ) {
851                     $template_id = 'update-' . $value;
852                     push @{ $self->{'update_tickets'} }, $template_id;
853                 } elsif ( $value =~ /^#base-(\d+)$/ ) {
854                     $template_id = 'base-' . $1;
855                     push @{ $self->{'base_tickets'} }, $template_id;
856                 } elsif ( $value =~ /\S/ ) {
857                     $template_id = 'create-' . $value;
858                     push @{ $self->{'create_tickets'} }, $template_id;
859                 }
860             } else {
861                 # Some translations
862                 if (   $field =~ /^Body$/i
863                     || $field =~ /^Data$/i
864                     || $field =~ /^Message$/i )
865                   {
866                   $field = 'Content';
867                 } elsif ( $field =~ /^Summary$/i ) {
868                     $field = 'Subject';
869                 } elsif ( $field =~ /^Queue$/i ) {
870                     # Note that we found a queue
871                     $queue = 1;
872                     $value ||= $args{'Queue'};
873                 } elsif ( $field =~ /^Requestors?$/i ) {
874                     $field = 'Requestor'; # Remove plural
875                     # Note that we found a requestor
876                     $requestor = 1;
877                     $value ||= $args{'Requestor'};
878                 }
879
880                 # Tack onto the end of the template
881                 $template .= $field . ": ";
882                 $template .= (defined $value ? $value : "");
883                 $template .= "\n";
884                 $template .= "ENDOFCONTENT\n"
885                   if $field =~ /^Content$/i;
886             }
887         }
888
889         # Ignore blank lines
890         next unless $template;
891         
892         # If we didn't find a queue of requestor, tack on the defaults
893         if ( !$queue && $args{'Queue'} ) {
894             $template .= "Queue: $args{'Queue'}\n";
895         }
896         if ( !$requestor && $args{'Requestor'} ) {
897             $template .= "Requestor: $args{'Requestor'}\n";
898         }
899
900         # If we never found an ID, come up with one
901         unless ($template_id) {
902             $autoid++ while exists $self->{'templates'}->{"create-auto-$autoid"};
903             $template_id = "create-auto-$autoid";
904             # Also, it's a ticket to create
905             push @{ $self->{'create_tickets'} }, $template_id;
906         }
907         
908         # Save the template we generated
909         $self->{'templates'}->{$template_id} = $template;
910
911     }
912 }
913
914 sub GetDeferred {
915     my $self      = shift;
916     my $args      = shift;
917     my $id        = shift;
918     my $links     = shift;
919     my $postponed = shift;
920
921     # Deferred processing
922     push @$links,
923         (
924         $id,
925         {   DependsOn    => $args->{'dependson'},
926             DependedOnBy => $args->{'dependedonby'},
927             RefersTo     => $args->{'refersto'},
928             ReferredToBy => $args->{'referredtoby'},
929             Children     => $args->{'children'},
930             Parents      => $args->{'parents'},
931         }
932         );
933
934     push @$postponed, (
935
936         # Status is postponed so we don't violate dependencies
937         $id, { Status => $args->{'status'}, }
938     );
939 }
940
941 sub GetUpdateTemplate {
942     my $self = shift;
943     my $t    = shift;
944
945     my $string;
946     $string .= "Queue: " . $t->QueueObj->Name . "\n";
947     $string .= "Subject: " . $t->Subject . "\n";
948     $string .= "Status: " . $t->Status . "\n";
949     $string .= "UpdateType: correspond\n";
950     $string .= "Content: \n";
951     $string .= "ENDOFCONTENT\n";
952     $string .= "Due: " . $t->DueObj->AsString . "\n";
953     $string .= "Starts: " . $t->StartsObj->AsString . "\n";
954     $string .= "Started: " . $t->StartedObj->AsString . "\n";
955     $string .= "Resolved: " . $t->ResolvedObj->AsString . "\n";
956     $string .= "Owner: " . $t->OwnerObj->Name . "\n";
957     $string .= "Requestor: " . $t->RequestorAddresses . "\n";
958     $string .= "Cc: " . $t->CcAddresses . "\n";
959     $string .= "AdminCc: " . $t->AdminCcAddresses . "\n";
960     $string .= "TimeWorked: " . $t->TimeWorked . "\n";
961     $string .= "TimeEstimated: " . $t->TimeEstimated . "\n";
962     $string .= "TimeLeft: " . $t->TimeLeft . "\n";
963     $string .= "InitialPriority: " . $t->Priority . "\n";
964     $string .= "FinalPriority: " . $t->FinalPriority . "\n";
965
966     foreach my $type ( RT::Link->DisplayTypes ) {
967         $string .= "$type: ";
968
969         my $mode   = $RT::Link::TYPEMAP{$type}->{Mode};
970         my $method = $RT::Link::TYPEMAP{$type}->{Type};
971
972         my $links = '';
973         while ( my $link = $t->$method->Next ) {
974             $links .= ", " if $links;
975
976             my $object = $mode . "Obj";
977             my $member = $link->$object;
978             $links .= $member->Id if $member;
979         }
980         $string .= $links;
981         $string .= "\n";
982     }
983
984     return $string;
985 }
986
987 sub GetBaseTemplate {
988     my $self = shift;
989     my $t    = shift;
990
991     my $string;
992     $string .= "Queue: " . $t->Queue . "\n";
993     $string .= "Subject: " . $t->Subject . "\n";
994     $string .= "Status: " . $t->Status . "\n";
995     $string .= "Due: " . $t->DueObj->Unix . "\n";
996     $string .= "Starts: " . $t->StartsObj->Unix . "\n";
997     $string .= "Started: " . $t->StartedObj->Unix . "\n";
998     $string .= "Resolved: " . $t->ResolvedObj->Unix . "\n";
999     $string .= "Owner: " . $t->Owner . "\n";
1000     $string .= "Requestor: " . $t->RequestorAddresses . "\n";
1001     $string .= "Cc: " . $t->CcAddresses . "\n";
1002     $string .= "AdminCc: " . $t->AdminCcAddresses . "\n";
1003     $string .= "TimeWorked: " . $t->TimeWorked . "\n";
1004     $string .= "TimeEstimated: " . $t->TimeEstimated . "\n";
1005     $string .= "TimeLeft: " . $t->TimeLeft . "\n";
1006     $string .= "InitialPriority: " . $t->Priority . "\n";
1007     $string .= "FinalPriority: " . $t->FinalPriority . "\n";
1008
1009     return $string;
1010 }
1011
1012 sub GetCreateTemplate {
1013     my $self = shift;
1014
1015     my $string;
1016
1017     $string .= "Queue: General\n";
1018     $string .= "Subject: \n";
1019     $string .= "Status: new\n";
1020     $string .= "Content: \n";
1021     $string .= "ENDOFCONTENT\n";
1022     $string .= "Due: \n";
1023     $string .= "Starts: \n";
1024     $string .= "Started: \n";
1025     $string .= "Resolved: \n";
1026     $string .= "Owner: \n";
1027     $string .= "Requestor: \n";
1028     $string .= "Cc: \n";
1029     $string .= "AdminCc:\n";
1030     $string .= "TimeWorked: \n";
1031     $string .= "TimeEstimated: \n";
1032     $string .= "TimeLeft: \n";
1033     $string .= "InitialPriority: \n";
1034     $string .= "FinalPriority: \n";
1035
1036     foreach my $type ( RT::Link->DisplayTypes ) {
1037         $string .= "$type: \n";
1038     }
1039     return $string;
1040 }
1041
1042 sub UpdateWatchers {
1043     my $self   = shift;
1044     my $ticket = shift;
1045     my $args   = shift;
1046
1047     my @results;
1048
1049     foreach my $type (qw(Requestor Cc AdminCc)) {
1050         my $method  = $type . 'Addresses';
1051         my $oldaddr = $ticket->$method;
1052
1053         # Skip unless we have a defined field
1054         next unless defined $args->{$type};
1055         my $newaddr = $args->{$type};
1056
1057         my @old = split( /,\s*/, $oldaddr );
1058         my @new;
1059         for (ref $newaddr ? @{$newaddr} : split( /,\s*/, $newaddr )) {
1060             # Sometimes these are email addresses, sometimes they're
1061             # users.  Try to guess which is which, as we want to deal
1062             # with email addresses if at all possible.
1063             if (/^\S+@\S+$/) {
1064                 push @new, $_;
1065             } else {
1066                 # It doesn't look like an email address.  Try to load it.
1067                 my $user = RT::User->new($self->CurrentUser);
1068                 $user->Load($_);
1069                 if ($user->Id) {
1070                     push @new, $user->EmailAddress;
1071                 } else {
1072                     push @new, $_;
1073                 }
1074             }
1075         }
1076
1077         my %oldhash = map { $_ => 1 } @old;
1078         my %newhash = map { $_ => 1 } @new;
1079
1080         my @add    = grep( !defined $oldhash{$_}, @new );
1081         my @delete = grep( !defined $newhash{$_}, @old );
1082
1083         foreach (@add) {
1084             my ( $val, $msg ) = $ticket->AddWatcher(
1085                 Type  => $type,
1086                 Email => $_
1087             );
1088
1089             push @results,
1090                 $ticket->loc( "Ticket [_1]", $ticket->Id ) . ': ' . $msg;
1091         }
1092
1093         foreach (@delete) {
1094             my ( $val, $msg ) = $ticket->DeleteWatcher(
1095                 Type  => $type,
1096                 Email => $_
1097             );
1098             push @results,
1099                 $ticket->loc( "Ticket [_1]", $ticket->Id ) . ': ' . $msg;
1100         }
1101     }
1102     return @results;
1103 }
1104
1105 sub UpdateCustomFields {
1106     my $self   = shift;
1107     my $ticket = shift;
1108     my $args   = shift;
1109
1110     my @results;
1111     foreach my $arg (keys %{$args}) {
1112         next unless $arg =~ /^CustomField-(\d+)$/;
1113         my $cf = $1;
1114
1115         my $CustomFieldObj = RT::CustomField->new($self->CurrentUser);
1116         $CustomFieldObj->SetContextObject( $ticket );
1117         $CustomFieldObj->LoadById($cf);
1118
1119         my @values;
1120         if ($CustomFieldObj->Type =~ /text/i) { # Both Text and Wikitext
1121             @values = ($args->{$arg});
1122         } else {
1123             @values = split /\n/, $args->{$arg};
1124         }
1125         
1126         if ( ($CustomFieldObj->Type eq 'Freeform' 
1127               && ! $CustomFieldObj->SingleValue) ||
1128               $CustomFieldObj->Type =~ /text/i) {
1129             foreach my $val (@values) {
1130                 $val =~ s/\r//g;
1131             }
1132         }
1133
1134         foreach my $value (@values) {
1135             next unless length($value);
1136             my ( $val, $msg ) = $ticket->AddCustomFieldValue(
1137                 Field => $cf,
1138                 Value => $value
1139             );
1140             push ( @results, $msg );
1141         }
1142     }
1143     return @results;
1144 }
1145
1146 sub PostProcess {
1147     my $self      = shift;
1148     my $links     = shift;
1149     my $postponed = shift;
1150
1151     # postprocessing: add links
1152
1153     while ( my $template_id = shift(@$links) ) {
1154         my $ticket = $T::Tickets{$template_id};
1155         $RT::Logger->debug( "Handling links for " . $ticket->Id );
1156         my %args = %{ shift(@$links) };
1157
1158         foreach my $type ( keys %RT::Link::TYPEMAP ) {
1159             next unless ( defined $args{$type} );
1160             foreach my $link (
1161                 ref( $args{$type} ) ? @{ $args{$type} } : ( $args{$type} ) )
1162             {
1163                 next unless $link;
1164
1165                 if ( $link =~ /^TOP$/i ) {
1166                     $RT::Logger->debug( "Building $type link for $link: "
1167                             . $T::Tickets{TOP}->Id );
1168                     $link = $T::Tickets{TOP}->Id;
1169
1170                 } elsif ( $link !~ m/^\d+$/ ) {
1171                     my $key = "create-$link";
1172                     if ( !exists $T::Tickets{$key} ) {
1173                         $RT::Logger->debug(
1174                             "Skipping $type link for $key (non-existent)");
1175                         next;
1176                     }
1177                     $RT::Logger->debug( "Building $type link for $link: "
1178                             . $T::Tickets{$key}->Id );
1179                     $link = $T::Tickets{$key}->Id;
1180                 } else {
1181                     $RT::Logger->debug("Building $type link for $link");
1182                 }
1183
1184                 my ( $wval, $wmsg ) = $ticket->AddLink(
1185                     Type => $RT::Link::TYPEMAP{$type}->{'Type'},
1186                     $RT::Link::TYPEMAP{$type}->{'Mode'} => $link,
1187                     Silent                        => 1
1188                 );
1189
1190                 $RT::Logger->warning("AddLink thru $link failed: $wmsg")
1191                     unless $wval;
1192
1193                 # push @non_fatal_errors, $wmsg unless ($wval);
1194             }
1195
1196         }
1197     }
1198
1199     # postponed actions -- Status only, currently
1200     while ( my $template_id = shift(@$postponed) ) {
1201         my $ticket = $T::Tickets{$template_id};
1202         $RT::Logger->debug( "Handling postponed actions for " . $ticket->id );
1203         my %args = %{ shift(@$postponed) };
1204         $ticket->SetStatus( $args{Status} ) if defined $args{Status};
1205     }
1206
1207 }
1208
1209 RT::Base->_ImportOverlays();
1210
1211 1;
1212