rt/lib/RT/Action/CreateTickets.pm

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