rt 4.2.15
[freeside.git] / rt / lib / RT / Action / CreateTickets.pm
index efd2bda..ae8b01a 100644 (file)
@@ -2,7 +2,7 @@
 #
 # COPYRIGHT:
 #
-# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2018 Best Practical Solutions, LLC
 #                                          <sales@bestpractical.com>
 #
 # (Except where explicitly superseded by other copyright notices)
@@ -53,17 +53,15 @@ use strict;
 use warnings;
 
 use MIME::Entity;
+use RT::Link;
 
 =head1 NAME
 
- RT::Action::CreateTickets
-
-Create one or more tickets according to an externally supplied template.
-
+RT::Action::CreateTickets - Create one or more tickets according to an externally supplied template
 
 =head1 SYNOPSIS
 
- ===Create-Ticket codereview
+ ===Create-Ticket: codereview
  Subject: Code review for {$Tickets{'TOP'}->Subject}
  Depended-On-By: TOP
  Content: Someone has created a ticket. you should review and approve it,
@@ -72,18 +70,14 @@ Create one or more tickets according to an externally supplied template.
 
 =head1 DESCRIPTION
 
+The CreateTickets ScripAction allows you to create automated workflows in RT,
+creating new tickets in response to actions and conditions from other
+tickets.
 
-Using the "CreateTickets" ScripAction and mandatory dependencies, RT now has 
-the ability to model complex workflow. When a ticket is created in a queue
-that has a "CreateTickets" scripaction, that ScripAction parses its "Template"
-
-
-
-=head2 FORMAT
-
-CreateTickets uses the template as a template for an ordered set of tickets 
-to create. The basic format is as follows:
+=head2 Format
 
+CreateTickets uses the RT template configured in the scrip as a template
+for an ordered set of tickets to create. The basic format is as follows:
 
  ===Create-Ticket: identifier
  Param: Value
@@ -98,19 +92,24 @@ to create. The basic format is as follows:
  Content: Blah
  ENDOFCONTENT
 
-
-Each ===Create-Ticket: section is evaluated as its own 
-Text::Template object, which means that you can embed snippets
-of perl inside the Text::Template using {} delimiters, but that 
-such sections absolutely can not span a ===Create-Ticket boundary.
-
-After each ticket is created, it's stuffed into a hash called %Tickets
-so as to be available during the creation of other tickets during the
-same ScripAction, using the key 'create-identifier', where
-C<identifier> is the id you put after C<===Create-Ticket:>.  The hash
+As shown, you can put one or more C<===Create-Ticket:> sections in
+a template. Each C<===Create-Ticket:> section is evaluated as its own
+L<Text::Template> object, which means that you can embed snippets
+of Perl inside the L<Text::Template> using C<{}> delimiters, but that
+such sections absolutely can not span a C<===Create-Ticket:> boundary.
+
+Note that each C<Value> must come right after the C<Param> on the same
+line. The C<Content:> param can extend over multiple lines, but the text
+of the first line must start right after C<Content:>. Don't try to start
+your C<Content:> section with a newline.
+
+After each ticket is created, it's stuffed into a hash called C<%Tickets>
+making it available during the creation of other tickets during the
+same ScripAction. The hash key for each ticket is C<create-[identifier]>,
+where C<[identifier]> is the value you put after C<===Create-Ticket:>.  The hash
 is prepopulated with the ticket which triggered the ScripAction as
-$Tickets{'TOP'}; you can also access that ticket using the shorthand
-TOP.
+C<$Tickets{'TOP'}>. You can also access that ticket using the shorthand
+C<TOP>.
 
 A simple example:
 
@@ -121,34 +120,32 @@ A simple example:
  so they can finish their work
  ENDOFCONTENT
 
