Putting 4.2.0 on top of 4.0.17
[usit-rt.git] / lib / RT / Action / CreateTickets.pm
1 # BEGIN BPS TAGGED BLOCK {{{
2 #
3 # COPYRIGHT:
4 #
5 # This software is Copyright (c) 1996-2013 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     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
602 sub 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 );
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
676                         or grep {lc $_ eq $tag} keys %RT::Link::TYPEMAP)
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
779 =head2 _ParseXSVTemplate
780
781 Parses a tab or comma delimited template. Should only ever be called by
782 L</Parse>.
783
784 =cut
785
786 sub _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
910 sub 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
937 sub 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
962     foreach my $type ( RT::Link->DisplayTypes ) {
963         $string .= "$type: ";
964
965         my $mode   = $RT::Link::TYPEMAP{$type}->{Mode};
966         my $method = $RT::Link::TYPEMAP{$type}->{Type};
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
983 sub 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
1008 sub 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
1032     foreach my $type ( RT::Link->DisplayTypes ) {
1033         $string .= "$type: \n";
1034     }
1035     return $string;
1036 }
1037
1038 sub 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
1101 sub 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
1142 sub 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
1154         foreach my $type ( keys %RT::Link::TYPEMAP ) {
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(
1181                     Type => $RT::Link::TYPEMAP{$type}->{'Type'},
1182                     $RT::Link::TYPEMAP{$type}->{'Mode'} => $link,
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
1205 RT::Base->_ImportOverlays();
1206
1207 1;
1208