rt/lib/RT/Action/CreateTickets.pm

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