rt/lib/RT/Action/CreateTickets.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2005 Best Practical Solutions, LLC
   6 #                                          <jesse@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., 675 Mass Ave, Cambridge, MA 02139, USA.
  26 #
  27 #
  28 # CONTRIBUTION SUBMISSION POLICY:
  29 #
  30 # (The following paragraph is not intended to limit the rights granted
  31 # to you to modify and distribute this software under the terms of
  32 # the GNU General Public License and is only of importance to you if
  33 # you choose to contribute your changes and enhancements to the
  34 # community by submitting them to Best Practical Solutions, LLC.)
  35 #
  36 # By intentionally submitting any modifications, corrections or
  37 # derivatives to this work, or any other work intended for use with
  38 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
  39 # you are the copyright holder for those contributions and you grant
  40 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
  41 # royalty-free, perpetual, license to use, copy, create derivative
  42 # works based on those contributions, and sublicense and distribute
  43 # those contributions and any derivatives thereof.
  44 #
  45 # END BPS TAGGED BLOCK }}}
  46 package RT::Action::CreateTickets;
  47 require RT::Action::Generic;
  48
  49 use strict;
  50 use warnings;
  51 use vars qw/@ISA/;
  52 @ISA = qw(RT::Action::Generic);
  53
  54 use MIME::Entity;
  55
  56 =head1 NAME
  57
  58  RT::Action::CreateTickets
  59
  60 Create one or more tickets according to an externally supplied template.
  61
  62
  63 =head1 SYNOPSIS
  64
  65  ===Create-Ticket codereview
  66  Subject: Code review for {$Tickets{'TOP'}->Subject}
  67  Depended-On-By: TOP
  68  Content: Someone has created a ticket. you should review and approve it,
  69  so they can finish their work
  70  ENDOFCONTENT
  71
  72 =head1 DESCRIPTION
  73
  74
  75 Using the "CreateTickets" ScripAction and mandatory dependencies, RT now has
  76 the ability to model complex workflow. When a ticket is created in a queue
  77 that has a "CreateTickets" scripaction, that ScripAction parses its "Template"
  78
  79
  80
  81 =head2 FORMAT
  82
  83 CreateTickets uses the template as a template for an ordered set of tickets
  84 to create. The basic format is as follows:
  85
  86
  87  ===Create-Ticket: identifier
  88  Param: Value
  89  Param2: Value
  90  Param3: Value
  91  Content: Blah
  92  blah
  93  blah
  94  ENDOFCONTENT
  95  ===Create-Ticket: id2
  96  Param: Value
  97  Content: Blah
  98  ENDOFCONTENT
  99
 100
 101 Each ===Create-Ticket: section is evaluated as its own
 102 Text::Template object, which means that you can embed snippets
 103 of perl inside the Text::Template using {} delimiters, but that
 104 such sections absolutely can not span a ===Create-Ticket boundary.
 105
 106 After each ticket is created, it's stuffed into a hash called %Tickets
 107 so as to be available during the creation of other tickets during the same
 108 ScripAction.  The hash is prepopulated with the ticket which triggered the
 109 ScripAction as $Tickets{'TOP'}; you can also access that ticket using the
 110 shorthand TOP.
 111
 112 A simple example:
 113
 114  ===Create-Ticket: codereview
 115  Subject: Code review for {$Tickets{'TOP'}->Subject}
 116  Depended-On-By: TOP
 117  Content: Someone has created a ticket. you should review and approve it,
 118  so they can finish their work
 119  ENDOFCONTENT
 120
 121
 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");
 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      my @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  Depended-On-By: TOP
 166  Refers-On: {$Tickets{"approval"}->Id}
 167  Queue: ___Approvals
 168  Content-Type: text/plain
 169  Content:
 170  Your approval is requred for this ticket, too.
 171  ENDOFCONTENT
 172
 173 =head2 Acceptable fields
 174
 175 A complete list of acceptable fields for this beastie:
 176
 177
 178     *  Queue           => Name or id# of a queue
 179        Subject         => A text string
 180      ! Status          => A valid status. defaults to 'new'
 181        Due             => Dates can be specified in seconds since the epoch
 182                           to be handled literally or in a semi-free textual
 183                           format which RT will attempt to parse.
 184
 185
 186
 187        Starts          =>
 188        Started         =>
 189        Resolved        =>
 190        Owner           => Username or id of an RT user who can and should own
 191                           this ticket
 192    +   Requestor       => Email address
 193    +   Cc              => Email address
 194    +   AdminCc         => Email address
 195        TimeWorked      =>
 196        TimeEstimated   =>
 197        TimeLeft        =>
 198        InitialPriority =>
 199        FinalPriority   =>
 200        Type            =>
 201     +! DependsOn       =>
 202     +! DependedOnBy    =>
 203     +! RefersTo        =>
 204     +! ReferredToBy    =>
 205     +! Members         =>
 206     +! MemberOf        =>
 207        Content         => content. Can extend to multiple lines. Everything
 208                           within a template after a Content: header is treated
 209                           as content until we hit a line containing only
 210                           ENDOFCONTENT
 211        ContentType     => the content-type of the Content field
 212        CustomField-<id#> => custom field value
 213
 214 Fields marked with an * are required.
 215
 216 Fields marked with a + may have multiple values, simply
 217 by repeating the fieldname on a new line with an additional value.
 218
 219 Fields marked with a ! are postponed to be processed after all
 220 tickets in the same actions are created.  Except for 'Status', those
 221 field can also take a ticket name within the same action (i.e.
 222 the identifiers after ==Create-Ticket), instead of raw Ticket ID
 223 numbers.
 224
 225 When parsed, field names are converted to lowercase and have -s stripped.
 226 Refers-To, RefersTo, refersto, refers-to and r-e-f-er-s-tO will all
 227 be treated as the same thing.
 228
 229
 230 =begin testing
 231
 232 ok (require RT::Action::CreateTickets);
 233 use_ok(RT::Scrip);
 234 use_ok(RT::Template);
 235 use_ok(RT::ScripAction);
 236 use_ok(RT::ScripCondition);
 237 use_ok(RT::Ticket);
 238
 239 my $approvalsq = RT::Queue->new($RT::SystemUser);
 240 $approvalsq->Create(Name => 'Approvals');
 241 ok ($approvalsq->Id, "Created Approvals test queue");
 242
 243
 244 my $approvals =
 245 '===Create-Ticket: approval
 246 Queue: ___Approvals
 247 Type: approval
 248 AdminCc: {join ("\nAdminCc: ",@admins) }
 249 Depended-On-By: {$Tickets{"TOP"}->Id}
 250 Refers-To: TOP
 251 Subject: Approval for ticket: {$Tickets{"TOP"}->Id} - {$Tickets{"TOP"}->Subject}
 252 Due: {time + 86400}
 253 Content-Type: text/plain
 254 Content: Your approval is requested for the ticket {$Tickets{"TOP"}->Id}: {$Tickets{"TOP"}->Subject}
 255 Blah
 256 Blah
 257 ENDOFCONTENT
 258 ===Create-Ticket: two
 259 Subject: Manager approval.
 260 Depended-On-By: approval
 261 Queue: ___Approvals
 262 Content-Type: text/plain
 263 Content:
 264 Your minion approved ticket {$Tickets{"TOP"}->Id}. you ok with that?
 265 ENDOFCONTENT
 266 ';
 267
 268 ok ($approvals =~ /Content/, "Read in the approvals template");
 269
 270 my $apptemp = RT::Template->new($RT::SystemUser);
 271 $apptemp->Create( Content => $approvals, Name => "Approvals", Queue => "0");
 272
 273 ok ($apptemp->Id);
 274
 275 my $q = RT::Queue->new($RT::SystemUser);
 276 $q->Create(Name => 'WorkflowTest');
 277 ok ($q->Id, "Created workflow test queue");
 278
 279 my $scrip = RT::Scrip->new($RT::SystemUser);
 280 my ($sval, $smsg) =$scrip->Create( ScripCondition => 'On Transaction',
 281                 ScripAction => 'Create Tickets',
 282                 Template => 'Approvals',
 283                 Queue => $q->Id);
 284 ok ($sval, $smsg);
 285 ok ($scrip->Id, "Created the scrip");
 286 ok ($scrip->TemplateObj->Id, "Created the scrip template");
 287 ok ($scrip->ConditionObj->Id, "Created the scrip condition");
 288 ok ($scrip->ActionObj->Id, "Created the scrip action");
 289
 290 my $t = RT::Ticket->new($RT::SystemUser);
 291 my($tid, $ttrans, $tmsg) = $t->Create(Subject => "Sample workflow test",
 292            Owner => "root",
 293            Queue => $q->Id);
 294
 295 ok ($tid,$tmsg);
 296
 297 my $deps = $t->DependsOn;
 298 is ($deps->Count, 1, "The ticket we created depends on one other ticket");
 299 my $dependson= $deps->First->TargetObj;
 300 ok ($dependson->Id, "It depends on a real ticket");
 301 unlike ($dependson->Subject, qr/{/, "The subject doesn't have braces in it. that means we're interpreting expressions");
 302 is ($t->ReferredToBy->Count,1, "It's only referred to by one other ticket");
 303 is ($t->ReferredToBy->First->BaseObj->Id,$t->DependsOn->First->TargetObj->Id, "The same ticket that depends on it refers to it.");
 304 use RT::Action::CreateTickets;
 305 my $action =  RT::Action::CreateTickets->new( CurrentUser => $RT::SystemUser);;
 306
 307 # comma-delimited templates
 308 my $commas = <<"EOF";
 309 id,Queue,Subject,Owner,Content
 310 ticket1,General,"foo, bar",root,blah
 311 ticket2,General,foo bar,root,blah
 312 ticket3,General,foo' bar,root,blah'boo
 313 ticket4,General,foo' bar,,blah'boo
 314 EOF
 315
 316
 317 # Comma delimited templates with missing data
 318 my $sparse_commas = <<"EOF";
 319 id,Queue,Subject,Owner,Requestor
 320 ticket14,General,,,bobby
 321 ticket15,General,,,tommy
 322 ticket16,General,,suzie,tommy
 323 ticket17,General,Foo "bar" baz,suzie,tommy
 324 ticket18,General,'Foo "bar" baz',suzie,tommy
 325 ticket19,General,'Foo bar' baz,suzie,tommy
 326 EOF
 327
 328
 329 # tab-delimited templates
 330 my $tabs = <<"EOF";
 331 id\tQueue\tSubject\tOwner\tContent
 332 ticket10\tGeneral\t"foo' bar"\troot\tblah'
 333 ticket11\tGeneral\tfoo, bar\troot\tblah
 334 ticket12\tGeneral\tfoo' bar\troot\tblah'boo
 335 ticket13\tGeneral\tfoo' bar\t\tblah'boo
 336 EOF
 337
 338 my %expected;
 339
 340 $expected{ticket1} = <<EOF;
 341 Queue: General
 342 Subject: foo, bar
 343 Owner: root
 344 Content: blah
 345 ENDOFCONTENT
 346 EOF
 347
 348 $expected{ticket2} = <<EOF;
 349 Queue: General
 350 Subject: foo bar
 351 Owner: root
 352 Content: blah
 353 ENDOFCONTENT
 354 EOF
 355
 356 $expected{ticket3} = <<EOF;
 357 Queue: General
 358 Subject: foo' bar
 359 Owner: root
 360 Content: blah'boo
 361 ENDOFCONTENT
 362 EOF
 363
 364 $expected{ticket4} = <<EOF;
 365 Queue: General
 366 Subject: foo' bar
 367 Owner:
 368 Content: blah'boo
 369 ENDOFCONTENT
 370 EOF
 371
 372 $expected{ticket10} = <<EOF;
 373 Queue: General
 374 Subject: foo' bar
 375 Owner: root
 376 Content: blah'
 377 ENDOFCONTENT
 378 EOF
 379
 380 $expected{ticket11} = <<EOF;
 381 Queue: General
 382 Subject: foo, bar
 383 Owner: root
 384 Content: blah
 385 ENDOFCONTENT
 386 EOF
 387
 388 $expected{ticket12} = <<EOF;
 389 Queue: General
 390 Subject: foo' bar
 391 Owner: root
 392 Content: blah'boo
 393 ENDOFCONTENT
 394 EOF
 395
 396 $expected{ticket13} = <<EOF;
 397 Queue: General
 398 Subject: foo' bar
 399 Owner:
 400 Content: blah'boo
 401 ENDOFCONTENT
 402 EOF
 403
 404
 405 $expected{'ticket14'} = <<EOF;
 406 Queue: General
 407 Subject:
 408 Owner:
 409 Requestor: bobby
 410 EOF
 411 $expected{'ticket15'} = <<EOF;
 412 Queue: General
 413 Subject:
 414 Owner:
 415 Requestor: tommy
 416 EOF
 417 $expected{'ticket16'} = <<EOF;
 418 Queue: General
 419 Subject:
 420 Owner: suzie
 421 Requestor: tommy
 422 EOF
 423 $expected{'ticket17'} = <<EOF;
 424 Queue: General
 425 Subject: Foo "bar" baz
 426 Owner: suzie
 427 Requestor: tommy
 428 EOF
 429 $expected{'ticket18'} = <<EOF;
 430 Queue: General
 431 Subject: Foo "bar" baz
 432 Owner: suzie
 433 Requestor: tommy
 434 EOF
 435 $expected{'ticket19'} = <<EOF;
 436 Queue: General
 437 Subject: 'Foo bar' baz
 438 Owner: suzie
 439 Requestor: tommy
 440 EOF
 441
 442
 443
 444
 445 $action->Parse(Content =>$commas);
 446 $action->Parse(Content =>$sparse_commas);
 447 $action->Parse(Content => $tabs);
 448
 449 my %got;
 450 foreach (@{ $action->{'create_tickets'} }) {
 451   $got{$_} = $action->{'templates'}->{$_};
 452 }
 453
 454 foreach my $id ( sort keys %expected ) {
 455     ok(exists($got{"create-$id"}), "template exists for $id");
 456     is($got{"create-$id"}, $expected{$id}, "template is correct for $id");
 457 }
 458
 459 =end testing
 460
 461
 462 =head1 AUTHOR
 463
 464 Jesse Vincent <jesse@bestpractical.com>
 465
 466 =head1 SEE ALSO
 467
 468 perl(1).
 469
 470 =cut
 471
 472 my %LINKTYPEMAP = (
 473     MemberOf => {
 474         Type => 'MemberOf',
 475         Mode => 'Target',
 476     },
 477     Parents => {
 478         Type => 'MemberOf',
 479         Mode => 'Target',
 480     },
 481     Members => {
 482         Type => 'MemberOf',
 483         Mode => 'Base',
 484     },
 485     Children => {
 486         Type => 'MemberOf',
 487         Mode => 'Base',
 488     },
 489     HasMember => {
 490         Type => 'MemberOf',
 491         Mode => 'Base',
 492     },
 493     RefersTo => {
 494         Type => 'RefersTo',
 495         Mode => 'Target',
 496     },
 497     ReferredToBy => {
 498         Type => 'RefersTo',
 499         Mode => 'Base',
 500     },
 501     DependsOn => {
 502         Type => 'DependsOn',
 503         Mode => 'Target',
 504     },
 505     DependedOnBy => {
 506         Type => 'DependsOn',
 507         Mode => 'Base',
 508     },
 509
 510 );
 511
 512 # {{{ Scrip methods (Commit, Prepare)
 513
 514 # {{{ sub Commit
 515 #Do what we need to do and send it out.
 516 sub Commit {
 517     my $self = shift;
 518
 519     # Create all the tickets we care about
 520     return (1) unless $self->TicketObj->Type eq 'ticket';
 521
 522     $self->CreateByTemplate( $self->TicketObj );
 523     $self->UpdateByTemplate( $self->TicketObj );
 524     return (1);
 525 }
 526
 527 # }}}
 528
 529 # {{{ sub Prepare
 530
 531 sub Prepare {
 532     my $self = shift;
 533
 534     unless ( $self->TemplateObj ) {
 535         $RT::Logger->warning("No template object handed to $self\n");
 536     }
 537
 538     unless ( $self->TransactionObj ) {
 539         $RT::Logger->warning("No transaction object handed to $self\n");
 540
 541     }
 542
 543     unless ( $self->TicketObj ) {
 544         $RT::Logger->warning("No ticket object handed to $self\n");
 545
 546     }
 547
 548     $self->Parse( Content => $self->TemplateObj->Content, _ActiveContent => 1);
 549     return 1;
 550
 551 }
 552
 553 # }}}
 554
 555 # }}}
 556
 557 sub CreateByTemplate {
 558     my $self = shift;
 559     my $top  = shift;
 560
 561     $RT::Logger->debug("In CreateByTemplate");
 562
 563     my @results;
 564
 565     # XXX: cargo cult programming that works. i'll be back.
 566     use bytes;
 567
 568     local %T::Tickets = %T::Tickets;
 569     local $T::TOP = $T::TOP;
 570     local $T::ID = $T::ID;
 571     $T::Tickets{'TOP'} = $T::TOP = $top if $top;
 572
 573     my $ticketargs;
 574     my ( @links, @postponed );
 575     foreach my $template_id ( @{ $self->{'create_tickets'} } ) {
 576         $RT::Logger->debug("Workflow: processing $template_id of $T::TOP")
 577           if $T::TOP;
 578
 579         $T::ID    = $template_id;
 580         @T::AllID = @{ $self->{'create_tickets'} };
 581
 582         ( $T::Tickets{$template_id}, $ticketargs ) =
 583           $self->ParseLines( $template_id, \@links, \@postponed );
 584
 585         # Now we have a %args to work with.
 586         # Make sure we have at least the minimum set of
 587         # reasonable data and do our thang
 588
 589         my ( $id, $transid, $msg ) =
 590           $T::Tickets{$template_id}->Create(%$ticketargs);
 591
 592         foreach my $res ( split( '\n', $msg ) ) {
 593             push @results,
 594               $T::Tickets{$template_id}
 595               ->loc( "Ticket [_1]", $T::Tickets{$template_id}->Id ) . ': '
 596               . $res;
 597         }
 598         if ( !$id ) {
 599             if ( $self->TicketObj ) {
 600                 $msg =
 601                     "Couldn't create related ticket $template_id for "
 602                   . $self->TicketObj->Id . " "
 603                   . $msg;
 604             }
 605             else {
 606                 $msg = "Couldn't create ticket $template_id " . $msg;
 607             }
 608
 609             $RT::Logger->error($msg);
 610             next;
 611         }
 612
 613         $RT::Logger->debug("Assigned $template_id with $id");
 614         $T::Tickets{$template_id}->SetOriginObj( $self->TicketObj )
 615           if $self->TicketObj
 616           && $T::Tickets{$template_id}->can('SetOriginObj');
 617
 618     }
 619
 620     $self->PostProcess( \@links, \@postponed );
 621
 622     return @results;
 623 }
 624
 625 sub UpdateByTemplate {
 626     my $self = shift;
 627     my $top  = shift;
 628
 629     # XXX: cargo cult programming that works. i'll be back.
 630     use bytes;
 631
 632     my @results;
 633     local %T::Tickets = %T::Tickets;
 634     local $T::ID = $T::ID;
 635
 636     my $ticketargs;
 637     my ( @links, @postponed );
 638     foreach my $template_id ( @{ $self->{'update_tickets'} } ) {
 639         $RT::Logger->debug("Update Workflow: processing $template_id");
 640
 641         $T::ID    = $template_id;
 642         @T::AllID = @{ $self->{'update_tickets'} };
 643
 644         ( $T::Tickets{$template_id}, $ticketargs ) =
 645           $self->ParseLines( $template_id, \@links, \@postponed );
 646
 647         # Now we have a %args to work with.
 648         # Make sure we have at least the minimum set of
 649         # reasonable data and do our thang
 650
 651         my @attribs = qw(
 652           Subject
 653           FinalPriority
 654           Priority
 655           TimeEstimated
 656           TimeWorked
 657           TimeLeft
 658           Status
 659           Queue
 660           Due
 661           Starts
 662           Started
 663           Resolved
 664         );
 665
 666         my $id = $template_id;
 667         $id =~ s/update-(\d+).*/$1/;
 668         $T::Tickets{$template_id}->Load($id);
 669
 670         my $msg;
 671         if ( !$T::Tickets{$template_id}->Id ) {
 672             $msg = "Couldn't update ticket $template_id " . $msg;
 673
 674             $RT::Logger->error($msg);
 675             next;
 676         }
 677
 678         my $current = $self->GetBaseTemplate( $T::Tickets{$template_id} );
 679
 680         $template_id =~ m/^update-(.*)/;
 681         my $base_id = "base-$1";
 682         my $base    = $self->{'templates'}->{$base_id};
 683         if ($base) {
 684         $base    =~ s/\r//g;
 685         $base    =~ s/\n+$//;
 686         $current =~ s/\n+$//;
 687
 688         # If we have no base template, set what we can.
 689         if ($base ne $current)  {
 690             push @results,
 691               "Could not update ticket "
 692               . $T::Tickets{$template_id}->Id
 693               . ": Ticket has changed";
 694             next;
 695         }
 696         }
 697         push @results, $T::Tickets{$template_id}->Update(
 698             AttributesRef => \@attribs,
 699             ARGSRef       => $ticketargs
 700         );
 701
 702         push @results,
 703           $self->UpdateWatchers( $T::Tickets{$template_id}, $ticketargs );
 704
 705         next unless exists $ticketargs->{'UpdateType'};
 706         if ( $ticketargs->{'UpdateType'} =~ /^(private|public)$/ ) {
 707             my ( $Transaction, $Description, $Object ) =
 708               $T::Tickets{$template_id}->Comment(
 709                 CcMessageTo  => $ticketargs->{'Cc'},
 710                 BccMessageTo => $ticketargs->{'Bcc'},
 711                 MIMEObj      => $ticketargs->{'MIMEObj'},
 712                 TimeTaken    => $ticketargs->{'TimeWorked'}
 713               );
 714             push( @results,
 715                 $T::Tickets{$template_id}
 716                   ->loc( "Ticket [_1]", $T::Tickets{$template_id}->id ) . ': '
 717                   . $Description );
 718         }
 719         elsif ( $ticketargs->{'UpdateType'} eq 'response' ) {
 720             my ( $Transaction, $Description, $Object ) =
 721               $T::Tickets{$template_id}->Correspond(
 722                 CcMessageTo  => $ticketargs->{'Cc'},
 723                 BccMessageTo => $ticketargs->{'Bcc'},
 724                 MIMEObj      => $ticketargs->{'MIMEObj'},
 725                 TimeTaken    => $ticketargs->{'TimeWorked'}
 726               );
 727             push( @results,
 728                 $T::Tickets{$template_id}
 729                   ->loc( "Ticket [_1]", $T::Tickets{$template_id}->id ) . ': '
 730                   . $Description );
 731         }
 732         else {
 733             push( @results,
 734                 $T::Tickets{$template_id}
 735                   ->loc("Update type was neither correspondence nor comment.")
 736                   . " "
 737                   . $T::Tickets{$template_id}->loc("Update not recorded.") );
 738         }
 739     }
 740
 741     $self->PostProcess( \@links, \@postponed );
 742
 743     return @results;
 744 }
 745
 746 =head2 Parse  TEMPLATE_CONTENT, DEFAULT_QUEUE, DEFAULT_REQEUESTOR ACTIVE
 747
 748 Parse a template from TEMPLATE_CONTENT
 749
 750 If $active is set to true, then we'll use Text::Template to parse the templates,
 751 allowing you to embed active perl in your templates.
 752
 753 =cut
 754
 755 sub Parse {
 756     my $self          = shift;
 757     my %args = ( Content => undef,
 758                  Queue => undef,
 759                  Requestor => undef,
 760                  _ActiveContent => undef,
 761                 @_);
 762
 763     if ($args{'_ActiveContent'}) {
 764         $self->{'UsePerlTextTemplate'} =1;
 765     } else {
 766
 767         $self->{'UsePerlTextTemplate'} = 0;
 768     }
 769
 770     my @template_order;
 771     my $template_id;
 772     my ( $queue, $requestor );
 773     if ( substr( $args{'Content'}, 0, 3 ) eq '===' ) {
 774         $RT::Logger->debug("Line: ===");
 775         foreach my $line ( split( /\n/, $args{'Content'} ) ) {
 776             $line =~ s/\r$//;
 777             $RT::Logger->debug("Line: $line");
 778             if ( $line =~ /^===/ ) {
 779                 if ( $template_id && !$queue && $args{'Queue'} ) {
 780                     $self->{'templates'}->{$template_id} .= "Queue: $args{'Queue'}\n";
 781                 }
 782                 if ( $template_id && !$requestor && $args{'Requestor'} ) {
 783                     $self->{'templates'}->{$template_id} .=
 784                       "Requestor: $args{'Requestor'}\n";
 785                 }
 786                 $queue     = 0;
 787                 $requestor = 0;
 788             }
 789             if ( $line =~ /^===Create-Ticket: (.*)$/ ) {
 790                 $template_id = "create-$1";
 791                 $RT::Logger->debug("****  Create ticket: $template_id");
 792                 push @{ $self->{'create_tickets'} }, $template_id;
 793             }
 794             elsif ( $line =~ /^===Update-Ticket: (.*)$/ ) {
 795                 $template_id = "update-$1";
 796                 $RT::Logger->debug("****  Update ticket: $template_id");
 797                 push @{ $self->{'update_tickets'} }, $template_id;
 798             }
 799             elsif ( $line =~ /^===Base-Ticket: (.*)$/ ) {
 800                 $template_id = "base-$1";
 801                 $RT::Logger->debug("****  Base ticket: $template_id");
 802                 push @{ $self->{'base_tickets'} }, $template_id;
 803             }
 804             elsif ( $line =~ /^===#.*$/ ) {    # a comment
 805                 next;
 806             }
 807             else {
 808                 if ( $line =~ /^Queue:(.*)/i ) {
 809                     $queue = 1;
 810                     my $value = $1;
 811                     $value =~ s/^\s//;
 812                     $value =~ s/\s$//;
 813                     if ( !$value && $args{'Queue'}) {
 814                         $value = $args{'Queue'};
 815                         $line  = "Queue: $value";
 816                     }
 817                 }
 818                 if ( $line =~ /^Requestor:(.*)/i ) {
 819                     $requestor = 1;
 820                     my $value = $1;
 821                     $value =~ s/^\s//;
 822                     $value =~ s/\s$//;
 823                     if ( !$value && $args{'Requestor'}) {
 824                         $value = $args{'Requestor'};
 825                         $line  = "Requestor: $value";
 826                     }
 827                 }
 828                 $self->{'templates'}->{$template_id} .= $line . "\n";
 829             }
 830         }
 831         if ( $template_id && !$queue && $args{'Queue'} ) {
 832             $self->{'templates'}->{$template_id} .= "Queue: $args{'Queue'}\n";
 833         }
 834     }
 835     elsif ( substr( $args{'Content'}, 0, 2 ) =~ /^id$/i ) {
 836         $RT::Logger->debug("Line: id");
 837         use Regexp::Common qw(delimited);
 838         my $first = substr( $args{'Content'}, 0, index( $args{'Content'}, "\n" ) );
 839         $first =~ s/\r$//;
 840
 841         my $delimiter;
 842         if ( $first =~ /\t/ ) {
 843             $delimiter = "\t";
 844         }
 845         else {
 846             $delimiter = ',';
 847         }
 848         my @fields    = split( /$delimiter/, $first );
 849
 850
 851         my $delimiter_re = qr[$delimiter];
 852
 853         my $delimited = qr[[^$delimiter]+];
 854         my $empty     = qr[^[$delimiter](?=[$delimiter])];
 855         my $justquoted = qr[$RE{quoted}];
 856
 857         $args{'Content'} = substr( $args{'Content'}, index( $args{'Content'}, "\n" ) + 1 );
 858         $RT::Logger->debug("First: $first");
 859
 860         my $queue;
 861         foreach my $line ( split( /\n/, $args{'Content'} ) ) {
 862             next unless $line;
 863             $RT::Logger->debug("Line: $line");
 864
 865             # first item is $template_id
 866             my $i = 0;
 867             my $template_id;
 868             while ($line && $line =~ s/^($justquoted|.*?)(?:$delimiter_re|$)//ix) {
 869                 if ( $i == 0 ) {
 870                     $queue     = 0;
 871                     $requestor = 0;
 872                     my $tid = $1;
 873                     $tid =~ s/^\s//;
 874                     $tid =~ s/\s$//;
 875                     next unless $tid;
 876
 877
 878                     if ($tid =~ /^\d+$/) {
 879                         $template_id = 'update-' . $tid;
 880                         push @{ $self->{'update_tickets'} }, $template_id;
 881
 882                     } elsif ($tid =~ /^#base-(\d+)$/) {
 883
 884                         $template_id = 'base-' . $1;
 885                         push @{ $self->{'base_tickets'} }, $template_id;
 886
 887                     } else {
 888                         $template_id = 'create-' . $tid;
 889                         push @{ $self->{'create_tickets'} }, $template_id;
 890                     }
 891                     $RT::Logger->debug("template_id: $tid");
 892                 }
 893                 else {
 894                     my $value = $1;
 895                     $value = '' if ( $value =~ /^$delimiter$/ );
 896                     if ($value =~ /^$RE{delimited}{-delim=>qq{\'\"}}$/) {
 897                         substr($value,0,1) = "";
 898                     substr($value,-1,1) = "";
 899                     }
 900                     my $field = $fields[$i];
 901                     next unless $field;
 902                     $field =~ s/^\s//;
 903                     $field =~ s/\s$//;
 904                     if (   $field =~ /Body/i
 905                         || $field =~ /Data/i
 906                         || $field =~ /Message/i )
 907                     {
 908                         $field = 'Content';
 909                     }
 910                     if ( $field =~ /Summary/i ) {
 911                         $field = 'Subject';
 912                     }
 913                     if ( $field =~ /Queue/i ) {
 914                         $queue = 1;
 915                         if ( !$value && $args{'Queue'} ) {
 916                             $value = $args{'Queue'};
 917                         }
 918                     }
 919                     if ( $field =~ /Requestor/i ) {
 920                         $requestor = 1;
 921                         if ( !$value && $args{'Requestor'} ) {
 922                             $value = $args{'Requestor'};
 923                         }
 924                     }
 925                     $self->{'templates'}->{$template_id} .= $field . ": ";
 926                     $self->{'templates'}->{$template_id} .= $value || "";
 927                     $self->{'templates'}->{$template_id} .= "\n";
 928                     $self->{'templates'}->{$template_id} .= "ENDOFCONTENT\n"
 929                       if $field =~ /content/i;
 930                 }
 931                 $i++;
 932             }
 933             if ( !$queue && $args{'Queue'} ) {
 934                 $self->{'templates'}->{$template_id} .= "Queue: $args{'Queue'}\n";
 935             }
 936             if ( !$requestor && $args{'Requestor'} ) {
 937                 $self->{'templates'}->{$template_id} .=
 938                   "Requestor: $args{'Requestor'}\n";
 939             }
 940         }
 941     }
 942 }
 943
 944 sub ParseLines {
 945     my $self        = shift;
 946     my $template_id = shift;
 947     my $links       = shift;
 948     my $postponed   = shift;
 949
 950
 951     my $content = $self->{'templates'}->{$template_id};
 952
 953     if ( $self->{'UsePerlTextTemplate'} ) {
 954
 955         $RT::Logger->debug(
 956             "Workflow: evaluating\n$self->{templates}{$template_id}");
 957
 958         my $template = Text::Template->new(
 959             TYPE   => 'STRING',
 960             SOURCE => $content
 961         );
 962
 963         my $err;
 964         $content = $template->fill_in(
 965             PACKAGE => 'T',
 966             BROKEN  => sub {
 967                 $err = {@_}->{error};
 968             }
 969         );
 970
 971         $RT::Logger->debug("Workflow: yielding\n$content");
 972
 973         if ($err) {
 974             $RT::Logger->error( "Ticket creation failed: " . $err );
 975             while ( my ( $k, $v ) = each %T::X ) {
 976                 $RT::Logger->debug(
 977                     "Eliminating $template_id from ${k}'s parents.");
 978                 delete $v->{$template_id};
 979             }
 980             next;
 981         }
 982     }
 983
 984     my $TicketObj ||= RT::Ticket->new($self->CurrentUser);
 985
 986     my %args;
 987     my @lines = ( split( /\n/, $content ) );
 988     while ( defined( my $line = shift @lines ) ) {
 989         if ( $line =~ /^(.*?):(?:\s+)(.*?)(?:\s*)$/ ) {
 990             my $value = $2;
 991             my $tag   = lc($1);
 992             $tag =~ s/-//g;
 993
 994             if ( ref( $args{$tag} ) )
 995             {    #If it's an array, we want to push the value
 996                 push @{ $args{$tag} }, $value;
 997             }
 998             elsif ( defined( $args{$tag} ) )
 999             {    #if we're about to get a second value, make it an array
1000                 $args{$tag} = [ $args{$tag}, $value ];
1001             }
1002             else {    #if there's nothing there, just set the value
1003                 $args{$tag} = $value;
1004             }
1005
1006             if ( $tag eq 'content' ) {    #just build up the content
1007                                           # convert it to an array
1008                 $args{$tag} = defined($value) ? [ $value . "\n" ] : [];
1009                 while ( defined( my $l = shift @lines ) ) {
1010                     last if ( $l =~ /^ENDOFCONTENT\s*$/ );
1011                     push @{ $args{'content'} }, $l . "\n";
1012                 }
1013             }
1014             else {
1015
1016                 # if it's not content, strip leading and trailing spaces
1017                 if ( $args{$tag} ) {
1018                     $args{$tag} =~ s/^\s+//g;
1019                     $args{$tag} =~ s/\s+$//g;
1020                 }
1021             }
1022         }
1023     }
1024
1025     foreach my $date qw(due starts started resolved) {
1026         my $dateobj = RT::Date->new($self->CurrentUser);
1027         next unless $args{$date};
1028         if ( $args{$date} =~ /^\d+$/ ) {
1029             $dateobj->Set( Format => 'unix', Value => $args{$date} );
1030         }
1031         else {
1032             $dateobj->Set( Format => 'unknown', Value => $args{$date} );
1033         }
1034         $args{$date} = $dateobj->ISO;
1035     }
1036
1037     $args{'requestor'} ||= $self->TicketObj->Requestors->MemberEmailAddresses
1038       if $self->TicketObj;
1039
1040     $args{'type'} ||= 'ticket';
1041
1042     my %ticketargs = (
1043         Queue           => $args{'queue'},
1044         Subject         => $args{'subject'},
1045         Status          => 'new',
1046         Due             => $args{'due'},
1047         Starts          => $args{'starts'},
1048         Started         => $args{'started'},
1049         Resolved        => $args{'resolved'},
1050         Owner           => $args{'owner'},
1051         Requestor       => $args{'requestor'},
1052         Cc              => $args{'cc'},
1053         AdminCc         => $args{'admincc'},
1054         TimeWorked      => $args{'timeworked'},
1055         TimeEstimated   => $args{'timeestimated'},
1056         TimeLeft        => $args{'timeleft'},
1057         InitialPriority => $args{'initialpriority'} || 0,
1058         FinalPriority   => $args{'finalpriority'} || 0,
1059         Type            => $args{'type'},
1060     );
1061
1062     if ($args{content}) {
1063         my $mimeobj = MIME::Entity->new();
1064         $mimeobj->build(
1065             Type => $args{'contenttype'},
1066             Data => $args{'content'}
1067         );
1068         $ticketargs{MIMEObj} = $mimeobj;
1069         $ticketargs{UpdateType} = $args{'updatetype'} if $args{'updatetype'};
1070     }
1071
1072     foreach my $key ( keys(%args) ) {
1073         $key =~ /^customfield(\d+)$/ or next;
1074         $ticketargs{ "CustomField-" . $1 } = $args{$key};
1075     }
1076
1077     $self->GetDeferred( \%args, $template_id, $links, $postponed );
1078
1079     return $TicketObj, \%ticketargs;
1080 }
1081
1082 sub GetDeferred {
1083     my $self      = shift;
1084     my $args      = shift;
1085     my $id        = shift;
1086     my $links     = shift;
1087     my $postponed = shift;
1088
1089     # Deferred processing
1090     push @$links,
1091       (
1092         $id,
1093         {
1094             DependsOn    => $args->{'dependson'},
1095             DependedOnBy => $args->{'dependedonby'},
1096             RefersTo     => $args->{'refersto'},
1097             ReferredToBy => $args->{'referredtoby'},
1098             Children     => $args->{'children'},
1099             Parents      => $args->{'parents'},
1100         }
1101       );
1102
1103     push @$postponed, (
1104
1105         # Status is postponed so we don't violate dependencies
1106         $id, { Status => $args->{'status'}, }
1107     );
1108 }
1109
1110 sub GetUpdateTemplate {
1111     my $self = shift;
1112     my $t    = shift;
1113
1114     my $string;
1115     $string .= "Queue: " . $t->QueueObj->Name . "\n";
1116     $string .= "Subject: " . $t->Subject . "\n";
1117     $string .= "Status: " . $t->Status . "\n";
1118     $string .= "UpdateType: response\n";
1119     $string .= "Content: \n";
1120     $string .= "ENDOFCONTENT\n";
1121     $string .= "Due: " . $t->DueObj->AsString . "\n";
1122     $string .= "Starts: " . $t->StartsObj->AsString . "\n";
1123     $string .= "Started: " . $t->StartedObj->AsString . "\n";
1124     $string .= "Resolved: " . $t->ResolvedObj->AsString . "\n";
1125     $string .= "Owner: " . $t->OwnerObj->Name . "\n";
1126     $string .= "Requestor: " . $t->RequestorAddresses . "\n";
1127     $string .= "Cc: " . $t->CcAddresses . "\n";
1128     $string .= "AdminCc: " . $t->AdminCcAddresses . "\n";
1129     $string .= "TimeWorked: " . $t->TimeWorked . "\n";
1130     $string .= "TimeEstimated: " . $t->TimeEstimated . "\n";
1131     $string .= "TimeLeft: " . $t->TimeLeft . "\n";
1132     $string .= "InitialPriority: " . $t->Priority . "\n";
1133     $string .= "FinalPriority: " . $t->FinalPriority . "\n";
1134
1135     foreach my $type ( sort keys %LINKTYPEMAP ) {
1136
1137         # don't display duplicates
1138         if (   $type eq "HasMember"
1139             || $type eq "Members"
1140             || $type eq "MemberOf" )
1141         {
1142             next;
1143         }
1144         $string .= "$type: ";
1145
1146         my $mode   = $LINKTYPEMAP{$type}->{Mode};
1147         my $method = $LINKTYPEMAP{$type}->{Type};
1148
1149         my $links;
1150         while ( my $link = $t->$method->Next ) {
1151             $links .= ", " if $links;
1152
1153             my $object = $mode . "Obj";
1154             my $member = $link->$object;
1155             $links .= $member->Id if $member;
1156         }
1157         $string .= $links;
1158         $string .= "\n";
1159     }
1160
1161     return $string;
1162 }
1163
1164 sub GetBaseTemplate {
1165     my $self = shift;
1166     my $t    = shift;
1167
1168     my $string;
1169     $string .= "Queue: " . $t->Queue . "\n";
1170     $string .= "Subject: " . $t->Subject . "\n";
1171     $string .= "Status: " . $t->Status . "\n";
1172     $string .= "Due: " . $t->DueObj->Unix . "\n";
1173     $string .= "Starts: " . $t->StartsObj->Unix . "\n";
1174     $string .= "Started: " . $t->StartedObj->Unix . "\n";
1175     $string .= "Resolved: " . $t->ResolvedObj->Unix . "\n";
1176     $string .= "Owner: " . $t->Owner . "\n";
1177     $string .= "Requestor: " . $t->RequestorAddresses . "\n";
1178     $string .= "Cc: " . $t->CcAddresses . "\n";
1179     $string .= "AdminCc: " . $t->AdminCcAddresses . "\n";
1180     $string .= "TimeWorked: " . $t->TimeWorked . "\n";
1181     $string .= "TimeEstimated: " . $t->TimeEstimated . "\n";
1182     $string .= "TimeLeft: " . $t->TimeLeft . "\n";
1183     $string .= "InitialPriority: " . $t->Priority . "\n";
1184     $string .= "FinalPriority: " . $t->FinalPriority . "\n";
1185
1186     return $string;
1187 }
1188
1189 sub GetCreateTemplate {
1190     my $self = shift;
1191
1192     my $string;
1193
1194     $string .= "Queue: General\n";
1195     $string .= "Subject: \n";
1196     $string .= "Status: new\n";
1197     $string .= "Content: \n";
1198     $string .= "ENDOFCONTENT\n";
1199     $string .= "Due: \n";
1200     $string .= "Starts: \n";
1201     $string .= "Started: \n";
1202     $string .= "Resolved: \n";
1203     $string .= "Owner: \n";
1204     $string .= "Requestor: \n";
1205     $string .= "Cc: \n";
1206     $string .= "AdminCc:\n";
1207     $string .= "TimeWorked: \n";
1208     $string .= "TimeEstimated: \n";
1209     $string .= "TimeLeft: \n";
1210     $string .= "InitialPriority: \n";
1211     $string .= "FinalPriority: \n";
1212
1213     foreach my $type ( keys %LINKTYPEMAP ) {
1214
1215         # don't display duplicates
1216         if (   $type eq "HasMember"
1217             || $type eq 'Members'
1218             || $type eq 'MemberOf' )
1219         {
1220             next;
1221         }
1222         $string .= "$type: \n";
1223     }
1224     return $string;
1225 }
1226
1227 sub UpdateWatchers {
1228     my $self   = shift;
1229     my $ticket = shift;
1230     my $args   = shift;
1231
1232     my @results;
1233
1234     foreach my $type qw(Requestor Cc AdminCc) {
1235         my $method  = $type . 'Addresses';
1236         my $oldaddr = $ticket->$method;
1237
1238
1239         # Skip unless we have a defined field
1240         next unless defined $args->{$type};
1241         my $newaddr = $args->{$type};
1242
1243         my @old = split( ', ', $oldaddr );
1244         my @new = split( ', ', $newaddr );
1245         my %oldhash = map { $_ => 1 } @old;
1246         my %newhash = map { $_ => 1 } @new;
1247
1248         my @add    = grep( !defined $oldhash{$_}, @new );
1249         my @delete = grep( !defined $newhash{$_}, @old );
1250
1251         foreach (@add) {
1252             my ( $val, $msg ) = $ticket->AddWatcher(
1253                 Type  => $type,
1254                 Email => $_
1255             );
1256
1257             push @results,
1258               $ticket->loc( "Ticket [_1]", $ticket->Id ) . ': ' . $msg;
1259         }
1260
1261         foreach (@delete) {
1262             my ( $val, $msg ) = $ticket->DeleteWatcher(
1263                 Type  => $type,
1264                 Email => $_
1265             );
1266             push @results,
1267               $ticket->loc( "Ticket [_1]", $ticket->Id ) . ': ' . $msg;
1268         }
1269     }
1270     return @results;
1271 }
1272
1273 sub PostProcess {
1274     my $self      = shift;
1275     my $links     = shift;
1276     my $postponed = shift;
1277
1278     # postprocessing: add links
1279
1280     while ( my $template_id = shift(@$links) ) {
1281         my $ticket = $T::Tickets{$template_id};
1282         $RT::Logger->debug( "Handling links for " . $ticket->Id );
1283         my %args = %{ shift(@$links) };
1284
1285         foreach my $type ( keys %LINKTYPEMAP ) {
1286             next unless ( defined $args{$type} );
1287             foreach my $link (
1288                 ref( $args{$type} ) ? @{ $args{$type} } : ( $args{$type} ) )
1289             {
1290                 next unless $link;
1291
1292                 if ($link =~ /^TOP$/i) {
1293                     $RT::Logger->debug( "Building $type link for $link: " . $T::Tickets{TOP}->Id );
1294                     $link = $T::Tickets{TOP}->Id;
1295
1296                 }
1297                 elsif ( $link !~ m/^\d+$/ ) {
1298                     my $key = "create-$link";
1299                     if ( !exists $T::Tickets{$key} ) {
1300                         $RT::Logger->debug( "Skipping $type link for $key (non-existent)");
1301                         next;
1302                     }
1303                     $RT::Logger->debug( "Building $type link for $link: " . $T::Tickets{$key}->Id );
1304                     $link = $T::Tickets{$key}->Id;
1305                 }
1306                 else {
1307                     $RT::Logger->debug("Building $type link for $link");
1308                 }
1309
1310                 my ( $wval, $wmsg ) = $ticket->AddLink(
1311                     Type => $LINKTYPEMAP{$type}->{'Type'},
1312                     $LINKTYPEMAP{$type}->{'Mode'} => $link,
1313                     Silent                        => 1
1314                 );
1315
1316                 $RT::Logger->warning("AddLink thru $link failed: $wmsg")
1317                   unless $wval;
1318
1319                 # push @non_fatal_errors, $wmsg unless ($wval);
1320             }
1321
1322         }
1323     }
1324
1325     # postponed actions -- Status only, currently
1326     while ( my $template_id = shift(@$postponed) ) {
1327         my $ticket = $T::Tickets{$template_id};
1328         $RT::Logger->debug("Handling postponed actions for ".$ticket->id);
1329         my %args = %{ shift(@$postponed) };
1330         $ticket->SetStatus( $args{Status} ) if defined $args{Status};
1331     }
1332
1333 }
1334
1335 eval "require RT::Action::CreateTickets_Vendor";
1336 die $@ if ( $@ && $@ !~ qr{^Can't locate RT/Action/CreateTickets_Vendor.pm} );
1337 eval "require RT::Action::CreateTickets_Local";
1338 die $@ if ( $@ && $@ !~ qr{^Can't locate RT/Action/CreateTickets_Local.pm} );
1339
1340 1;
1341