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