rt/lib/RT/Action/CreateTickets.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2015 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         $self->Rules
 737     );
 738
 739     if ( $args{content} ) {
 740         my $mimeobj = MIME::Entity->build(
 741             Type    => $args{'contenttype'} || 'text/plain',
 742             Charset => 'UTF-8',
 743             Data    => [ map {Encode::encode( "UTF-8", $_ )} @{$args{'content'}} ],
 744         );
 745         $ticketargs{MIMEObj} = $mimeobj;
 746         $ticketargs{UpdateType} = $args{'updatetype'} || 'correspond';
 747     }
 748
 749     foreach my $tag ( keys(%args) ) {
 750         # if the tag was added later, skip it
 751         my $orig_tag = $original_tags{$tag} or next;
 752         if ( $orig_tag =~ /^customfield-?(\d+)$/i ) {
 753             $ticketargs{ "CustomField-" . $1 } = $args{$tag};
 754         } elsif ( $orig_tag =~ /^(?:customfield|cf)-?(.+)$/i ) {
 755             my $cf = RT::CustomField->new( $self->CurrentUser );
 756             $cf->LoadByName(
 757                 Name          => $1,
 758                 LookupType    => RT::Ticket->CustomFieldLookupType,
 759                 ObjectId      => $ticketargs{Queue},
 760                 IncludeGlobal => 1,
 761             );
 762             next unless $cf->id;
 763             $ticketargs{ "CustomField-" . $cf->id } = $args{$tag};
 764         } elsif ($orig_tag) {
 765             my $cf = RT::CustomField->new( $self->CurrentUser );
 766             $cf->LoadByName(
 767                 Name          => $orig_tag,
 768                 LookupType    => RT::Ticket->CustomFieldLookupType,
 769                 ObjectId      => $ticketargs{Queue},
 770                 IncludeGlobal => 1,
 771             );
 772             next unless $cf->id;
 773             $ticketargs{ "CustomField-" . $cf->id } = $args{$tag};
 774
 775         }
 776     }
 777
 778     $self->GetDeferred( \%args, $template_id, $links, $postponed );
 779
 780     return $TicketObj, \%ticketargs;
 781 }
 782
 783
 784 =head2 _ParseXSVTemplate
 785
 786 Parses a tab or comma delimited template. Should only ever be called by
 787 L</Parse>.
 788
 789 =cut
 790
 791 sub _ParseXSVTemplate {
 792     my $self = shift;
 793     my %args = (@_);
 794
 795     use Regexp::Common qw(delimited);
 796     my($first, $content) = split(/\r?\n/, $args{'Content'}, 2);
 797
 798     my $delimiter;
 799     if ( $first =~ /\t/ ) {
 800         $delimiter = "\t";
 801     } else {
 802         $delimiter = ',';
 803     }
 804     my @fields = split( /$delimiter/, $first );
 805
 806     my $delimiter_re = qr[$delimiter];
 807     my $justquoted = qr[$RE{quoted}];
 808
 809     # Used to generate automatic template ids
 810     my $autoid = 1;
 811
 812   LINE:
 813     while ($content) {
 814         $content =~ s/^(\s*\r?\n)+//;
 815
 816         # Keep track of Queue and Requestor, so we can provide defaults
 817         my $queue;
 818         my $requestor;
 819
 820         # The template for this line
 821         my $template;
 822
 823         # What column we're on
 824         my $i = 0;
 825
 826         # If the last iteration was the end of the line
 827         my $EOL = 0;
 828
 829         # The template id
 830         my $template_id;
 831
 832       COLUMN:
 833         while (not $EOL and length $content and $content =~ s/^($justquoted|.*?)($delimiter_re|$)//smix) {
 834             $EOL = not $2;
 835
 836             # Strip off quotes, if they exist
 837             my $value = $1;
 838             if ( $value =~ /^$RE{delimited}{-delim=>qq{\'\"}}$/ ) {
 839                 substr( $value, 0,  1 ) = "";
 840                 substr( $value, -1, 1 ) = "";
 841             }
 842
 843             # What column is this?
 844             my $field = $fields[$i++];
 845             next COLUMN unless $field =~ /\S/;
 846             $field =~ s/^\s//;
 847             $field =~ s/\s$//;
 848
 849             if ( $field =~ /^id$/i ) {
 850                 # Special case if this is the ID column
 851                 if ( $value =~ /^\d+$/ ) {
 852                     $template_id = 'update-' . $value;
 853                     push @{ $self->{'update_tickets'} }, $template_id;
 854                 } elsif ( $value =~ /^#base-(\d+)$/ ) {
 855                     $template_id = 'base-' . $1;
 856                     push @{ $self->{'base_tickets'} }, $template_id;
 857                 } elsif ( $value =~ /\S/ ) {
 858                     $template_id = 'create-' . $value;
 859                     push @{ $self->{'create_tickets'} }, $template_id;
 860                 }
 861             } else {
 862                 # Some translations
 863                 if (   $field =~ /^Body$/i
 864                     || $field =~ /^Data$/i
 865                     || $field =~ /^Message$/i )
 866                   {
 867                   $field = 'Content';
 868                 } elsif ( $field =~ /^Summary$/i ) {
 869                     $field = 'Subject';
 870                 } elsif ( $field =~ /^Queue$/i ) {
 871                     # Note that we found a queue
 872                     $queue = 1;
 873                     $value ||= $args{'Queue'};
 874                 } elsif ( $field =~ /^Requestors?$/i ) {
 875                     $field = 'Requestor'; # Remove plural
 876                     # Note that we found a requestor
 877                     $requestor = 1;
 878                     $value ||= $args{'Requestor'};
 879                 }
 880
 881                 # Tack onto the end of the template
 882                 $template .= $field . ": ";
 883                 $template .= (defined $value ? $value : "");
 884                 $template .= "\n";
 885                 $template .= "ENDOFCONTENT\n"
 886                   if $field =~ /^Content$/i;
 887             }
 888         }
 889
 890         # Ignore blank lines
 891         next unless $template;
 892
 893         # If we didn't find a queue of requestor, tack on the defaults
 894         if ( !$queue && $args{'Queue'} ) {
 895             $template .= "Queue: $args{'Queue'}\n";
 896         }
 897         if ( !$requestor && $args{'Requestor'} ) {
 898             $template .= "Requestor: $args{'Requestor'}\n";
 899         }
 900
 901         # If we never found an ID, come up with one
 902         unless ($template_id) {
 903             $autoid++ while exists $self->{'templates'}->{"create-auto-$autoid"};
 904             $template_id = "create-auto-$autoid";
 905             # Also, it's a ticket to create
 906             push @{ $self->{'create_tickets'} }, $template_id;
 907         }
 908
 909         # Save the template we generated
 910         $self->{'templates'}->{$template_id} = $template;
 911
 912     }
 913 }
 914
 915 sub GetDeferred {
 916     my $self      = shift;
 917     my $args      = shift;
 918     my $id        = shift;
 919     my $links     = shift;
 920     my $postponed = shift;
 921
 922     # Unify the aliases for child/parent
 923     $args->{$_} = [$args->{$_}]
 924         for grep {$args->{$_} and not ref $args->{$_}} qw/members hasmember memberof/;
 925     push @{$args->{'children'}}, @{delete $args->{'members'}}   if $args->{'members'};
 926     push @{$args->{'children'}}, @{delete $args->{'hasmember'}} if $args->{'hasmember'};
 927     push @{$args->{'parents'}},  @{delete $args->{'memberof'}}  if $args->{'memberof'};
 928
 929     # Deferred processing
 930     push @$links,
 931         (
 932         $id,
 933         {   DependsOn    => $args->{'dependson'},
 934             DependedOnBy => $args->{'dependedonby'},
 935             RefersTo     => $args->{'refersto'},
 936             ReferredToBy => $args->{'referredtoby'},
 937             Children     => $args->{'children'},
 938             Parents      => $args->{'parents'},
 939         }
 940         );
 941
 942     push @$postponed, (
 943
 944         # Status is postponed so we don't violate dependencies
 945         $id, { Status => $args->{'status'}, }
 946     );
 947 }
 948
 949 sub GetUpdateTemplate {
 950     my $self = shift;
 951     my $t    = shift;
 952
 953     my $string;
 954     $string .= "Queue: " . $t->QueueObj->Name . "\n";
 955     $string .= "Subject: " . $t->Subject . "\n";
 956     $string .= "Status: " . $t->Status . "\n";
 957     $string .= "UpdateType: correspond\n";
 958     $string .= "Content: \n";
 959     $string .= "ENDOFCONTENT\n";
 960     $string .= "Due: " . $t->DueObj->AsString . "\n";
 961     $string .= "Starts: " . $t->StartsObj->AsString . "\n";
 962     $string .= "Started: " . $t->StartedObj->AsString . "\n";
 963     $string .= "Resolved: " . $t->ResolvedObj->AsString . "\n";
 964     $string .= "Owner: " . $t->OwnerObj->Name . "\n";
 965     $string .= "Requestor: " . $t->RequestorAddresses . "\n";
 966     $string .= "Cc: " . $t->CcAddresses . "\n";
 967     $string .= "AdminCc: " . $t->AdminCcAddresses . "\n";
 968     $string .= "TimeWorked: " . $t->TimeWorked . "\n";
 969     $string .= "TimeEstimated: " . $t->TimeEstimated . "\n";
 970     $string .= "TimeLeft: " . $t->TimeLeft . "\n";
 971     $string .= "InitialPriority: " . $t->Priority . "\n";
 972     $string .= "FinalPriority: " . $t->FinalPriority . "\n";
 973
 974     foreach my $type ( RT::Link->DisplayTypes ) {
 975         $string .= "$type: ";
 976
 977         my $mode   = $RT::Link::TYPEMAP{$type}->{Mode};
 978         my $method = $RT::Link::TYPEMAP{$type}->{Type};
 979
 980         my $links = '';
 981         while ( my $link = $t->$method->Next ) {
 982             $links .= ", " if $links;
 983
 984             my $object = $mode . "Obj";
 985             my $member = $link->$object;
 986             $links .= $member->Id if $member;
 987         }
 988         $string .= $links;
 989         $string .= "\n";
 990     }
 991
 992     return $string;
 993 }
 994
 995 sub GetBaseTemplate {
 996     my $self = shift;
 997     my $t    = shift;
 998
 999     my $string;
1000     $string .= "Queue: " . $t->Queue . "\n";
1001     $string .= "Subject: " . $t->Subject . "\n";
1002     $string .= "Status: " . $t->Status . "\n";
1003     $string .= "Due: " . $t->DueObj->Unix . "\n";
1004     $string .= "Starts: " . $t->StartsObj->Unix . "\n";
1005     $string .= "Started: " . $t->StartedObj->Unix . "\n";
1006     $string .= "Resolved: " . $t->ResolvedObj->Unix . "\n";
1007     $string .= "Owner: " . $t->Owner . "\n";
1008     $string .= "Requestor: " . $t->RequestorAddresses . "\n";
1009     $string .= "Cc: " . $t->CcAddresses . "\n";
1010     $string .= "AdminCc: " . $t->AdminCcAddresses . "\n";
1011     $string .= "TimeWorked: " . $t->TimeWorked . "\n";
1012     $string .= "TimeEstimated: " . $t->TimeEstimated . "\n";
1013     $string .= "TimeLeft: " . $t->TimeLeft . "\n";
1014     $string .= "InitialPriority: " . $t->Priority . "\n";
1015     $string .= "FinalPriority: " . $t->FinalPriority . "\n";
1016
1017     return $string;
1018 }
1019
1020 sub GetCreateTemplate {
1021     my $self = shift;
1022
1023     my $string;
1024
1025     $string .= "Queue: General\n";
1026     $string .= "Subject: \n";
1027     $string .= "Status: new\n";
1028     $string .= "Content: \n";
1029     $string .= "ENDOFCONTENT\n";
1030     $string .= "Due: \n";
1031     $string .= "Starts: \n";
1032     $string .= "Started: \n";
1033     $string .= "Resolved: \n";
1034     $string .= "Owner: \n";
1035     $string .= "Requestor: \n";
1036     $string .= "Cc: \n";
1037     $string .= "AdminCc:\n";
1038     $string .= "TimeWorked: \n";
1039     $string .= "TimeEstimated: \n";
1040     $string .= "TimeLeft: \n";
1041     $string .= "InitialPriority: \n";
1042     $string .= "FinalPriority: \n";
1043
1044     foreach my $type ( RT::Link->DisplayTypes ) {
1045         $string .= "$type: \n";
1046     }
1047     return $string;
1048 }
1049
1050 sub UpdateWatchers {
1051     my $self   = shift;
1052     my $ticket = shift;
1053     my $args   = shift;
1054
1055     my @results;
1056
1057     foreach my $type (qw(Requestor Cc AdminCc)) {
1058         my $method  = $type . 'Addresses';
1059         my $oldaddr = $ticket->$method;
1060
1061         # Skip unless we have a defined field
1062         next unless defined $args->{$type};
1063         my $newaddr = $args->{$type};
1064
1065         my @old = split( /,\s*/, $oldaddr );
1066         my @new;
1067         for (ref $newaddr ? @{$newaddr} : split( /,\s*/, $newaddr )) {
1068             # Sometimes these are email addresses, sometimes they're
1069             # users.  Try to guess which is which, as we want to deal
1070             # with email addresses if at all possible.
1071             if (/^\S+@\S+$/) {
1072                 push @new, $_;
1073             } else {
1074                 # It doesn't look like an email address.  Try to load it.
1075                 my $user = RT::User->new($self->CurrentUser);
1076                 $user->Load($_);
1077                 if ($user->Id) {
1078                     push @new, $user->EmailAddress;
1079                 } else {
1080                     push @new, $_;
1081                 }
1082             }
1083         }
1084
1085         my %oldhash = map { $_ => 1 } @old;
1086         my %newhash = map { $_ => 1 } @new;
1087
1088         my @add    = grep( !defined $oldhash{$_}, @new );
1089         my @delete = grep( !defined $newhash{$_}, @old );
1090
1091         foreach (@add) {
1092             my ( $val, $msg ) = $ticket->AddWatcher(
1093                 Type  => $type,
1094                 Email => $_
1095             );
1096
1097             push @results,
1098                 $ticket->loc( "Ticket [_1]", $ticket->Id ) . ': ' . $msg;
1099         }
1100
1101         foreach (@delete) {
1102             my ( $val, $msg ) = $ticket->DeleteWatcher(
1103                 Type  => $type,
1104                 Email => $_
1105             );
1106             push @results,
1107                 $ticket->loc( "Ticket [_1]", $ticket->Id ) . ': ' . $msg;
1108         }
1109     }
1110     return @results;
1111 }
1112
1113 sub UpdateCustomFields {
1114     my $self   = shift;
1115     my $ticket = shift;
1116     my $args   = shift;
1117
1118     my @results;
1119     foreach my $arg (keys %{$args}) {
1120         next unless $arg =~ /^CustomField-(\d+)$/;
1121         my $cf = $1;
1122
1123         my $CustomFieldObj = RT::CustomField->new($self->CurrentUser);
1124         $CustomFieldObj->SetContextObject( $ticket );
1125         $CustomFieldObj->LoadById($cf);
1126
1127         my @values;
1128         if ($CustomFieldObj->Type =~ /text/i) { # Both Text and Wikitext
1129             @values = ($args->{$arg});
1130         } else {
1131             @values = split /\n/, $args->{$arg};
1132         }
1133
1134         if ( ($CustomFieldObj->Type eq 'Freeform'
1135               && ! $CustomFieldObj->SingleValue) ||
1136               $CustomFieldObj->Type =~ /text/i) {
1137             foreach my $val (@values) {
1138                 $val =~ s/\r//g;
1139             }
1140         }
1141
1142         foreach my $value (@values) {
1143             next unless length($value);
1144             my ( $val, $msg ) = $ticket->AddCustomFieldValue(
1145                 Field => $cf,
1146                 Value => $value
1147             );
1148             push ( @results, $msg );
1149         }
1150     }
1151     return @results;
1152 }
1153
1154 sub PostProcess {
1155     my $self      = shift;
1156     my $links     = shift;
1157     my $postponed = shift;
1158
1159     # postprocessing: add links
1160
1161     while ( my $template_id = shift(@$links) ) {
1162         my $ticket = $T::Tickets{$template_id};
1163         $RT::Logger->debug( "Handling links for " . $ticket->Id );
1164         my %args = %{ shift(@$links) };
1165
1166         foreach my $type ( keys %RT::Link::TYPEMAP ) {
1167             next unless ( defined $args{$type} );
1168             foreach my $link (
1169                 ref( $args{$type} ) ? @{ $args{$type} } : ( $args{$type} ) )
1170             {
1171                 next unless $link;
1172
1173                 if ( $link =~ /^TOP$/i ) {
1174                     $RT::Logger->debug( "Building $type link for $link: "
1175                             . $T::Tickets{TOP}->Id );
1176                     $link = $T::Tickets{TOP}->Id;
1177
1178                 } elsif ( $link !~ m/^\d+$/ ) {
1179                     my $key = "create-$link";
1180                     if ( !exists $T::Tickets{$key} ) {
1181                         $RT::Logger->debug(
1182                             "Skipping $type link for $key (non-existent)");
1183                         next;
1184                     }
1185                     $RT::Logger->debug( "Building $type link for $link: "
1186                             . $T::Tickets{$key}->Id );
1187                     $link = $T::Tickets{$key}->Id;
1188                 } else {
1189                     $RT::Logger->debug("Building $type link for $link");
1190                 }
1191
1192                 my ( $wval, $wmsg ) = $ticket->AddLink(
1193                     Type => $RT::Link::TYPEMAP{$type}->{'Type'},
1194                     $RT::Link::TYPEMAP{$type}->{'Mode'} => $link,
1195                     Silent                        => 1
1196                 );
1197
1198                 $RT::Logger->warning("AddLink thru $link failed: $wmsg")
1199                     unless $wval;
1200
1201                 # push @non_fatal_errors, $wmsg unless ($wval);
1202             }
1203
1204         }
1205     }
1206
1207     # postponed actions -- Status only, currently
1208     while ( my $template_id = shift(@$postponed) ) {
1209         my $ticket = $T::Tickets{$template_id};
1210         $RT::Logger->debug( "Handling postponed actions for " . $ticket->id );
1211         my %args = %{ shift(@$postponed) };
1212         $ticket->SetStatus( $args{Status} ) if defined $args{Status};
1213     }
1214
1215 }
1216
1217 sub Options {
1218   my $self = shift;
1219   my $queues = RT::Queues->new($self->CurrentUser);
1220   $queues->UnLimit;
1221   my @names;
1222   while (my $queue = $queues->Next) {
1223     push @names, $queue->Id, $queue->Name;
1224   }
1225   return (
1226     {
1227       'name'    => 'Queue',
1228       'label'   => 'In queue',
1229       'type'    => 'select',
1230       'options' => \@names
1231     }
1232   )
1233 }
1234
1235 RT::Base->_ImportOverlays();
1236
1237 1;
1238