rt/lib/RT/Action/CreateTickets.pm

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