rt/lib/RT/Action/CreateTickets.pm

   1 # {{{ BEGIN BPS TAGGED BLOCK
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2004 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 + man 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     %T::Tickets = ();
 569
 570     my $ticketargs;
 571     my ( @links, @postponed );
 572     foreach my $template_id ( @{ $self->{'create_tickets'} } ) {
 573         $T::Tickets{'TOP'} = $T::TOP = $top if $top;
 574         $RT::Logger->debug("Workflow: processing $template_id of $T::TOP")
 575           if $T::TOP;
 576
 577         $T::ID    = $template_id;
 578         @T::AllID = @{ $self->{'create_tickets'} };
 579
 580         ( $T::Tickets{$template_id}, $ticketargs ) =
 581           $self->ParseLines( $template_id, \@links, \@postponed );
 582
 583         # Now we have a %args to work with.
 584         # Make sure we have at least the minimum set of
 585         # reasonable data and do our thang
 586
 587         my ( $id, $transid, $msg ) =
 588           $T::Tickets{$template_id}->Create(%$ticketargs);
 589
 590         foreach my $res ( split( '\n', $msg ) ) {
 591             push @results,
 592               $T::Tickets{$template_id}
 593               ->loc( "Ticket [_1]", $T::Tickets{$template_id}->Id ) . ': '
 594               . $res;
 595         }
 596         if ( !$id ) {
 597             if ( $self->TicketObj ) {
 598                 $msg =
 599                     "Couldn't create related ticket $template_id for "
 600                   . $self->TicketObj->Id . " "
 601                   . $msg;
 602             }
 603             else {
 604                 $msg = "Couldn't create ticket $template_id " . $msg;
 605             }
 606
 607             $RT::Logger->error($msg);
 608             next;
 609         }
 610
 611         $RT::Logger->debug("Assigned $template_id with $id");
 612         $T::Tickets{$template_id}->SetOriginObj( $self->TicketObj )
 613           if $self->TicketObj
 614           && $T::Tickets{$template_id}->can('SetOriginObj');
 615
 616     }
 617
 618     $self->PostProcess( \@links, \@postponed );
 619
 620     return @results;
 621 }
 622
 623 sub UpdateByTemplate {
 624     my $self = shift;
 625     my $top  = shift;
 626
 627     # XXX: cargo cult programming that works. i'll be back.
 628     use bytes;
 629
 630     my @results;
 631     %T::Tickets = ();
 632
 633     my $ticketargs;
 634     my ( @links, @postponed );
 635     foreach my $template_id ( @{ $self->{'update_tickets'} } ) {
 636         $RT::Logger->debug("Update Workflow: processing $template_id");
 637
 638         $T::ID    = $template_id;
 639         @T::AllID = @{ $self->{'update_tickets'} };
 640
 641         ( $T::Tickets{$template_id}, $ticketargs ) =
 642           $self->ParseLines( $template_id, \@links, \@postponed );
 643
 644         # Now we have a %args to work with.
 645         # Make sure we have at least the minimum set of
 646         # reasonable data and do our thang
 647
 648         my @attribs = qw(
 649           Subject
 650           FinalPriority
 651           Priority
 652           TimeEstimated
 653           TimeWorked
 654           TimeLeft
 655           Status
 656           Queue
 657           Due
 658           Starts
 659           Started
 660           Resolved
 661         );
 662
 663         my $id = $template_id;
 664         $id =~ s/update-(\d+).*/$1/;
 665         $T::Tickets{$template_id}->Load($id);
 666
 667         my $msg;
 668         if ( !$T::Tickets{$template_id}->Id ) {
 669             $msg = "Couldn't update ticket $template_id " . $msg;
 670
 671             $RT::Logger->error($msg);
 672             next;
 673         }
 674
 675         my $current = $self->GetBaseTemplate( $T::Tickets{$template_id} );
 676
 677         $template_id =~ m/^update-(.*)/;
 678         my $base_id = "base-$1";
 679         my $base    = $self->{'templates'}->{$base_id};
 680         if ($base) {
 681         $base    =~ s/\r//g;
 682         $base    =~ s/\n+$//;
 683         $current =~ s/\n+$//;
 684
 685         # If we have no base template, set what we can.
 686         if ($base ne $current)  {
 687             push @results,
 688               "Could not update ticket "
 689               . $T::Tickets{$template_id}->Id
 690               . ": Ticket has changed";
 691             next;
 692         }
 693         }
 694         push @results, $T::Tickets{$template_id}->Update(
 695             AttributesRef => \@attribs,
 696             ARGSRef       => $ticketargs
 697         );
 698
 699         push @results,
 700           $self->UpdateWatchers( $T::Tickets{$template_id}, $ticketargs );
 701
 702         next unless exists $ticketargs->{'UpdateType'};
 703         if ( $ticketargs->{'UpdateType'} =~ /^(private|public)$/ ) {
 704             my ( $Transaction, $Description, $Object ) =
 705               $T::Tickets{$template_id}->Comment(
 706                 CcMessageTo  => $ticketargs->{'Cc'},
 707                 BccMessageTo => $ticketargs->{'Bcc'},
 708                 MIMEObj      => $ticketargs->{'MIMEObj'},
 709                 TimeTaken    => $ticketargs->{'TimeWorked'}
 710               );
 711             push( @results,
 712                 $T::Tickets{$template_id}
 713                   ->loc( "Ticket [_1]", $T::Tickets{$template_id}->id ) . ': '
 714                   . $Description );
 715         }
 716         elsif ( $ticketargs->{'UpdateType'} eq 'response' ) {
 717             my ( $Transaction, $Description, $Object ) =
 718               $T::Tickets{$template_id}->Correspond(
 719                 CcMessageTo  => $ticketargs->{'Cc'},
 720                 BccMessageTo => $ticketargs->{'Bcc'},
 721                 MIMEObj      => $ticketargs->{'MIMEObj'},
 722                 TimeTaken    => $ticketargs->{'TimeWorked'}
 723               );
 724             push( @results,
 725                 $T::Tickets{$template_id}
 726                   ->loc( "Ticket [_1]", $T::Tickets{$template_id}->id ) . ': '
 727                   . $Description );
 728         }
 729         else {
 730             push( @results,
 731                 $T::Tickets{$template_id}
 732                   ->loc("Update type was neither correspondence nor comment.")
 733                   . " "
 734                   . $T::Tickets{$template_id}->loc("Update not recorded.") );
 735         }
 736     }
 737
 738     $self->PostProcess( \@links, \@postponed );
 739
 740     return @results;
 741 }
 742
 743 =head2 Parse  TEMPLATE_CONTENT, DEFAULT_QUEUE, DEFAULT_REQEUESTOR ACTIVE
 744
 745 Parse a template from TEMPLATE_CONTENT
 746
 747 If $active is set to true, then we'll use Text::Template to parse the templates,
 748 allowing you to embed active perl in your templates.
 749
 750 =cut
 751
 752 sub Parse {
 753     my $self          = shift;
 754     my %args = ( Content => undef,
 755                  Queue => undef,
 756                  Requestor => undef,
 757                  _ActiveContent => undef,
 758                 @_);
 759
 760     if ($args{'_ActiveContent'}) {
 761         $self->{'UsePerlTextTemplate'} =1;
 762     } else {
 763
 764         $self->{'UsePerlTextTemplate'} = 0;
 765     }
 766
 767     my @template_order;
 768     my $template_id;
 769     my ( $queue, $requestor );
 770     if ( substr( $args{'Content'}, 0, 3 ) eq '===' ) {
 771         $RT::Logger->debug("Line: ===");
 772         foreach my $line ( split( /\n/, $args{'Content'} ) ) {
 773             $line =~ s/\r$//;
 774             $RT::Logger->debug("Line: $line");
 775             if ( $line =~ /^===/ ) {
 776                 if ( $template_id && !$queue && $args{'Queue'} ) {
 777                     $self->{'templates'}->{$template_id} .= "Queue: $args{'Queue'}\n";
 778                 }
 779                 if ( $template_id && !$requestor && $args{'Requestor'} ) {
 780                     $self->{'templates'}->{$template_id} .=
 781                       "Requestor: $args{'Requestor'}\n";
 782                 }
 783                 $queue     = 0;
 784                 $requestor = 0;
 785             }
 786             if ( $line =~ /^===Create-Ticket: (.*)$/ ) {
 787                 $template_id = "create-$1";
 788                 $RT::Logger->debug("****  Create ticket: $template_id");
 789                 push @{ $self->{'create_tickets'} }, $template_id;
 790             }
 791             elsif ( $line =~ /^===Update-Ticket: (.*)$/ ) {
 792                 $template_id = "update-$1";
 793                 $RT::Logger->debug("****  Update ticket: $template_id");
 794                 push @{ $self->{'update_tickets'} }, $template_id;
 795             }
 796             elsif ( $line =~ /^===Base-Ticket: (.*)$/ ) {
 797                 $template_id = "base-$1";
 798                 $RT::Logger->debug("****  Base ticket: $template_id");
 799                 push @{ $self->{'base_tickets'} }, $template_id;
 800             }
 801             elsif ( $line =~ /^===#.*$/ ) {    # a comment
 802                 next;
 803             }
 804             else {
 805                 if ( $line =~ /^Queue:(.*)/i ) {
 806                     $queue = 1;
 807                     my $value = $1;
 808                     $value =~ s/^\s//;
 809                     $value =~ s/\s$//;
 810                     if ( !$value && $args{'Queue'}) {
 811                         $value = $args{'Queue'};
 812                         $line  = "Queue: $value";
 813                     }
 814                 }
 815                 if ( $line =~ /^Requestor:(.*)/i ) {
 816                     $requestor = 1;
 817                     my $value = $1;
 818                     $value =~ s/^\s//;
 819                     $value =~ s/\s$//;
 820                     if ( !$value && $args{'Requestor'}) {
 821                         $value = $args{'Requestor'};
 822                         $line  = "Requestor: $value";
 823                     }
 824                 }
 825                 $self->{'templates'}->{$template_id} .= $line . "\n";
 826             }
 827         }
 828         if ( $template_id && !$queue && $args{'Queue'} ) {
 829             $self->{'templates'}->{$template_id} .= "Queue: $args{'Queue'}\n";
 830         }
 831     }
 832     elsif ( substr( $args{'Content'}, 0, 2 ) =~ /^id$/i ) {
 833         $RT::Logger->debug("Line: id");
 834         use Regexp::Common qw(delimited);
 835         my $first = substr( $args{'Content'}, 0, index( $args{'Content'}, "\n" ) );
 836         $first =~ s/\r$//;
 837
 838         my $delimiter;
 839         if ( $first =~ /\t/ ) {
 840             $delimiter = "\t";
 841         }
 842         else {
 843             $delimiter = ',';
 844         }
 845         my @fields    = split( /$delimiter/, $first );
 846
 847
 848         my $delimiter_re = qr[$delimiter];
 849
 850         my $delimited = qr[[^$delimiter]+];
 851         my $empty     = qr[^[$delimiter](?=[$delimiter])];
 852         my $justquoted = qr[$RE{quoted}];
 853
 854         $args{'Content'} = substr( $args{'Content'}, index( $args{'Content'}, "\n" ) + 1 );
 855         $RT::Logger->debug("First: $first");
 856
 857         my $queue;
 858         foreach my $line ( split( /\n/, $args{'Content'} ) ) {
 859             next unless $line;
 860             $RT::Logger->debug("Line: $line");
 861
 862             # first item is $template_id
 863             my $i = 0;
 864             my $template_id;
 865             while ($line && $line =~ s/^($justquoted|.*?)(?:$delimiter_re|$)//ix) {
 866                 if ( $i == 0 ) {
 867                     $queue     = 0;
 868                     $requestor = 0;
 869                     my $tid = $1;
 870                     $tid =~ s/^\s//;
 871                     $tid =~ s/\s$//;
 872                     next unless $tid;
 873
 874
 875                     if ($tid =~ /^\d+$/) {
 876                         $template_id = 'update-' . $tid;
 877                         push @{ $self->{'update_tickets'} }, $template_id;
 878
 879                     } elsif ($tid =~ /^#base-(\d+)$/) {
 880
 881                         $template_id = 'base-' . $1;
 882                         push @{ $self->{'base_tickets'} }, $template_id;
 883
 884                     } else {
 885                         $template_id = 'create-' . $tid;
 886                         push @{ $self->{'create_tickets'} }, $template_id;
 887                     }
 888                     $RT::Logger->debug("template_id: $tid");
 889                 }
 890                 else {
 891                     my $value = $1;
 892                     $value = '' if ( $value =~ /^$delimiter$/ );
 893                     if ($value =~ /^$RE{delimited}{-delim=>qq{\'\"}}$/) {
 894                         substr($value,0,1) = "";
 895                     substr($value,-1,1) = "";
 896                     }
 897                     my $field = $fields[$i];
 898                     next unless $field;
 899                     $field =~ s/^\s//;
 900                     $field =~ s/\s$//;
 901                     if (   $field =~ /Body/i
 902                         || $field =~ /Data/i
 903                         || $field =~ /Message/i )
 904                     {
 905                         $field = 'Content';
 906                     }
 907                     if ( $field =~ /Summary/i ) {
 908                         $field = 'Subject';
 909                     }
 910                     if ( $field =~ /Queue/i ) {
 911                         $queue = 1;
 912                         if ( !$value && $args{'Queue'} ) {
 913                             $value = $args{'Queue'};
 914                         }
 915                     }
 916                     if ( $field =~ /Requestor/i ) {
 917                         $requestor = 1;
 918                         if ( !$value && $args{'Requestor'} ) {
 919                             $value = $args{'Requestor'};
 920                         }
 921                     }
 922                     $self->{'templates'}->{$template_id} .= $field . ": ";
 923                     $self->{'templates'}->{$template_id} .= $value || "";
 924                     $self->{'templates'}->{$template_id} .= "\n";
 925                     $self->{'templates'}->{$template_id} .= "ENDOFCONTENT\n"
 926                       if $field =~ /content/i;
 927                 }
 928                 $i++;
 929             }
 930             if ( !$queue && $args{'Queue'} ) {
 931                 $self->{'templates'}->{$template_id} .= "Queue: $args{'Queue'}\n";
 932             }
 933             if ( !$requestor && $args{'Requestor'} ) {
 934                 $self->{'templates'}->{$template_id} .=
 935                   "Requestor: $args{'Requestor'}\n";
 936             }
 937         }
 938     }
 939 }
 940
 941 sub ParseLines {
 942     my $self        = shift;
 943     my $template_id = shift;
 944     my $links       = shift;
 945     my $postponed   = shift;
 946
 947
 948     my $content = $self->{'templates'}->{$template_id};
 949
 950     if ( $self->{'UsePerlTextTemplate'} ) {
 951
 952         $RT::Logger->debug(
 953             "Workflow: evaluating\n$self->{templates}{$template_id}");
 954
 955         my $template = Text::Template->new(
 956             TYPE   => 'STRING',
 957             SOURCE => $content
 958         );
 959
 960         my $err;
 961         $content = $template->fill_in(
 962             PACKAGE => 'T',
 963             BROKEN  => sub {
 964                 $err = {@_}->{error};
 965             }
 966         );
 967
 968         $RT::Logger->debug("Workflow: yielding\n$content");
 969
 970         if ($err) {
 971             $RT::Logger->error( "Ticket creation failed: " . $err );
 972             while ( my ( $k, $v ) = each %T::X ) {
 973                 $RT::Logger->debug(
 974                     "Eliminating $template_id from ${k}'s parents.");
 975                 delete $v->{$template_id};
 976             }
 977             next;
 978         }
 979     }
 980
 981     my $TicketObj ||= RT::Ticket->new($self->CurrentUser);
 982
 983     my %args;
 984     my @lines = ( split( /\n/, $content ) );
 985     while ( defined( my $line = shift @lines ) ) {
 986         if ( $line =~ /^(.*?):(?:\s+)(.*?)(?:\s*)$/ ) {
 987             my $value = $2;
 988             my $tag   = lc($1);
 989             $tag =~ s/-//g;
 990
 991             if ( ref( $args{$tag} ) )
 992             {    #If it's an array, we want to push the value
 993                 push @{ $args{$tag} }, $value;
 994             }
 995             elsif ( defined( $args{$tag} ) )
 996             {    #if we're about to get a second value, make it an array
 997                 $args{$tag} = [ $args{$tag}, $value ];
 998             }
 999             else {    #if there's nothing there, just set the value
1000                 $args{$tag} = $value;
1001             }
1002
1003             if ( $tag eq 'content' ) {    #just build up the content
1004                                           # convert it to an array
1005                 $args{$tag} = defined($value) ? [ $value . "\n" ] : [];
1006                 while ( defined( my $l = shift @lines ) ) {
1007                     last if ( $l =~ /^ENDOFCONTENT\s*$/ );
1008                     push @{ $args{'content'} }, $l . "\n";
1009                 }
1010             }
1011             else {
1012
1013                 # if it's not content, strip leading and trailing spaces
1014                 if ( $args{$tag} ) {
1015                     $args{$tag} =~ s/^\s+//g;
1016                     $args{$tag} =~ s/\s+$//g;
1017                 }
1018             }
1019         }
1020     }
1021
1022     foreach my $date qw(due starts started resolved) {
1023         my $dateobj = RT::Date->new($self->CurrentUser);
1024         next unless $args{$date};
1025         if ( $args{$date} =~ /^\d+$/ ) {
1026             $dateobj->Set( Format => 'unix', Value => $args{$date} );
1027         }
1028         else {
1029             $dateobj->Set( Format => 'unknown', Value => $args{$date} );
1030         }
1031         $args{$date} = $dateobj->ISO;
1032     }
1033
1034     $args{'requestor'} ||= $self->TicketObj->Requestors->MemberEmailAddresses
1035       if $self->TicketObj;
1036
1037     $args{'type'} ||= 'ticket';
1038
1039     my %ticketargs = (
1040         Queue           => $args{'queue'},
1041         Subject         => $args{'subject'},
1042         Status          => 'new',
1043         Due             => $args{'due'},
1044         Starts          => $args{'starts'},
1045         Started         => $args{'started'},
1046         Resolved        => $args{'resolved'},
1047         Owner           => $args{'owner'},
1048         Requestor       => $args{'requestor'},
1049         Cc              => $args{'cc'},
1050         AdminCc         => $args{'admincc'},
1051         TimeWorked      => $args{'timeworked'},
1052         TimeEstimated   => $args{'timeestimated'},
1053         TimeLeft        => $args{'timeleft'},
1054         InitialPriority => $args{'initialpriority'} || 0,
1055         FinalPriority   => $args{'finalpriority'} || 0,
1056         Type            => $args{'type'},
1057     );
1058
1059     if ($args{content}) {
1060         my $mimeobj = MIME::Entity->new();
1061         $mimeobj->build(
1062             Type => $args{'contenttype'},
1063             Data => $args{'content'}
1064         );
1065         $ticketargs{MIMEObj} = $mimeobj;
1066         $ticketargs{UpdateType} = $args{'updatetype'} if $args{'updatetype'};
1067     }
1068
1069     foreach my $key ( keys(%args) ) {
1070         $key =~ /^customfield(\d+)$/ or next;
1071         $ticketargs{ "CustomField-" . $1 } = $args{$key};
1072     }
1073
1074     $self->GetDeferred( \%args, $template_id, $links, $postponed );
1075
1076     return $TicketObj, \%ticketargs;
1077 }
1078
1079 sub GetDeferred {
1080     my $self      = shift;
1081     my $args      = shift;
1082     my $id        = shift;
1083     my $links     = shift;
1084     my $postponed = shift;
1085
1086     # Deferred processing
1087     push @$links,
1088       (
1089         $id,
1090         {
1091             DependsOn    => $args->{'dependson'},
1092             DependedOnBy => $args->{'dependedonby'},
1093             RefersTo     => $args->{'refersto'},
1094             ReferredToBy => $args->{'referredtoby'},
1095             Children     => $args->{'children'},
1096             Parents      => $args->{'parents'},
1097         }
1098       );
1099
1100     push @$postponed, (
1101
1102         # Status is postponed so we don't violate dependencies
1103         $id, { Status => $args->{'status'}, }
1104     );
1105 }
1106
1107 sub GetUpdateTemplate {
1108     my $self = shift;
1109     my $t    = shift;
1110
1111     my $string;
1112     $string .= "Queue: " . $t->QueueObj->Name . "\n";
1113     $string .= "Subject: " . $t->Subject . "\n";
1114     $string .= "Status: " . $t->Status . "\n";
1115     $string .= "UpdateType: response\n";
1116     $string .= "Content: \n";
1117     $string .= "ENDOFCONTENT\n";
1118     $string .= "Due: " . $t->DueObj->AsString . "\n";
1119     $string .= "Starts: " . $t->StartsObj->AsString . "\n";
1120     $string .= "Started: " . $t->StartedObj->AsString . "\n";
1121     $string .= "Resolved: " . $t->ResolvedObj->AsString . "\n";
1122     $string .= "Owner: " . $t->OwnerObj->Name . "\n";
1123     $string .= "Requestor: " . $t->RequestorAddresses . "\n";
1124     $string .= "Cc: " . $t->CcAddresses . "\n";
1125     $string .= "AdminCc: " . $t->AdminCcAddresses . "\n";
1126     $string .= "TimeWorked: " . $t->TimeWorked . "\n";
1127     $string .= "TimeEstimated: " . $t->TimeEstimated . "\n";
1128     $string .= "TimeLeft: " . $t->TimeLeft . "\n";
1129     $string .= "InitialPriority: " . $t->Priority . "\n";
1130     $string .= "FinalPriority: " . $t->FinalPriority . "\n";
1131
1132     foreach my $type ( sort keys %LINKTYPEMAP ) {
1133
1134         # don't display duplicates
1135         if (   $type eq "HasMember"
1136             || $type eq "Members"
1137             || $type eq "MemberOf" )
1138         {
1139             next;
1140         }
1141         $string .= "$type: ";
1142
1143         my $mode   = $LINKTYPEMAP{$type}->{Mode};
1144         my $method = $LINKTYPEMAP{$type}->{Type};
1145
1146         my $links;
1147         while ( my $link = $t->$method->Next ) {
1148             $links .= ", " if $links;
1149
1150             my $object = $mode . "Obj";
1151             my $member = $link->$object;
1152             $links .= $member->Id if $member;
1153         }
1154         $string .= $links;
1155         $string .= "\n";
1156     }
1157
1158     return $string;
1159 }
1160
1161 sub GetBaseTemplate {
1162     my $self = shift;
1163     my $t    = shift;
1164
1165     my $string;
1166     $string .= "Queue: " . $t->Queue . "\n";
1167     $string .= "Subject: " . $t->Subject . "\n";
1168     $string .= "Status: " . $t->Status . "\n";
1169     $string .= "Due: " . $t->DueObj->Unix . "\n";
1170     $string .= "Starts: " . $t->StartsObj->Unix . "\n";
1171     $string .= "Started: " . $t->StartedObj->Unix . "\n";
1172     $string .= "Resolved: " . $t->ResolvedObj->Unix . "\n";
1173     $string .= "Owner: " . $t->Owner . "\n";
1174     $string .= "Requestor: " . $t->RequestorAddresses . "\n";
1175     $string .= "Cc: " . $t->CcAddresses . "\n";
1176     $string .= "AdminCc: " . $t->AdminCcAddresses . "\n";
1177     $string .= "TimeWorked: " . $t->TimeWorked . "\n";
1178     $string .= "TimeEstimated: " . $t->TimeEstimated . "\n";
1179     $string .= "TimeLeft: " . $t->TimeLeft . "\n";
1180     $string .= "InitialPriority: " . $t->Priority . "\n";
1181     $string .= "FinalPriority: " . $t->FinalPriority . "\n";
1182
1183     return $string;
1184 }
1185
1186 sub GetCreateTemplate {
1187     my $self = shift;
1188
1189     my $string;
1190
1191     $string .= "Queue: General\n";
1192     $string .= "Subject: \n";
1193     $string .= "Status: new\n";
1194     $string .= "Content: \n";
1195     $string .= "ENDOFCONTENT\n";
1196     $string .= "Due: \n";
1197     $string .= "Starts: \n";
1198     $string .= "Started: \n";
1199     $string .= "Resolved: \n";
1200     $string .= "Owner: \n";
1201     $string .= "Requestor: \n";
1202     $string .= "Cc: \n";
1203     $string .= "AdminCc:\n";
1204     $string .= "TimeWorked: \n";
1205     $string .= "TimeEstimated: \n";
1206     $string .= "TimeLeft: \n";
1207     $string .= "InitialPriority: \n";
1208     $string .= "FinalPriority: \n";
1209
1210     foreach my $type ( keys %LINKTYPEMAP ) {
1211
1212         # don't display duplicates
1213         if (   $type eq "HasMember"
1214             || $type eq 'Members'
1215             || $type eq 'MemberOf' )
1216         {
1217             next;
1218         }
1219         $string .= "$type: \n";
1220     }
1221     return $string;
1222 }
1223
1224 sub UpdateWatchers {
1225     my $self   = shift;
1226     my $ticket = shift;
1227     my $args   = shift;
1228
1229     my @results;
1230
1231     foreach my $type qw(Requestor Cc AdminCc) {
1232         my $method  = $type . 'Addresses';
1233         my $oldaddr = $ticket->$method;
1234
1235
1236         # Skip unless we have a defined field
1237         next unless defined $args->{$type};
1238         my $newaddr = $args->{$type};
1239
1240         my @old = split( ', ', $oldaddr );
1241         my @new = split( ', ', $newaddr );
1242         my %oldhash = map { $_ => 1 } @old;
1243         my %newhash = map { $_ => 1 } @new;
1244
1245         my @add    = grep( !defined $oldhash{$_}, @new );
1246         my @delete = grep( !defined $newhash{$_}, @old );
1247
1248         foreach (@add) {
1249             my ( $val, $msg ) = $ticket->AddWatcher(
1250                 Type  => $type,
1251                 Email => $_
1252             );
1253
1254             push @results,
1255               $ticket->loc( "Ticket [_1]", $ticket->Id ) . ': ' . $msg;
1256         }
1257
1258         foreach (@delete) {
1259             my ( $val, $msg ) = $ticket->DeleteWatcher(
1260                 Type  => $type,
1261                 Email => $_
1262             );
1263             push @results,
1264               $ticket->loc( "Ticket [_1]", $ticket->Id ) . ': ' . $msg;
1265         }
1266     }
1267     return @results;
1268 }
1269
1270 sub PostProcess {
1271     my $self      = shift;
1272     my $links     = shift;
1273     my $postponed = shift;
1274
1275     # postprocessing: add links
1276
1277     while ( my $template_id = shift(@$links) ) {
1278         my $ticket = $T::Tickets{$template_id};
1279         $RT::Logger->debug( "Handling links for " . $ticket->Id );
1280         my %args = %{ shift(@$links) };
1281
1282         foreach my $type ( keys %LINKTYPEMAP ) {
1283             next unless ( defined $args{$type} );
1284             foreach my $link (
1285                 ref( $args{$type} ) ? @{ $args{$type} } : ( $args{$type} ) )
1286             {
1287                 next unless $link;
1288
1289                 if ($link =~ /^TOP$/i) {
1290                     $RT::Logger->debug( "Building $type link for $link: " . $T::Tickets{TOP}->Id );
1291                     $link = $T::Tickets{TOP}->Id;
1292
1293                 }
1294                 elsif ( $link !~ m/^\d+$/ ) {
1295                     my $key = "create-$link";
1296                     if ( !exists $T::Tickets{$key} ) {
1297                         $RT::Logger->debug( "Skipping $type link for $key (non-existent)");
1298                         next;
1299                     }
1300                     $RT::Logger->debug( "Building $type link for $link: " . $T::Tickets{$key}->Id );
1301                     $link = $T::Tickets{$key}->Id;
1302                 }
1303                 else {
1304                     $RT::Logger->debug("Building $type link for $link");
1305                 }
1306
1307                 my ( $wval, $wmsg ) = $ticket->AddLink(
1308                     Type => $LINKTYPEMAP{$type}->{'Type'},
1309                     $LINKTYPEMAP{$type}->{'Mode'} => $link,
1310                     Silent                        => 1
1311                 );
1312
1313                 $RT::Logger->warning("AddLink thru $link failed: $wmsg")
1314                   unless $wval;
1315
1316                 # push @non_fatal_errors, $wmsg unless ($wval);
1317             }
1318
1319         }
1320     }
1321
1322     # postponed actions -- Status only, currently
1323     while ( my $template_id = shift(@$postponed) ) {
1324         my $ticket = $T::Tickets{$template_id};
1325         $RT::Logger->debug("Handling postponed actions for ".$ticket->id);
1326         my %args = %{ shift(@$postponed) };
1327         $ticket->SetStatus( $args{Status} ) if defined $args{Status};
1328     }
1329
1330 }
1331
1332 eval "require RT::Action::CreateTickets_Vendor";
1333 die $@ if ( $@ && $@ !~ qr{^Can't locate RT/Action/CreateTickets_Vendor.pm} );
1334 eval "require RT::Action::CreateTickets_Local";
1335 die $@ if ( $@ && $@ !~ qr{^Can't locate RT/Action/CreateTickets_Local.pm} );
1336
1337 1;
1338