-
-
-A convoluted example
+A convoluted example:
 
  ===Create-Ticket: approval
  { # Find out who the administrators of the group called "HR" 
    # of which the creator of this ticket is a member
     my $name = "HR";
-   
+
     my $groups = RT::Groups->new(RT->SystemUser);
     $groups->LimitToUserDefinedGroups();
-    $groups->Limit(FIELD => "Name", OPERATOR => "=", VALUE => "$name");
+    $groups->Limit(FIELD => "Name", OPERATOR => "=", VALUE => $name, CASESENSITIVE => 0);
     $groups->WithMember($TransactionObj->CreatorObj->Id);
+
     my $groupid = $groups->First->Id;
+
     my $adminccs = RT::Users->new(RT->SystemUser);
     $adminccs->WhoHaveRight(
-       Right => "AdminGroup",
-       Object =>$groups->First,
-       IncludeSystemRights => undef,
-       IncludeSuperusers => 0,
-       IncludeSubgroupMembers => 0,
+        Right => "AdminGroup",
+        Object =>$groups->First,
+        IncludeSystemRights => undef,
+        IncludeSuperusers => 0,
+        IncludeSubgroupMembers => 0,
     );
-     my @admins;
+
+     our @admins;
      while (my $admin = $adminccs->Next) {
-         push (@admins, $admin->EmailAddress); 
+         push (@admins, $admin->EmailAddress);
      }
  }
  Queue: ___Approvals
@@ -170,50 +167,51 @@ A convoluted example
  Refers-To: {$Tickets{"create-approval"}->Id}
  Queue: ___Approvals
  Content-Type: text/plain
- Content: 
- Your approval is requred for this ticket, too.
+ Content: Your approval is requred for this ticket, too.
  ENDOFCONTENT
-=head2 Acceptable fields
 
-A complete list of acceptable fields for this beastie:
+As shown above, you can include a block with Perl code to set up some
+values for the new tickets. If you want to access a variable in the
+template section after the block, you must scope it with C<our> rather
+than C<my>. Just as with other RT templates, you can also include
+Perl code in the template sections using C<{}>.
+
+=head2 Acceptable Fields
 
+A complete list of acceptable fields:
 
     *  Queue           => Name or id# of a queue
        Subject         => A text string
-     ! Status          => A valid status. defaults to 'new'
+     ! Status          => A valid status. Defaults to 'new'
        Due             => Dates can be specified in seconds since the epoch
                           to be handled literally or in a semi-free textual
                           format which RT will attempt to parse.
-                        
-                          
-                          
-       Starts          => 
-       Started         => 
-       Resolved        => 
-       Owner           => Username or id of an RT user who can and should own 
+       Starts          =>
+       Started         =>
+       Resolved        =>
+       Owner           => Username or id of an RT user who can and should own
                           this ticket; forces the owner if necessary
    +   Requestor       => Email address
-   +   Cc              => Email address 
-   +   AdminCc         => Email address 
+   +   Cc              => Email address
+   +   AdminCc         => Email address
    +   RequestorGroup  => Group name
    +   CcGroup         => Group name
    +   AdminCcGroup    => Group name
-       TimeWorked      => 
-       TimeEstimated   => 
-       TimeLeft        => 
-       InitialPriority => 
-       FinalPriority   => 
-       Type            => 
-    +! DependsOn       => 
+       TimeWorked      =>
+       TimeEstimated   =>
+       TimeLeft        =>
+       InitialPriority =>
+       FinalPriority   =>
+       Type            =>
+    +! DependsOn       =>
     +! DependedOnBy    =>
     +! RefersTo        =>
-    +! ReferredToBy    => 
+    +! ReferredToBy    =>
     +! Members         =>
-    +! MemberOf        => 
-       Content         => content. Can extend to multiple lines. Everything
+    +! MemberOf        =>
+       Content         => Content. Can extend to multiple lines. Everything
                           within a template after a Content: header is treated
-                          as content until we hit a line containing only 
+                          as content until we hit a line containing only
                           ENDOFCONTENT
        ContentType     => the content-type of the Content field.  Defaults to
                           'text/plain'
@@ -225,75 +223,25 @@ A complete list of acceptable fields for this beastie:
        CF-name           => custom field value
        CustomField-name  => custom field value
 
-Fields marked with an * are required.
+Fields marked with an C<*> are required.
 
-Fields marked with a + may have multiple values, simply
+Fields marked with a C<+> may have multiple values, simply
 by repeating the fieldname on a new line with an additional value.
 
