rt/lib/RT/Action/CreateTickets.pm

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