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     );
 790
 791     if ( $args{content} ) {
 792         my $mimeobj = MIME::Entity->new();
 793         $mimeobj->build(
 794             Type => $args{'contenttype'} || 'text/plain',
 795             Data => $args{'content'}
 796         );
 797         $ticketargs{MIMEObj} = $mimeobj;
 798         $ticketargs{UpdateType} = $args{'updatetype'} || 'correspond';
 799     }
 800
 801     foreach my $tag ( keys(%args) ) {
 802         # if the tag was added later, skip it
 803         my $orig_tag = $original_tags{$tag} or next;
 804         if ( $orig_tag =~ /^customfield-?(\d+)$/i ) {
 805             $ticketargs{ "CustomField-" . $1 } = $args{$tag};
 806         } elsif ( $orig_tag =~ /^(?:customfield|cf)-?(.+)$/i ) {
 807             my $cf = RT::CustomField->new( $self->CurrentUser );
 808             $cf->LoadByName( Name => $1, Queue => $ticketargs{Queue} );
 809             $cf->LoadByName( Name => $1, Queue => 0 ) unless $cf->id;
 810             next unless $cf->id;
 811             $ticketargs{ "CustomField-" . $cf->id } = $args{$tag};
 812         } elsif ($orig_tag) {
 813             my $cf = RT::CustomField->new( $self->CurrentUser );
 814             $cf->LoadByName( Name => $orig_tag, Queue => $ticketargs{Queue} );
 815             $cf->LoadByName( Name => $orig_tag, Queue => 0 ) unless $cf->id;
 816             next unless $cf->id;
 817             $ticketargs{ "CustomField-" . $cf->id } = $args{$tag};
 818
 819         }
 820     }
 821
 822     $self->GetDeferred( \%args, $template_id, $links, $postponed );
 823
 824     return $TicketObj, \%ticketargs;
 825 }
 826
 827
 828 =head2 _ParseXSVTemplate
 829
 830 Parses a tab or comma delimited template. Should only ever be called by
 831 L</Parse>.
 832
 833 =cut
 834
 835 sub _ParseXSVTemplate {
 836     my $self = shift;
 837     my %args = (@_);
 838
 839     use Regexp::Common qw(delimited);
 840     my($first, $content) = split(/\r?\n/, $args{'Content'}, 2);
 841
 842     my $delimiter;
 843     if ( $first =~ /\t/ ) {
 844         $delimiter = "\t";
 845     } else {
 846         $delimiter = ',';
 847     }
 848     my @fields = split( /$delimiter/, $first );
 849
 850     my $delimiter_re = qr[$delimiter];
 851     my $justquoted = qr[$RE{quoted}];
 852
 853     # Used to generate automatic template ids
 854     my $autoid = 1;
 855
 856   LINE:
 857     while ($content) {
 858         $content =~ s/^(\s*\r?\n)+//;
 859
 860         # Keep track of Queue and Requestor, so we can provide defaults
 861         my $queue;
 862         my $requestor;
 863
 864         # The template for this line
 865         my $template;
 866
 867         # What column we're on
 868         my $i = 0;
 869
 870         # If the last iteration was the end of the line
 871         my $EOL = 0;
 872
 873         # The template id
 874         my $template_id;
 875
 876       COLUMN:
 877         while (not $EOL and length $content and $content =~ s/^($justquoted|.*?)($delimiter_re|$)//smix) {
 878             $EOL = not $2;
 879
 880             # Strip off quotes, if they exist
 881             my $value = $1;
 882             if ( $value =~ /^$RE{delimited}{-delim=>qq{\'\"}}$/ ) {
 883                 substr( $value, 0,  1 ) = "";
 884                 substr( $value, -1, 1 ) = "";
 885             }
 886
 887             # What column is this?
 888             my $field = $fields[$i++];
 889             next COLUMN unless $field =~ /\S/;
 890             $field =~ s/^\s//;
 891             $field =~ s/\s$//;
 892
 893             if ( $field =~ /^id$/i ) {
 894                 # Special case if this is the ID column
 895                 if ( $value =~ /^\d+$/ ) {
 896                     $template_id = 'update-' . $value;
 897                     push @{ $self->{'update_tickets'} }, $template_id;
 898                 } elsif ( $value =~ /^#base-(\d+)$/ ) {
 899                     $template_id = 'base-' . $1;
 900                     push @{ $self->{'base_tickets'} }, $template_id;
 901                 } elsif ( $value =~ /\S/ ) {
 902                     $template_id = 'create-' . $value;
 903                     push @{ $self->{'create_tickets'} }, $template_id;
 904                 }
 905             } else {
 906                 # Some translations
 907                 if (   $field =~ /^Body$/i
 908                     || $field =~ /^Data$/i
 909                     || $field =~ /^Message$/i )
 910                   {
 911                   $field = 'Content';
 912                 } elsif ( $field =~ /^Summary$/i ) {
 913                     $field = 'Subject';
 914                 } elsif ( $field =~ /^Queue$/i ) {
 915                     # Note that we found a queue
 916                     $queue = 1;
 917                     $value ||= $args{'Queue'};
 918                 } elsif ( $field =~ /^Requestors?$/i ) {
 919                     $field = 'Requestor'; # Remove plural
 920                     # Note that we found a requestor
 921                     $requestor = 1;
 922                     $value ||= $args{'Requestor'};
 923                 }
 924
 925                 # Tack onto the end of the template
 926                 $template .= $field . ": ";
 927                 $template .= (defined $value ? $value : "");
 928                 $template .= "\n";
 929                 $template .= "ENDOFCONTENT\n"
 930                   if $field =~ /^Content$/i;
 931             }
 932         }
 933
 934         # Ignore blank lines
 935         next unless $template;
 936
 937         # If we didn't find a queue of requestor, tack on the defaults
 938         if ( !$queue && $args{'Queue'} ) {
 939             $template .= "Queue: $args{'Queue'}\n";
 940         }
 941         if ( !$requestor && $args{'Requestor'} ) {
 942             $template .= "Requestor: $args{'Requestor'}\n";
 943         }
 944
 945         # If we never found an ID, come up with one
 946         unless ($template_id) {
 947             $autoid++ while exists $self->{'templates'}->{"create-auto-$autoid"};
 948             $template_id = "create-auto-$autoid";
 949             # Also, it's a ticket to create
 950             push @{ $self->{'create_tickets'} }, $template_id;
 951         }
 952
 953         # Save the template we generated
 954         $self->{'templates'}->{$template_id} = $template;
 955
 956     }
 957 }
 958
 959 sub GetDeferred {
 960     my $self      = shift;
 961     my $args      = shift;
 962     my $id        = shift;
 963     my $links     = shift;
 964     my $postponed = shift;
 965
 966     # Deferred processing
 967     push @$links,
 968         (
 969         $id,
 970         {   DependsOn    => $args->{'dependson'},
 971             DependedOnBy => $args->{'dependedonby'},
 972             RefersTo     => $args->{'refersto'},
 973             ReferredToBy => $args->{'referredtoby'},
 974             Children     => $args->{'children'},
 975             Parents      => $args->{'parents'},
 976         }
 977         );
 978
 979     push @$postponed, (
 980
 981         # Status is postponed so we don't violate dependencies
 982         $id, { Status => $args->{'status'}, }
 983     );
 984 }
 985
 986 sub GetUpdateTemplate {
 987     my $self = shift;
 988     my $t    = shift;
 989
 990     my $string;
 991     $string .= "Queue: " . $t->QueueObj->Name . "\n";
 992     $string .= "Subject: " . $t->Subject . "\n";
 993     $string .= "Status: " . $t->Status . "\n";
 994     $string .= "UpdateType: correspond\n";
 995     $string .= "Content: \n";
 996     $string .= "ENDOFCONTENT\n";
 997     $string .= "Due: " . $t->DueObj->AsString . "\n";
 998     $string .= "Starts: " . $t->StartsObj->AsString . "\n";
 999     $string .= "Started: " . $t->StartedObj->AsString . "\n";
1000     $string .= "Resolved: " . $t->ResolvedObj->AsString . "\n";
1001     $string .= "Owner: " . $t->OwnerObj->Name . "\n";
1002     $string .= "Requestor: " . $t->RequestorAddresses . "\n";
1003     $string .= "Cc: " . $t->CcAddresses . "\n";
1004     $string .= "AdminCc: " . $t->AdminCcAddresses . "\n";
1005     $string .= "TimeWorked: " . $t->TimeWorked . "\n";
1006     $string .= "TimeEstimated: " . $t->TimeEstimated . "\n";
1007     $string .= "TimeLeft: " . $t->TimeLeft . "\n";
1008     $string .= "InitialPriority: " . $t->Priority . "\n";
1009     $string .= "FinalPriority: " . $t->FinalPriority . "\n";
1010
1011     foreach my $type ( sort keys %LINKTYPEMAP ) {
1012
1013         # don't display duplicates
1014         if (   $type eq "HasMember"
1015             || $type eq "Members"
1016             || $type eq "MemberOf" )
1017         {
1018             next;
1019         }
1020         $string .= "$type: ";
1021
1022         my $mode   = $LINKTYPEMAP{$type}->{Mode};
1023         my $method = $LINKTYPEMAP{$type}->{Type};
1024
1025         my $links = '';
1026         while ( my $link = $t->$method->Next ) {
1027             $links .= ", " if $links;
1028
1029             my $object = $mode . "Obj";
1030             my $member = $link->$object;
1031             $links .= $member->Id if $member;
1032         }
1033         $string .= $links;
1034         $string .= "\n";
1035     }
1036
1037     return $string;
1038 }
1039
1040 sub GetBaseTemplate {
1041     my $self = shift;
1042     my $t    = shift;
1043
1044     my $string;
1045     $string .= "Queue: " . $t->Queue . "\n";
1046     $string .= "Subject: " . $t->Subject . "\n";
1047     $string .= "Status: " . $t->Status . "\n";
1048     $string .= "Due: " . $t->DueObj->Unix . "\n";
1049     $string .= "Starts: " . $t->StartsObj->Unix . "\n";
1050     $string .= "Started: " . $t->StartedObj->Unix . "\n";
1051     $string .= "Resolved: " . $t->ResolvedObj->Unix . "\n";
1052     $string .= "Owner: " . $t->Owner . "\n";
1053     $string .= "Requestor: " . $t->RequestorAddresses . "\n";
1054     $string .= "Cc: " . $t->CcAddresses . "\n";
1055     $string .= "AdminCc: " . $t->AdminCcAddresses . "\n";
1056     $string .= "TimeWorked: " . $t->TimeWorked . "\n";
1057     $string .= "TimeEstimated: " . $t->TimeEstimated . "\n";
1058     $string .= "TimeLeft: " . $t->TimeLeft . "\n";
1059     $string .= "InitialPriority: " . $t->Priority . "\n";
1060     $string .= "FinalPriority: " . $t->FinalPriority . "\n";
1061
1062     return $string;
1063 }
1064
1065 sub GetCreateTemplate {
1066     my $self = shift;
1067
1068     my $string;
1069
1070     $string .= "Queue: General\n";
1071     $string .= "Subject: \n";
1072     $string .= "Status: new\n";
1073     $string .= "Content: \n";
1074     $string .= "ENDOFCONTENT\n";
1075     $string .= "Due: \n";
1076     $string .= "Starts: \n";
1077     $string .= "Started: \n";
1078     $string .= "Resolved: \n";
1079     $string .= "Owner: \n";
1080     $string .= "Requestor: \n";
1081     $string .= "Cc: \n";
1082     $string .= "AdminCc:\n";
1083     $string .= "TimeWorked: \n";
1084     $string .= "TimeEstimated: \n";
1085     $string .= "TimeLeft: \n";
1086     $string .= "InitialPriority: \n";
1087     $string .= "FinalPriority: \n";
1088
1089     foreach my $type ( keys %LINKTYPEMAP ) {
1090
1091         # don't display duplicates
1092         if (   $type eq "HasMember"
1093             || $type eq 'Members'
1094             || $type eq 'MemberOf' )
1095         {
1096             next;
1097         }
1098         $string .= "$type: \n";
1099     }
1100     return $string;
1101 }
1102
1103 sub UpdateWatchers {
1104     my $self   = shift;
1105     my $ticket = shift;
1106     my $args   = shift;
1107
1108     my @results;
1109
1110     foreach my $type (qw(Requestor Cc AdminCc)) {
1111         my $method  = $type . 'Addresses';
1112         my $oldaddr = $ticket->$method;
1113
1114         # Skip unless we have a defined field
1115         next unless defined $args->{$type};
1116         my $newaddr = $args->{$type};
1117
1118         my @old = split( /,\s*/, $oldaddr );
1119         my @new;
1120         for (ref $newaddr ? @{$newaddr} : split( /,\s*/, $newaddr )) {
1121             # Sometimes these are email addresses, sometimes they're
1122             # users.  Try to guess which is which, as we want to deal
1123             # with email addresses if at all possible.
1124             if (/^\S+@\S+$/) {
1125                 push @new, $_;
1126             } else {
1127                 # It doesn't look like an email address.  Try to load it.
1128                 my $user = RT::User->new($self->CurrentUser);
1129                 $user->Load($_);
1130                 if ($user->Id) {
1131                     push @new, $user->EmailAddress;
1132                 } else {
1133                     push @new, $_;
1134                 }
1135             }
1136         }
1137
1138         my %oldhash = map { $_ => 1 } @old;
1139         my %newhash = map { $_ => 1 } @new;
1140
1141         my @add    = grep( !defined $oldhash{$_}, @new );
1142         my @delete = grep( !defined $newhash{$_}, @old );
1143
1144         foreach (@add) {
1145             my ( $val, $msg ) = $ticket->AddWatcher(
1146                 Type  => $type,
1147                 Email => $_
1148             );
1149
1150             push @results,
1151                 $ticket->loc( "Ticket [_1]", $ticket->Id ) . ': ' . $msg;
1152         }
1153
1154         foreach (@delete) {
1155             my ( $val, $msg ) = $ticket->DeleteWatcher(
1156                 Type  => $type,
1157                 Email => $_
1158             );
1159             push @results,
1160                 $ticket->loc( "Ticket [_1]", $ticket->Id ) . ': ' . $msg;
1161         }
1162     }
1163     return @results;
1164 }
1165
1166 sub UpdateCustomFields {
1167     my $self   = shift;
1168     my $ticket = shift;
1169     my $args   = shift;
1170
1171     my @results;
1172     foreach my $arg (keys %{$args}) {
1173         next unless $arg =~ /^CustomField-(\d+)$/;
1174         my $cf = $1;
1175
1176         my $CustomFieldObj = RT::CustomField->new($self->CurrentUser);
1177         $CustomFieldObj->SetContextObject( $ticket );
1178         $CustomFieldObj->LoadById($cf);
1179
1180         my @values;
1181         if ($CustomFieldObj->Type =~ /text/i) { # Both Text and Wikitext
1182             @values = ($args->{$arg});
1183         } else {
1184             @values = split /\n/, $args->{$arg};
1185         }
1186
1187         if ( ($CustomFieldObj->Type eq 'Freeform'
1188               && ! $CustomFieldObj->SingleValue) ||
1189               $CustomFieldObj->Type =~ /text/i) {
1190             foreach my $val (@values) {
1191                 $val =~ s/\r//g;
1192             }
1193         }
1194
1195         foreach my $value (@values) {
1196             next unless length($value);
1197             my ( $val, $msg ) = $ticket->AddCustomFieldValue(
1198                 Field => $cf,
1199                 Value => $value
1200             );
1201             push ( @results, $msg );
1202         }
1203     }
1204     return @results;
1205 }
1206
1207 sub PostProcess {
1208     my $self      = shift;
1209     my $links     = shift;
1210     my $postponed = shift;
1211
1212     # postprocessing: add links
1213
1214     while ( my $template_id = shift(@$links) ) {
1215         my $ticket = $T::Tickets{$template_id};
1216         $RT::Logger->debug( "Handling links for " . $ticket->Id );
1217         my %args = %{ shift(@$links) };
1218
1219         foreach my $type ( keys %LINKTYPEMAP ) {
1220             next unless ( defined $args{$type} );
1221             foreach my $link (
1222                 ref( $args{$type} ) ? @{ $args{$type} } : ( $args{$type} ) )
1223             {
1224                 next unless $link;
1225
1226                 if ( $link =~ /^TOP$/i ) {
1227                     $RT::Logger->debug( "Building $type link for $link: "
1228                             . $T::Tickets{TOP}->Id );
1229                     $link = $T::Tickets{TOP}->Id;
1230
1231                 } elsif ( $link !~ m/^\d+$/ ) {
1232                     my $key = "create-$link";
1233                     if ( !exists $T::Tickets{$key} ) {
1234                         $RT::Logger->debug(
1235                             "Skipping $type link for $key (non-existent)");
1236                         next;
1237                     }
1238                     $RT::Logger->debug( "Building $type link for $link: "
1239                             . $T::Tickets{$key}->Id );
1240                     $link = $T::Tickets{$key}->Id;
1241                 } else {
1242                     $RT::Logger->debug("Building $type link for $link");
1243                 }
1244
1245                 my ( $wval, $wmsg ) = $ticket->AddLink(
1246                     Type => $LINKTYPEMAP{$type}->{'Type'},
1247                     $LINKTYPEMAP{$type}->{'Mode'} => $link,
1248                     Silent                        => 1
1249                 );
1250
1251                 $RT::Logger->warning("AddLink thru $link failed: $wmsg")
1252                     unless $wval;
1253
1254                 # push @non_fatal_errors, $wmsg unless ($wval);
1255             }
1256
1257         }
1258     }
1259
1260     # postponed actions -- Status only, currently
1261     while ( my $template_id = shift(@$postponed) ) {
1262         my $ticket = $T::Tickets{$template_id};
1263         $RT::Logger->debug( "Handling postponed actions for " . $ticket->id );
1264         my %args = %{ shift(@$postponed) };
1265         $ticket->SetStatus( $args{Status} ) if defined $args{Status};
1266     }
1267
1268 }
1269
1270 RT::Base->_ImportOverlays();
1271
1272 1;
1273