rt/lib/RT/Action/CreateTickets.pm

   1 # BEGIN LICENSE BLOCK
   2 #
   3 # Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
   4 #
   5 # (Except where explictly superceded by other copyright notices)
   6 #
   7 # This work is made available to you under the terms of Version 2 of
   8 # the GNU General Public License. A copy of that license should have
   9 # been provided with this software, but in any event can be snarfed
  10 # from www.gnu.org.
  11 #
  12 # This work is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 # General Public License for more details.
  16 #
  17 # Unless otherwise specified, all modifications, corrections or
  18 # extensions to this work which alter its source code become the
  19 # property of Best Practical Solutions, LLC when submitted for
  20 # inclusion in the work.
  21 #
  22 #
  23 # END LICENSE BLOCK
  24 package RT::Action::CreateTickets;
  25 require RT::Action::Generic;
  26
  27 use strict;
  28 use vars qw/@ISA/;
  29 @ISA = qw(RT::Action::Generic);
  30
  31 use MIME::Entity;
  32
  33 =head1 NAME
  34
  35  RT::Action::CreateTickets
  36
  37 Create one or more tickets according to an externally supplied template.
  38
  39
  40 =head1 SYNOPSIS
  41
  42  ===Create-Ticket: codereview
  43  Subject: Code review for {$Tickets{'TOP'}->Subject}
  44  Depended-On-By: TOP
  45  Content: Someone has created a ticket. you should review and approve it,
  46  so they can finish their work
  47  ENDOFCONTENT
  48
  49 =head1 DESCRIPTION
  50
  51
  52 Using the "CreateTickets" ScripAction and mandatory dependencies, RT now has
  53 the ability to model complex workflow. When a ticket is created in a queue
  54 that has a "CreateTickets" scripaction, that ScripAction parses its "Template"
  55
  56
  57
  58 =head2 FORMAT
  59
  60 CreateTickets uses the template as a template for an ordered set of tickets
  61 to create. The basic format is as follows:
  62
  63
  64  ===Create-Ticket: identifier
  65  Param: Value
  66  Param2: Value
  67  Param3: Value
  68  Content: Blah
  69  blah
  70  blah
  71  ENDOFCONTENT
  72  ===Create-Ticket: id2
  73  Param: Value
  74  Content: Blah
  75  ENDOFCONTENT
  76
  77
  78 Each ===Create-Ticket: section is evaluated as its own
  79 Text::Template object, which means that you can embed snippets
  80 of perl inside the Text::Template using {} delimiters, but that
  81 such sections absolutely can not span a ===Create-Ticket boundary.
  82
  83 After each ticket is created, it's stuffed into a hash called %Tickets
  84 so as to be available during the creation of other tickets during the same
  85 ScripAction.  The hash is prepopulated with the ticket which triggered the
  86 ScripAction as $Tickets{'TOP'}; you can also access that ticket using the
  87 shorthand TOP.
  88
  89 A simple example:
  90
  91  ===Create-Ticket: codereview
  92  Subject: Code review for {$Tickets{'TOP'}->Subject}
  93  Depended-On-By: TOP
  94  Content: Someone has created a ticket. you should review and approve it,
  95  so they can finish their work
  96  ENDOFCONTENT
  97
  98
  99
 100 A convoluted example
 101
 102  ===Create-Ticket: approval
 103  { # Find out who the administrators of the group called "HR"
 104    # of which the creator of this ticket is a member
 105     my $name = "HR";
 106
 107     my $groups = RT::Groups->new($RT::SystemUser);
 108     $groups->LimitToUserDefinedGroups();
 109     $groups->Limit(FIELD => "Name", OPERATOR => "=", VALUE => "$name");
 110     $groups->WithMember($TransactionObj->CreatorObj->Id);
 111
 112     my $groupid = $groups->First->Id;
 113
 114     my $adminccs = RT::Users->new($RT::SystemUser);
 115     $adminccs->WhoHaveRight(
 116         Right => "AdminGroup",
 117         Object =>$groups->First,
 118         IncludeSystemRights => undef,
 119         IncludeSuperusers => 0,
 120         IncludeSubgroupMembers => 0,
 121     );
 122
 123      my @admins;
 124      while (my $admin = $adminccs->Next) {
 125          push (@admins, $admin->EmailAddress);
 126      }
 127  }
 128  Queue: Approvals
 129  Type: Approval
 130  AdminCc: {join ("\nAdminCc: ",@admins) }
 131  Depended-On-By: TOP
 132  Refers-To: TOP
 133  Subject: Approval for ticket: {$Tickets{"TOP"}->Id} - {$Tickets{"TOP"}->Subject}
 134  Due: {time + 86400}
 135  Content-Type: text/plain
 136  Content: Your approval is requested for the ticket {$Tickets{"TOP"}->Id}: {$Tickets{"TOP"}->Subject}
 137  Blah
 138  Blah
 139  ENDOFCONTENT
 140  ===Create-Ticket: two
 141  Subject: Manager approval
 142  Depended-On-By: TOP
 143  Refers-On: {$Tickets{"approval"}->Id}
 144  Queue: Approvals
 145  Content-Type: text/plain
 146  Content:
 147  Your approval is requred for this ticket, too.
 148  ENDOFCONTENT
 149
 150 =head2 Acceptable fields
 151
 152 A complete list of acceptable fields for this beastie:
 153
 154
 155     *  Queue           => Name or id# of a queue
 156        Subject         => A text string
 157      ! Status          => A valid status. defaults to 'new'
 158        Due             => Dates can be specified in seconds since the epoch
 159                           to be handled literally or in a semi-free textual
 160                           format which RT will attempt to parse.
 161
 162
 163
 164        Starts          =>
 165        Started         =>
 166        Resolved        =>
 167        Owner           => Username or id of an RT user who can and should own
 168                           this ticket
 169    +   Requestor       => Email address
 170    +   Cc              => Email address
 171    +   AdminCc         => Email address
 172        TimeWorked      =>
 173        TimeEstimated   =>
 174        TimeLeft        =>
 175        InitialPriority =>
 176        FinalPriority   =>
 177        Type            =>
 178     +! DependsOn       =>
 179     +! DependedOnBy    =>
 180     +! RefersTo        =>
 181     +! ReferredToBy    =>
 182     +! Members         =>
 183     +! MemberOf        =>
 184        Content         => content. Can extend to multiple lines. Everything
 185                           within a template after a Content: header is treated
 186                           as content until we hit a line containing only
 187                           ENDOFCONTENT
 188        ContentType     => the content-type of the Content field
 189        CustomField-<id#> => custom field value
 190
 191 Fields marked with an * are required.
 192
 193 Fields marked with a + man have multiple values, simply
 194 by repeating the fieldname on a new line with an additional value.
 195
 196 Fields marked with a ! are postponed to be processed after all
 197 tickets in the same actions are created.  Except for 'Status', those
 198 field can also take a ticket name within the same action (i.e.
 199 the identifiers after ==Create-Ticket), instead of raw Ticket ID
 200 numbers.
 201
 202 When parsed, field names are converted to lowercase and have -s stripped.
 203 Refers-To, RefersTo, refersto, refers-to and r-e-f-er-s-tO will all
 204 be treated as the same thing.
 205
 206
 207 =begin testing
 208
 209 ok (require RT::Action::CreateTickets);
 210 use_ok(RT::Scrip);
 211 use_ok(RT::Template);
 212 use_ok(RT::ScripAction);
 213 use_ok(RT::ScripCondition);
 214 use_ok(RT::Ticket);
 215
 216 my $approvalsq = RT::Queue->new($RT::SystemUser);
 217 $approvalsq->Create(Name => 'Approvals');
 218 ok ($approvalsq->Id, "Created Approvals test queue");
 219
 220
 221 my $approvals =
 222 '===Create-Ticket: approval
 223 {  my $name = "HR";
 224      my $groups = RT::Groups->new($RT::SystemUser);
 225    $groups->LimitToUserDefinedGroups();
 226    $groups->Limit(FIELD => "Name", OPERATOR => "=", VALUE => "$name");
 227    $groups->WithMember($Transaction->CreatorObj->Id);
 228
 229    my $groupid = $groups->First->Id;
 230
 231    my $adminccs = RT::Users->new($RT::SystemUser);
 232    $adminccs->WhoHaveRight(Right => "AdminGroup", IncludeSystemRights => undef, IncludeSuperusers => 0, IncludeSubgroupMembers => 0, Object => $groups->First);
 233
 234     my @admins;
 235     while (my $admin = $adminccs->Next) {
 236         push (@admins, $admin->EmailAddress);
 237     }
 238 }
 239 Queue: Approvals
 240 Type: Approval
 241 AdminCc: {join ("\nAdminCc: ",@admins) }
 242 Depended-On-By: TOP
 243 Refers-To:  TOP
 244 Subject: Approval for ticket: {$Tickets{"TOP"}->Id} - {$Tickets{"TOP"}->Subject}
 245 Due: {time + 86400}
 246 Content-Type: text/plain
 247 Content: Your approval is requested for the ticket {$Tickets{"TOP"}->Id}: {$Tickets{"TOP"}->Subject}
 248 Blah
 249 Blah
 250 ENDOFCONTENT
 251 ===Create-Ticket: two
 252 Subject: Manager approval.
 253 Depends-On: {$Tickets{"approval"}->Id}
 254 Queue: Approvals
 255 Content-Type: text/plain
 256 Content:
 257 Your minion approved this ticket. you ok with that?
 258 ENDOFCONTENT
 259 ';
 260
 261 ok ($approvals =~ /Content/, "Read in the approvals template");
 262
 263 my $apptemp = RT::Template->new($RT::SystemUser);
 264 $apptemp->Create( Content => $approvals, Name => "Approvals", Queue => "0");
 265
 266 ok ($apptemp->Id);
 267
 268 my $q = RT::Queue->new($RT::SystemUser);
 269 $q->Create(Name => 'WorkflowTest');
 270 ok ($q->Id, "Created workflow test queue");
 271
 272 my $scrip = RT::Scrip->new($RT::SystemUser);
 273 my ($sval, $smsg) =$scrip->Create( ScripCondition => 'On Transaction',
 274                 ScripAction => 'Create Tickets',
 275                 Template => 'Approvals',
 276                 Queue => $q->Id);
 277 ok ($sval, $smsg);
 278 ok ($scrip->Id, "Created the scrip");
 279 ok ($scrip->TemplateObj->Id, "Created the scrip template");
 280 ok ($scrip->ConditionObj->Id, "Created the scrip condition");
 281 ok ($scrip->ActionObj->Id, "Created the scrip action");
 282
 283 my $t = RT::Ticket->new($RT::SystemUser);
 284 $t->Create(Subject => "Sample workflow test",
 285            Owner => "root",
 286            Queue => $q->Id);
 287
 288
 289 =end testing
 290
 291
 292 =head1 AUTHOR
 293
 294 Jesse Vincent <jesse@bestpractical.com>
 295
 296 =head1 SEE ALSO
 297
 298 perl(1).
 299
 300 =cut
 301
 302 my %LINKTYPEMAP = (
 303     MemberOf => { Type => 'MemberOf',
 304                   Mode => 'Target', },
 305     Members => { Type => 'MemberOf',
 306                  Mode => 'Base', },
 307     HasMember => { Type => 'MemberOf',
 308                    Mode => 'Base', },
 309     RefersTo => { Type => 'RefersTo',
 310                   Mode => 'Target', },
 311     ReferredToBy => { Type => 'RefersTo',
 312                       Mode => 'Base', },
 313     DependsOn => { Type => 'DependsOn',
 314                    Mode => 'Target', },
 315     DependedOnBy => { Type => 'DependsOn',
 316                       Mode => 'Base', },
 317
 318 );
 319
 320 # {{{ Scrip methods (Commit, Prepare)
 321
 322 # {{{ sub Commit
 323 #Do what we need to do and send it out.
 324 sub Commit {
 325     my $self = shift;
 326     my (@links, @postponed);
 327
 328     # XXX: cargo cult programming that works. i'll be back.
 329     use bytes;
 330
 331     # Create all the tickets we care about
 332     return(1) unless $self->TicketObj->Type eq 'ticket';
 333
 334     %T::Tickets = ();
 335
 336     foreach my $template_id ( @{ $self->{'template_order'} } ) {
 337         $T::Tickets{'TOP'} = $T::TOP = $self->TicketObj;
 338         $RT::Logger->debug("Workflow: processing $template_id of $T::TOP");
 339
 340         $T::ID = $template_id;
 341         @T::AllID = @{ $self->{'template_order'} };
 342
 343         my $template = Text::Template->new(
 344               TYPE   => 'STRING',
 345               SOURCE => $self->{'templates'}->{$template_id}
 346         );
 347
 348         $RT::Logger->debug("Workflow: evaluating\n$self->{templates}{$template_id}");
 349
 350         my $err;
 351         my $filled_in = $template->fill_in( PACKAGE => 'T', BROKEN => sub {
 352             $err = { @_ }->{error};
 353         } );
 354
 355         $RT::Logger->debug("Workflow: yielding\n$filled_in");
 356
 357         if ($err) {
 358             $RT::Logger->error("Ticket creation failed for ".$self->TicketObj->Id." ".$err);
 359             while (my ($k, $v) = each %T::X) {
 360                 $RT::Logger->debug("Eliminating $template_id from ${k}'s parents.");
 361                 delete $v->{$template_id};
 362             }
 363             next;
 364         }
 365
 366         my %args;
 367         my @lines = ( split ( /\n/, $filled_in ) );
 368         while ( defined(my $line = shift @lines) ) {
 369             if ( $line =~ /^(.*?):(?:\s+(.*))?$/ ) {
 370                 my $value = $2;
 371                 my $tag = lc ($1);
 372                 $tag =~ s/-//g;
 373
 374                 if (ref($args{$tag})) { #If it's an array, we want to push the value
 375                     push @{$args{$tag}}, $value;
 376                 }
 377                 elsif (defined ($args{$tag})) { #if we're about to get a second value, make it an array
 378                     $args{$tag} = [$args{$tag}, $value];
 379                 }
 380                 else { #if there's nothing there, just set the value
 381                     $args{ $tag } = $value;
 382                 }
 383
 384                 if ( $tag eq 'content' ) { #just build up the content
 385                         # convert it to an array
 386                         $args{$tag} = defined($value) ? [ $value."\n" ] : [];
 387                       while ( defined(my $l = shift @lines) ) {
 388                         last if ($l =~  /^ENDOFCONTENT\s*$/) ;
 389                         push @{$args{'content'}}, $l."\n";
 390                         }
 391                 }
 392             }
 393         }
 394
 395         foreach my $date qw(due starts started resolved) {
 396             my $dateobj = RT::Date->new($RT::SystemUser);
 397             next unless $args{$date};
 398             if ($args{$date} =~ /^\d+$/) {
 399                 $dateobj->Set(Format => 'unix', Value => $args{$date});
 400             } else {
 401                 $dateobj->Set(Format => 'unknown', Value => $args{$date});
 402             }
 403             $args{$date} = $dateobj->ISO;
 404         }
 405         my $mimeobj = MIME::Entity->new();
 406         $mimeobj->build(Type => $args{'contenttype'},
 407                         Data => $args{'content'});
 408         # Now we have a %args to work with.
 409         # Make sure we have at least the minimum set of
 410         # reasonable data and do our thang
 411         $T::Tickets{$template_id} ||= RT::Ticket->new($RT::SystemUser);
 412
 413         # Deferred processing
 414         push @links, (
 415             $T::Tickets{$template_id}, {
 416                 DependsOn               => $args{'dependson'},
 417                 DependedOnBy    => $args{'dependedonby'},
 418                 RefersTo                => $args{'refersto'},
 419                 ReferredToBy    => $args{'referredtoby'},
 420                 Members         => $args{'members'},
 421                 MemberOf                => $args{'memberof'},
 422             }
 423         );
 424
 425         push @postponed, (
 426             # Status is postponed so we don't violate dependencies
 427             $T::Tickets{$template_id}, {
 428                 Status          => $args{'status'},
 429             }
 430         );
 431
 432         $args{'requestor'} ||= $self->TicketObj->Requestors->MemberEmailAddresses;
 433
 434         $args{'type'} ||= 'ticket';
 435
 436         my %ticketargs = ( Queue => $args{'queue'},
 437                       Subject=> $args{'subject'},
 438                     Status => 'new',
 439                     Due => $args{'due'},
 440                     Starts => $args{'starts'},
 441                     Started => $args{'started'},
 442                     Resolved => $args{'resolved'},
 443                     Owner => $args{'owner'},
 444                     Requestor => $args{'requestor'},
 445                     Cc => $args{'cc'},
 446                     AdminCc=> $args{'admincc'},
 447                     TimeWorked =>$args{'timeworked'},
 448                     TimeEstimated =>$args{'timeestimated'},
 449                     TimeLeft =>$args{'timeleft'},
 450                     InitialPriority => $args{'initialpriority'},
 451                     FinalPriority => $args{'finalpriority'},
 452                     Type => $args{'type'},
 453                     MIMEObj => $mimeobj);
 454
 455
 456         foreach my $key (keys(%args)) {
 457             $key =~ /^customfield(\d+)$/ or next;
 458             $ticketargs{ "CustomField-" . $1 } = $args{$key};
 459         }
 460
 461         my ($id, $transid, $msg) = $T::Tickets{$template_id}->Create(%ticketargs);
 462         if (!$id) {
 463             $RT::Logger->error(
 464                 "Couldn't create related ticket $template_id for ".
 465                 $self->TicketObj->Id." ".$msg
 466             );
 467             next;
 468         }
 469
 470         $RT::Logger->debug("Assigned $template_id with $id");
 471         $T::Tickets{$template_id}->SetOriginObj($self->TicketObj)
 472             if $T::Tickets{$template_id}->can('SetOriginObj');
 473     }
 474
 475     # postprocessing: add links
 476
 477     while (my $ticket = shift(@links)) {
 478         $RT::Logger->debug("Handling links for " . $ticket->Id);
 479         my %args = %{shift(@links)};
 480
 481         foreach my $type ( keys %LINKTYPEMAP ) {
 482             next unless (defined $args{$type});
 483             foreach my $link (
 484                 ref( $args{$type} ) ? @{ $args{$type} } : ( $args{$type} ) )
 485             {
 486                 if (!exists $T::Tickets{$link}) {
 487                     $RT::Logger->debug("Skipping $type link for $link (non-existent)");
 488                     next;
 489                 }
 490                 $RT::Logger->debug("Building $type link for $link: " . $T::Tickets{$link}->Id);
 491                 $link = $T::Tickets{$link}->Id;
 492
 493                 my ( $wval, $wmsg ) = $ticket->AddLink(
 494                     Type                          => $LINKTYPEMAP{$type}->{'Type'},
 495                     $LINKTYPEMAP{$type}->{'Mode'} => $link,
 496                     Silent                        => 1
 497                 );
 498
 499                 $RT::Logger->warning("AddLink thru $link failed: $wmsg") unless $wval;
 500                 # push @non_fatal_errors, $wmsg unless ($wval);
 501             }
 502
 503         }
 504     }
 505
 506     # postponed actions -- Status only, currently
 507     while (my $ticket = shift(@postponed)) {
 508         $RT::Logger->debug("Handling postponed actions for $ticket");
 509         my %args = %{shift(@postponed)};
 510
 511         $ticket->SetStatus($args{Status}) if defined $args{Status};
 512     }
 513
 514     return(1);
 515 }
 516 # }}}
 517
 518 # {{{ sub Prepare
 519
 520 sub Prepare  {
 521   my $self = shift;
 522
 523   unless ($self->TemplateObj) {
 524     $RT::Logger->warning("No template object handed to $self\n");
 525   }
 526
 527   unless ($self->TransactionObj) {
 528     $RT::Logger->warning("No transaction object handed to $self\n");
 529
 530   }
 531
 532   unless ($self->TicketObj) {
 533     $RT::Logger->warning("No ticket object handed to $self\n");
 534
 535   }
 536
 537
 538
 539
 540 my $template_id;
 541 foreach my $line (split(/\n/,$self->TemplateObj->Content)) {
 542         if ($line =~ /^===Create-Ticket: (.*)$/) {
 543                 $template_id = $1;
 544                 push @{$self->{'template_order'}},$template_id;
 545         } else {
 546                 $self->{'templates'}->{$template_id} .= $line."\n";
 547         }
 548
 549
 550 }
 551
 552   return 1;
 553
 554 }
 555
 556 # }}}
 557
 558 # }}}
 559
 560 eval "require RT::Action::CreateTickets_Vendor";
 561 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/CreateTickets_Vendor.pm});
 562 eval "require RT::Action::CreateTickets_Local";
 563 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/CreateTickets_Local.pm});
 564
 565 1;
 566