Upgrade to 4.0.10.
[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
57 =head1 NAME
58
59 RT::Action::CreateTickets - Create one or more tickets according to an externally supplied template
60
61 =head1 SYNOPSIS
62
63  ===Create-Ticket codereview
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
72 The CreateTickets ScripAction allows you to create automated workflows in RT,
73 creating new tickets in response to actions and conditions from other
74 tickets.
75
76 =head2 Format
77
78 CreateTickets uses the RT template configured in the scrip as a template
79 for an ordered set of tickets to create. The basic format is as follows:
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
94 As shown, you can put one or more C<===Create-Ticket:> sections in
95 a template. Each C<===Create-Ticket:> section is evaluated as its own
96 L<Text::Template> object, which means that you can embed snippets
97 of Perl inside the L<Text::Template> using C<{}> delimiters, but that
98 such sections absolutely can not span a C<===Create-Ticket:> boundary.
99
100 Note that each C<Value> must come right after the C<Param> on the same
101 line. The C<Content:> param can extend over multiple lines, but the text
102 of the first line must start right after C<Content:>. Don't try to start
103 your C<Content:> section with a newline.
104
105 After each ticket is created, it's stuffed into a hash called C<%Tickets>
106 making it available during the creation of other tickets during the
107 same ScripAction. The hash key for each ticket is C<create-[identifier]>,
108 where C<[identifier]> is the value you put after C<===Create-Ticket:>.  The hash
109 is prepopulated with the ticket which triggered the ScripAction as
110 C<$Tickets{'TOP'}>. You can also access that ticket using the shorthand
111 C<TOP>.
112
113 A 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
122 A convoluted example:
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";
128
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);
133
134     my $groupid = $groups->First->Id;
135
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     );
144
145      our @admins;
146      while (my $admin = $adminccs->Next) {
147          push (@admins, $admin->EmailAddress);
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
169  Content: Your approval is requred for this ticket, too.
170  ENDOFCONTENT
171
172 As shown above, you can include a block with Perl code to set up some
173 values for the new tickets. If you want to access a variable in the
174 template section after the block, you must scope it with C<our> rather
175 than C<my>. Just as with other RT templates, you can also include
176 Perl code in the template sections using C<{}>.
177
178 =head2 Acceptable Fields
179
180 A complete list of acceptable fields:
181
182     *  Queue           => Name or id# of a queue
183        Subject         => A text string
184      ! Status          => A valid status. Defaults to 'new'
185        Due             => Dates can be specified in seconds since the epoch
186                           to be handled literally or in a semi-free textual
187                           format which RT will attempt to parse.
188        Starts          =>
189        Started         =>
190        Resolved        =>
191        Owner           => Username or id of an RT user who can and should own
192                           this ticket; forces the owner if necessary
193    +   Requestor       => Email address
194    +   Cc              => Email address
195    +   AdminCc         => Email address
196    +   RequestorGroup  => Group name
197    +   CcGroup         => Group name
198    +   AdminCcGroup    => Group name
199        TimeWorked      =>
200        TimeEstimated   =>
201        TimeLeft        =>
202        InitialPriority =>
203        FinalPriority   =>
204        Type            =>
205     +! DependsOn       =>
206     +! DependedOnBy    =>
207     +! RefersTo        =>
208     +! ReferredToBy    =>
209     +! Members         =>
210     +! MemberOf        =>
211        Content         => Content. Can extend to multiple lines. Everything
212                           within a template after a Content: header is treated
213                           as content until we hit a line containing only
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
225 Fields marked with an C<*> are required.
226
227 Fields marked with a C<+> may have multiple values, simply
228 by repeating the fieldname on a new line with an additional value.
229
230 Fields marked with a C<!> have processing postponed until after all
231 tickets in the same actions are created.  Except for C<Status>, those
232 fields can also take a ticket name within the same action (i.e.
233 the identifiers after C<===Create-Ticket:>), instead of raw ticket ID
234 numbers.
235
236 When parsed, field names are converted to lowercase and have hyphens stripped.
237 C<Refers-To>, C<RefersTo>, C<refersto>, C<refers-to> and C<r-e-f-er-s-tO> will
238 all be treated as the same thing.
239
240 =head1 METHODS
241
242 =cut
243
244 my %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.
286 sub 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
299 sub 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
336 sub 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
402 sub 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
528 =head2 Parse
529
530 Takes (in order) template content, a default queue, a default requestor, and
531 active (a boolean flag).
532
533 Parses a template in the template content, defaulting queue and requestor if
534 unspecified in the template to the values provided as arguments.
535
536 If the active flag is true, then we'll use L<Text::Template> to parse the
537 templates, allowing you to embed active Perl in your templates.
538
539 =cut
540
541 sub 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);
562     } else {
563         RT->Logger->error("Invalid Template Content (Couldn't find ===, and is not a csv/tsv template) - unable to parse: $args{Content}");
564     }
565 }
566
567 =head2 _ParseMultilineTemplate
568
569 Parses mulitline templates. Things like:
570
571  ===Create-Ticket ...
572
573 Takes the same arguments as L</Parse>.
574
575 =cut
576
577 sub _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
646 sub 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
828 =head2 _ParseXSVTemplate
829
830 Parses a tab or comma delimited template. Should only ever be called by
831 L</Parse>.
832
833 =cut
834
835 sub _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
959 sub 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
986 sub 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
1040 sub 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
1065 sub 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
1103 sub 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
1166 sub 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
1207 sub 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
1270 RT::Base->_ImportOverlays();
1271
1272 1;
1273