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