-Fields marked with a ! are postponed to be processed after all
-tickets in the same actions are created.  Except for 'Status', those
-field can also take a ticket name within the same action (i.e.
-the identifiers after ===Create-Ticket), instead of raw Ticket ID
+Fields marked with a C<!> have processing postponed until after all
+tickets in the same actions are created.  Except for C<Status>, those
+fields can also take a ticket name within the same action (i.e.
+the identifiers after C<===Create-Ticket:>), instead of raw ticket ID
 numbers.
 
-When parsed, field names are converted to lowercase and have -s stripped.
-Refers-To, RefersTo, refersto, refers-to and r-e-f-er-s-tO will all 
-be treated as the same thing.
-
-
-
-
-=head1 AUTHOR
-
-Jesse Vincent <jesse@bestpractical.com> 
+When parsed, field names are converted to lowercase and have hyphens stripped.
+C<Refers-To>, C<RefersTo>, C<refersto>, C<refers-to> and C<r-e-f-er-s-tO> will
+all be treated as the same thing.
 
-=head1 SEE ALSO
-
-perl(1).
+=head1 METHODS
 
 =cut
 
-my %LINKTYPEMAP = (
-    MemberOf => {
-        Type => 'MemberOf',
-        Mode => 'Target',
-    },
-    Parents => {
-        Type => 'MemberOf',
-        Mode => 'Target',
-    },
-    Members => {
-        Type => 'MemberOf',
-        Mode => 'Base',
-    },
-    Children => {
-        Type => 'MemberOf',
-        Mode => 'Base',
-    },
-    HasMember => {
-        Type => 'MemberOf',
-        Mode => 'Base',
-    },
-    RefersTo => {
-        Type => 'RefersTo',
-        Mode => 'Target',
-    },
-    ReferredToBy => {
-        Type => 'RefersTo',
-        Mode => 'Base',
-    },
-    DependsOn => {
-        Type => 'DependsOn',
-        Mode => 'Target',
-    },
-    DependedOnBy => {
-        Type => 'DependsOn',
-        Mode => 'Base',
-    },
-
-);
-
-
 #Do what we need to do and send it out.
 sub Commit {
     my $self = shift;
@@ -400,10 +348,6 @@ sub CreateByTemplate {
         }
 
         $RT::Logger->debug("Assigned $template_id with $id");
-        $T::Tickets{$template_id}->SetOriginObj( $self->TicketObj )
-            if $self->TicketObj
-            && $T::Tickets{$template_id}->can('SetOriginObj');
-
     }
 
     $self->PostProcess( \@links, \@postponed );
@@ -537,12 +481,16 @@ sub UpdateByTemplate {
     return @results;
 }
 
-=head2 Parse  TEMPLATE_CONTENT, DEFAULT_QUEUE, DEFAULT_REQEUESTOR ACTIVE
+=head2 Parse
+
+Takes (in order) template content, a default queue, a default requestor, and
+active (a boolean flag).
 
-Parse a template from TEMPLATE_CONTENT
+Parses a template in the template content, defaulting queue and requestor if
+unspecified in the template to the values provided as arguments.
 
-If $active is set to true, then we'll use Text::Template to parse the templates,
-allowing you to embed active perl in your templates.
+If the active flag is true, then we'll use L<Text::Template> to parse the
+templates, allowing you to embed active Perl in your templates.
 
 =cut
 
