rt/lib/RT/Action/CreateTickets.pm

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