lib/RT/Action/CreateTickets.pm

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