@@ -576,9 +524,9 @@ sub Parse {
 
 Parses mulitline templates. Things like:
 
- ===Create-Ticket ... 
+ ===Create-Ticket: ...
 
-Takes the same arguments as Parse
+Takes the same arguments as L</Parse>.
 
 =cut
 
@@ -587,15 +535,11 @@ sub _ParseMultilineTemplate {
     my %args = (@_);
 
     my $template_id;
-    require Encode;
-    require utf8;
     my ( $queue, $requestor );
         $RT::Logger->debug("Line: ===");
         foreach my $line ( split( /\n/, $args{'Content'} ) ) {
             $line =~ s/\r$//;
-            $RT::Logger->debug( "Line: " . utf8::is_utf8($line)
-                ? Encode::encode_utf8($line)
-                : $line );
+            $RT::Logger->debug( "Line: $line" );
             if ( $line =~ /^===/ ) {
                 if ( $template_id && !$queue && $args{'Queue'} ) {
                     $self->{'templates'}->{$template_id}
@@ -681,11 +625,6 @@ sub ParseLines {
 
         if ($err) {
             $RT::Logger->error( "Ticket creation failed: " . $err );
-            while ( my ( $k, $v ) = each %T::X ) {
-                $RT::Logger->debug(
-                    "Eliminating $template_id from ${k}'s parents.");
-                delete $v->{$template_id};
-            }
             next;
         }
     }
@@ -730,7 +669,7 @@ sub ParseLines {
                 }
                 if (
                     ($tag =~ /^(requestor|cc|admincc)(group)?$/i
-                        or grep {lc $_ eq $tag} keys %LINKTYPEMAP)
+                        or grep {lc $_ eq $tag} keys %RT::Link::TYPEMAP)
                     and $args{$tag} =~ /,/
                 ) {
                     $args{$tag} = [ split /,\s*/, $args{$tag} ];
@@ -748,7 +687,7 @@ sub ParseLines {
             eval {
                 $dateobj->Set( Format => 'iso', Value => $args{$date} );
             };
-            if ($@ or $dateobj->Unix <= 0) {
+            if ($@ or not $dateobj->IsSet) {
                 $dateobj->Set( Format => 'unknown', Value => $args{$date} );
             }
         }
@@ -794,14 +733,13 @@ sub ParseLines {
         FinalPriority   => $args{'finalpriority'} || 0,
         SquelchMailTo   => $args{'squelchmailto'},
         Type            => $args{'type'},
-        $self->Rules
     );
 
     if ( $args{content} ) {
-        my $mimeobj = MIME::Entity->new();
-        $mimeobj->build(
-            Type => $args{'contenttype'} || 'text/plain',
-            Data => $args{'content'}
+        my $mimeobj = MIME::Entity->build(
+            Type    => $args{'contenttype'} || 'text/plain',
+            Charset => 'UTF-8',
+            Data    => [ map {Encode::encode( "UTF-8", $_ )} @{$args{'content'}} ],
         );
         $ticketargs{MIMEObj} = $mimeobj;
         $ticketargs{UpdateType} = $args{'updatetype'} || 'correspond';
@@ -814,14 +752,22 @@ sub ParseLines {
             $ticketargs{ "CustomField-" . $1 } = $args{$tag};
         } elsif ( $orig_tag =~ /^(?:customfield|cf)-?(.+)$/i ) {
             my $cf = RT::CustomField->new( $self->CurrentUser );
-            $cf->LoadByName( Name => $1, Queue => $ticketargs{Queue} );
-            $cf->LoadByName( Name => $1, Queue => 0 ) unless $cf->id;
+            $cf->LoadByName(
+                Name          => $1,
+                LookupType    => RT::Ticket->CustomFieldLookupType,
+                ObjectId      => $ticketargs{Queue},
+                IncludeGlobal => 1,
+            );
             next unless $cf->id;
             $ticketargs{ "CustomField-" . $cf->id } = $args{$tag};
         } elsif ($orig_tag) {
             my $cf = RT::CustomField->new( $self->CurrentUser );
-            $cf->LoadByName( Name => $orig_tag, Queue => $ticketargs{Queue} );
-            $cf->LoadByName( Name => $orig_tag, Queue => 0 ) unless $cf->id;
+            $cf->LoadByName(
+                Name          => $orig_tag,
+                LookupType    => RT::Ticket->CustomFieldLookupType,
+                ObjectId      => $ticketargs{Queue},
+                IncludeGlobal => 1,
+            );
             next unless $cf->id;
             $ticketargs{ "CustomField-" . $cf->id } = $args{$tag};
 
@@ -834,9 +780,10 @@ sub ParseLines {
 }
 
 
-=head2 _ParseXSVTemplate 
+=head2 _ParseXSVTemplate
 
-Parses a tab or comma delimited template. Should only ever be called by Parse
+Parses a tab or comma delimited template. Should only ever be called by
+L</Parse>.
 
 =cut
 
@@ -971,6 +918,13 @@ sub GetDeferred {
     my $links     = shift;
     my $postponed = shift;
 
+    # Unify the aliases for child/parent
+    $args->{$_} = [$args->{$_}]
+        for grep {$args->{$_} and not ref $args->{$_}} qw/members hasmember memberof/;
+    push @{$args->{'children'}}, @{delete $args->{'members'}}   if $args->{'members'};
+    push @{$args->{'children'}}, @{delete $args->{'hasmember'}} if $args->{'hasmember'};
+    push @{$args->{'parents'}},  @{delete $args->{'memberof'}}  if $args->{'memberof'};
+
     # Deferred processing
     push @$links,
         (
@@ -1016,19 +970,11 @@ sub GetUpdateTemplate {
     $string .= "InitialPriority: " . $t->Priority . "\n";
     $string .= "FinalPriority: " . $t->FinalPriority . "\n";
 
-    foreach my $type ( sort keys %LINKTYPEMAP ) {
-
-        # don't display duplicates
-        if (   $type eq "HasMember"
-            || $type eq "Members"
-            || $type eq "MemberOf" )
-        {
-            next;
-        }
+    foreach my $type ( RT::Link->DisplayTypes ) {
         $string .= "$type: ";
 
-        my $mode   = $LINKTYPEMAP{$type}->{Mode};
-        my $method = $LINKTYPEMAP{$type}->{Type};
+        my $mode   = $RT::Link::TYPEMAP{$type}->{Mode};
+        my $method = $RT::Link::TYPEMAP{$type}->{Type};
 
         my $links = '';
         while ( my $link = $t->$method->Next ) {
@@ -1094,15 +1040,7 @@ sub GetCreateTemplate {
     $string .= "InitialPriority: \n";
     $string .= "FinalPriority: \n";
 
-    foreach my $type ( keys %LINKTYPEMAP ) {
-
-        # don't display duplicates
-        if (   $type eq "HasMember"
-            || $type eq 'Members'
-            || $type eq 'MemberOf' )
-        {
-            next;
-        }
+    foreach my $type ( RT::Link->DisplayTypes ) {
         $string .= "$type: \n";
     }
     return $string;
@@ -1201,7 +1139,10 @@ sub UpdateCustomFields {
         }
 
         foreach my $value (@values) {
-            next unless length($value);
+            next if $ticket->CustomFieldValueIsEmpty(
+                Field => $cf,
+                Value => $value,
+            );
             my ( $val, $msg ) = $ticket->AddCustomFieldValue(
                 Field => $cf,
                 Value => $value
@@ -1224,7 +1165,7 @@ sub PostProcess {
         $RT::Logger->debug( "Handling links for " . $ticket->Id );
         my %args = %{ shift(@$links) };
 
-        foreach my $type ( keys %LINKTYPEMAP ) {
+        foreach my $type ( keys %RT::Link::TYPEMAP ) {
             next unless ( defined $args{$type} );
             foreach my $link (
                 ref( $args{$type} ) ? @{ $args{$type} } : ( $args{$type} ) )
@@ -1251,8 +1192,8 @@ sub PostProcess {
                 }
 
                 my ( $wval, $wmsg ) = $ticket->AddLink(
-                    Type => $LINKTYPEMAP{$type}->{'Type'},
-                    $LINKTYPEMAP{$type}->{'Mode'} => $link,
+                    Type => $RT::Link::TYPEMAP{$type}->{'Type'},
+                    $RT::Link::TYPEMAP{$type}->{'Mode'} => $link,
                     Silent                        => 1
                 );
 
@@ -1275,24 +1216,6 @@ sub PostProcess {
 
 }
 
-sub Options {
-  my $self = shift;
-  my $queues = RT::Queues->new($self->CurrentUser);
-  $queues->UnLimit;
-  my @names;
-  while (my $queue = $queues->Next) {
-    push @names, $queue->Id, $queue->Name;
-  }
-  return (
-    {
-      'name'    => 'Queue',
-      'label'   => 'In queue',
-      'type'    => 'select',
-      'options' => \@names
-    }
-  )
-}
-
 RT::Base->_ImportOverlays();
 
 1;