This commit was manufactured by cvs2svn to create tag
[freeside.git] / rt / lib / RT / Action / CreateTickets.pm
diff --git a/rt/lib/RT/Action/CreateTickets.pm b/rt/lib/RT/Action/CreateTickets.pm
deleted file mode 100644 (file)
index e1c6f4a..0000000
+++ /dev/null
@@ -1,566 +0,0 @@
-# BEGIN LICENSE BLOCK
-# 
-# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
-# 
-# (Except where explictly superceded by other copyright notices)
-# 
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-# 
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-# General Public License for more details.
-# 
-# Unless otherwise specified, all modifications, corrections or
-# extensions to this work which alter its source code become the
-# property of Best Practical Solutions, LLC when submitted for
-# inclusion in the work.
-# 
-# 
-# END LICENSE BLOCK
-package RT::Action::CreateTickets;
-require RT::Action::Generic;
-
-use strict;
-use vars qw/@ISA/;
-@ISA = qw(RT::Action::Generic);
-
-use MIME::Entity;
-
-=head1 NAME
-
- RT::Action::CreateTickets
-
-Create one or more tickets according to an externally supplied template.
-
-
-=head1 SYNOPSIS
-
- ===Create-Ticket: codereview
- Subject: Code review for {$Tickets{'TOP'}->Subject}
- Depended-On-By: TOP
- Content: Someone has created a ticket. you should review and approve it,
- so they can finish their work
- ENDOFCONTENT
-
-=head1 DESCRIPTION
-
-
-Using the "CreateTickets" ScripAction and mandatory dependencies, RT now has 
-the ability to model complex workflow. When a ticket is created in a queue
-that has a "CreateTickets" scripaction, that ScripAction parses its "Template"
-
-
-
-=head2 FORMAT
-
-CreateTickets uses the template as a template for an ordered set of tickets 
-to create. The basic format is as follows:
-
-
- ===Create-Ticket: identifier
- Param: Value
- Param2: Value
- Param3: Value
- Content: Blah
- blah
- blah
- ENDOFCONTENT
- ===Create-Ticket: id2
- Param: Value
- Content: Blah
- ENDOFCONTENT
-
-
-Each ===Create-Ticket: section is evaluated as its own 
-Text::Template object, which means that you can embed snippets
-of perl inside the Text::Template using {} delimiters, but that 
-such sections absolutely can not span a ===Create-Ticket boundary.
-
-After each ticket is created, it's stuffed into a hash called %Tickets
-so as to be available during the creation of other tickets during the same 
-ScripAction.  The hash is prepopulated with the ticket which triggered the 
-ScripAction as $Tickets{'TOP'}; you can also access that ticket using the
-shorthand TOP.
-
-A simple example:
-
- ===Create-Ticket: codereview
- Subject: Code review for {$Tickets{'TOP'}->Subject}
- Depended-On-By: TOP
- Content: Someone has created a ticket. you should review and approve it,
- so they can finish their work
- ENDOFCONTENT
-
-
-
-A convoluted example
-
- ===Create-Ticket: approval
- { # Find out who the administrators of the group called "HR" 
-   # of which the creator of this ticket is a member
-    my $name = "HR";
-   
-    my $groups = RT::Groups->new($RT::SystemUser);
-    $groups->LimitToUserDefinedGroups();
-    $groups->Limit(FIELD => "Name", OPERATOR => "=", VALUE => "$name");
-    $groups->WithMember($TransactionObj->CreatorObj->Id);
-    my $groupid = $groups->First->Id;
-    my $adminccs = RT::Users->new($RT::SystemUser);
-    $adminccs->WhoHaveRight(
-       Right => "AdminGroup",
-       Object =>$groups->First,
-       IncludeSystemRights => undef,
-       IncludeSuperusers => 0,
-       IncludeSubgroupMembers => 0,
-    );
-     my @admins;
-     while (my $admin = $adminccs->Next) {
-         push (@admins, $admin->EmailAddress); 
-     }
- }
- Queue: Approvals
- Type: Approval
- AdminCc: {join ("\nAdminCc: ",@admins) }
- Depended-On-By: TOP
- Refers-To: TOP
- Subject: Approval for ticket: {$Tickets{"TOP"}->Id} - {$Tickets{"TOP"}->Subject}
- Due: {time + 86400}
- Content-Type: text/plain
- Content: Your approval is requested for the ticket {$Tickets{"TOP"}->Id}: {$Tickets{"TOP"}->Subject}
- Blah
- Blah
- ENDOFCONTENT
- ===Create-Ticket: two
- Subject: Manager approval
- Depended-On-By: TOP
- Refers-On: {$Tickets{"approval"}->Id}
- Queue: Approvals
- Content-Type: text/plain
- Content: 
- Your approval is requred for this ticket, too.
- ENDOFCONTENT
-=head2 Acceptable fields
-
-A complete list of acceptable fields for this beastie:
-
-
-    *  Queue           => Name or id# of a queue
-       Subject         => A text string
-     ! Status          => A valid status. defaults to 'new'
-       Due             => Dates can be specified in seconds since the epoch
-                          to be handled literally or in a semi-free textual
-                          format which RT will attempt to parse.
-                        
-                          
-                          
-       Starts          => 
-       Started         => 
-       Resolved        => 
-       Owner           => Username or id of an RT user who can and should own 
-                          this ticket
-   +   Requestor       => Email address
-   +   Cc              => Email address 
-   +   AdminCc         => Email address 
-       TimeWorked      => 
-       TimeEstimated   => 
-       TimeLeft        => 
-       InitialPriority => 
-       FinalPriority   => 
-       Type            => 
-    +! DependsOn       => 
-    +! DependedOnBy    =>
-    +! RefersTo        =>
-    +! ReferredToBy    => 
-    +! Members         =>
-    +! MemberOf        => 
-       Content         => content. Can extend to multiple lines. Everything
-                          within a template after a Content: header is treated
-                          as content until we hit a line containing only 
-                          ENDOFCONTENT
-       ContentType     => the content-type of the Content field
-       CustomField-<id#> => custom field value
-
-Fields marked with an * are required.
-
-Fields marked with a + man have multiple values, simply
-by repeating the fieldname on a new line with an additional value.
-
-Fields marked with a ! are postponed to be processed after all
-tickets in the same actions are created.  Except for 'Status', those
-field can also take a ticket name within the same action (i.e.
-the identifiers after ==Create-Ticket), instead of raw Ticket ID
-numbers.
-
-When parsed, field names are converted to lowercase and have -s stripped.
-Refers-To, RefersTo, refersto, refers-to and r-e-f-er-s-tO will all 
-be treated as the same thing.
-
-
-=begin testing
-
-ok (require RT::Action::CreateTickets);
-use_ok(RT::Scrip);
-use_ok(RT::Template);
-use_ok(RT::ScripAction);
-use_ok(RT::ScripCondition);
-use_ok(RT::Ticket);
-
-my $approvalsq = RT::Queue->new($RT::SystemUser);
-$approvalsq->Create(Name => 'Approvals');
-ok ($approvalsq->Id, "Created Approvals test queue");
-
-
-my $approvals = 
-'===Create-Ticket: approval
-{  my $name = "HR";
-     my $groups = RT::Groups->new($RT::SystemUser);
-   $groups->LimitToUserDefinedGroups();
-   $groups->Limit(FIELD => "Name", OPERATOR => "=", VALUE => "$name");
-   $groups->WithMember($Transaction->CreatorObj->Id);
-
-   my $groupid = $groups->First->Id;
-
-   my $adminccs = RT::Users->new($RT::SystemUser);
-   $adminccs->WhoHaveRight(Right => "AdminGroup", IncludeSystemRights => undef, IncludeSuperusers => 0, IncludeSubgroupMembers => 0, Object => $groups->First);
-
-    my @admins;
-    while (my $admin = $adminccs->Next) {
-        push (@admins, $admin->EmailAddress); 
-    }
-}
-Queue: Approvals
-Type: Approval
-AdminCc: {join ("\nAdminCc: ",@admins) }
-Depended-On-By: TOP
-Refers-To:  TOP 
-Subject: Approval for ticket: {$Tickets{"TOP"}->Id} - {$Tickets{"TOP"}->Subject}
-Due: {time + 86400}
-Content-Type: text/plain
-Content: Your approval is requested for the ticket {$Tickets{"TOP"}->Id}: {$Tickets{"TOP"}->Subject}
-Blah
-Blah
-ENDOFCONTENT
-===Create-Ticket: two
-Subject: Manager approval.
-Depends-On: {$Tickets{"approval"}->Id}
-Queue: Approvals
-Content-Type: text/plain
-Content: 
-Your minion approved this ticket. you ok with that?
-ENDOFCONTENT
-';
-
-ok ($approvals =~ /Content/, "Read in the approvals template");
-
-my $apptemp = RT::Template->new($RT::SystemUser);
-$apptemp->Create( Content => $approvals, Name => "Approvals", Queue => "0");
-
-ok ($apptemp->Id);
-
-my $q = RT::Queue->new($RT::SystemUser);
-$q->Create(Name => 'WorkflowTest');
-ok ($q->Id, "Created workflow test queue");
-
-my $scrip = RT::Scrip->new($RT::SystemUser);
-my ($sval, $smsg) =$scrip->Create( ScripCondition => 'On Transaction',
-                ScripAction => 'Create Tickets',
-                Template => 'Approvals',
-                Queue => $q->Id);
-ok ($sval, $smsg);
-ok ($scrip->Id, "Created the scrip");
-ok ($scrip->TemplateObj->Id, "Created the scrip template");
-ok ($scrip->ConditionObj->Id, "Created the scrip condition");
-ok ($scrip->ActionObj->Id, "Created the scrip action");
-
-my $t = RT::Ticket->new($RT::SystemUser);
-$t->Create(Subject => "Sample workflow test",
-           Owner => "root",
-           Queue => $q->Id);
-
-
-=end testing
-
-
-=head1 AUTHOR
-
-Jesse Vincent <jesse@bestpractical.com> 
-
-=head1 SEE ALSO
-
-perl(1).
-
-=cut
-
-my %LINKTYPEMAP = (
-    MemberOf => { Type => 'MemberOf',
-                  Mode => 'Target', },
-    Members => { Type => 'MemberOf',
-                 Mode => 'Base', },
-    HasMember => { Type => 'MemberOf',
-                   Mode => 'Base', },
-    RefersTo => { Type => 'RefersTo',
-                  Mode => 'Target', },
-    ReferredToBy => { Type => 'RefersTo',
-                      Mode => 'Base', },
-    DependsOn => { Type => 'DependsOn',
-                   Mode => 'Target', },
-    DependedOnBy => { Type => 'DependsOn',
-                      Mode => 'Base', },
-
-);
-
-# {{{ Scrip methods (Commit, Prepare)
-
-# {{{ sub Commit 
-#Do what we need to do and send it out.
-sub Commit {
-    my $self = shift;
-    my (@links, @postponed);
-
-    # XXX: cargo cult programming that works. i'll be back.
-    use bytes;
-
-    # Create all the tickets we care about
-    return(1) unless $self->TicketObj->Type eq 'ticket';
-
-    %T::Tickets = ();
-
-    foreach my $template_id ( @{ $self->{'template_order'} } ) {
-       $T::Tickets{'TOP'} = $T::TOP = $self->TicketObj;
-       $RT::Logger->debug("Workflow: processing $template_id of $T::TOP");
-
-       $T::ID = $template_id;
-       @T::AllID = @{ $self->{'template_order'} };
-
-        my $template = Text::Template->new(
-             TYPE   => 'STRING',
-             SOURCE => $self->{'templates'}->{$template_id}
-        );
-
-       $RT::Logger->debug("Workflow: evaluating\n$self->{templates}{$template_id}");
-
-       my $err;
-        my $filled_in = $template->fill_in( PACKAGE => 'T', BROKEN => sub {
-           $err = { @_ }->{error};
-       } );
-
-       $RT::Logger->debug("Workflow: yielding\n$filled_in");
-
-       if ($err) {
-           $RT::Logger->error("Ticket creation failed for ".$self->TicketObj->Id." ".$err);
-           while (my ($k, $v) = each %T::X) {
-               $RT::Logger->debug("Eliminating $template_id from ${k}'s parents.");
-               delete $v->{$template_id};
-           }
-           next;
-       }
-
-        my %args;
-        my @lines = ( split ( /\n/, $filled_in ) );
-        while ( defined(my $line = shift @lines) ) {
-            if ( $line =~ /^(.*?):(?:\s+(.*))?$/ ) {
-                my $value = $2;
-                my $tag = lc ($1);
-                $tag =~ s/-//g;
-
-               if (ref($args{$tag})) { #If it's an array, we want to push the value
-                   push @{$args{$tag}}, $value;
-               }
-               elsif (defined ($args{$tag})) { #if we're about to get a second value, make it an array
-                   $args{$tag} = [$args{$tag}, $value];
-               }
-               else { #if there's nothing there, just set the value
-                   $args{ $tag } = $value;
-               }
-
-                if ( $tag eq 'content' ) { #just build up the content
-                        # convert it to an array
-                        $args{$tag} = defined($value) ? [ $value."\n" ] : [];
-                      while ( defined(my $l = shift @lines) ) {
-                        last if ($l =~  /^ENDOFCONTENT\s*$/) ;
-                        push @{$args{'content'}}, $l."\n";
-                        }
-                }
-            }
-       }
-
-       foreach my $date qw(due starts started resolved) {
-           my $dateobj = RT::Date->new($RT::SystemUser);
-           next unless $args{$date};
-           if ($args{$date} =~ /^\d+$/) {
-               $dateobj->Set(Format => 'unix', Value => $args{$date});
-           } else {
-               $dateobj->Set(Format => 'unknown', Value => $args{$date});
-           }
-           $args{$date} = $dateobj->ISO;
-       }
-       my $mimeobj = MIME::Entity->new();
-       $mimeobj->build(Type => $args{'contenttype'},
-                       Data => $args{'content'});
-       # Now we have a %args to work with. 
-       # Make sure we have at least the minimum set of 
-       # reasonable data and do our thang
-       $T::Tickets{$template_id} ||= RT::Ticket->new($RT::SystemUser);
-
-       # Deferred processing   
-       push @links, (
-           $T::Tickets{$template_id}, {
-               DependsOn               => $args{'dependson'},
-               DependedOnBy    => $args{'dependedonby'},
-               RefersTo                => $args{'refersto'},
-               ReferredToBy    => $args{'referredtoby'},
-               Members         => $args{'members'},
-               MemberOf                => $args{'memberof'},
-           }
-       );
-
-       push @postponed, (
-           # Status is postponed so we don't violate dependencies
-           $T::Tickets{$template_id}, {
-               Status          => $args{'status'},
-           }
-       );
-
-       $args{'requestor'} ||= $self->TicketObj->Requestors->MemberEmailAddresses;
-
-       $args{'type'} ||= 'ticket';
-
-       my %ticketargs = ( Queue => $args{'queue'},
-                     Subject=> $args{'subject'},
-                   Status => 'new',
-                   Due => $args{'due'},
-                   Starts => $args{'starts'},
-                   Started => $args{'started'},
-                   Resolved => $args{'resolved'},
-                   Owner => $args{'owner'},
-                   Requestor => $args{'requestor'},
-                   Cc => $args{'cc'},
-                   AdminCc=> $args{'admincc'},
-                   TimeWorked =>$args{'timeworked'},
-                   TimeEstimated =>$args{'timeestimated'},
-                   TimeLeft =>$args{'timeleft'},
-                   InitialPriority => $args{'initialpriority'},
-                   FinalPriority => $args{'finalpriority'},
-                   Type => $args{'type'}, 
-                   MIMEObj => $mimeobj);
-
-
-       foreach my $key (keys(%args)) {
-           $key =~ /^customfield(\d+)$/ or next;
-           $ticketargs{ "CustomField-" . $1 } = $args{$key};
-       }
-
-       my ($id, $transid, $msg) = $T::Tickets{$template_id}->Create(%ticketargs);
-       if (!$id) {
-           $RT::Logger->error(
-               "Couldn't create related ticket $template_id for ".
-               $self->TicketObj->Id." ".$msg
-           );
-           next;
-       }
-
-       $RT::Logger->debug("Assigned $template_id with $id");
-       $T::Tickets{$template_id}->SetOriginObj($self->TicketObj)
-           if $T::Tickets{$template_id}->can('SetOriginObj');
-    }
-
-    # postprocessing: add links
-
-    while (my $ticket = shift(@links)) {
-       $RT::Logger->debug("Handling links for " . $ticket->Id);
-       my %args = %{shift(@links)};
-
-       foreach my $type ( keys %LINKTYPEMAP ) {
-           next unless (defined $args{$type});
-           foreach my $link (
-               ref( $args{$type} ) ? @{ $args{$type} } : ( $args{$type} ) )
-           {
-               if (!exists $T::Tickets{$link}) {
-                   $RT::Logger->debug("Skipping $type link for $link (non-existent)");
-                   next;
-               }
-               $RT::Logger->debug("Building $type link for $link: " . $T::Tickets{$link}->Id);
-               $link = $T::Tickets{$link}->Id;
-
-               my ( $wval, $wmsg ) = $ticket->AddLink(
-                   Type                          => $LINKTYPEMAP{$type}->{'Type'},
-                   $LINKTYPEMAP{$type}->{'Mode'} => $link,
-                   Silent                        => 1
-               );
-
-               $RT::Logger->warning("AddLink thru $link failed: $wmsg") unless $wval;
-               # push @non_fatal_errors, $wmsg unless ($wval);
-           }
-
-       }
-    }
-
-    # postponed actions -- Status only, currently
-    while (my $ticket = shift(@postponed)) {
-       $RT::Logger->debug("Handling postponed actions for $ticket");
-       my %args = %{shift(@postponed)};
-
-       $ticket->SetStatus($args{Status}) if defined $args{Status};
-    }
-
-    return(1);
-}
-# }}}
-
-# {{{ sub Prepare 
-
-sub Prepare  {
-  my $self = shift;
-  
-  unless ($self->TemplateObj) {
-    $RT::Logger->warning("No template object handed to $self\n");
-  }
-  
-  unless ($self->TransactionObj) {
-    $RT::Logger->warning("No transaction object handed to $self\n");
-    
-  }
-  
-  unless ($self->TicketObj) {
-    $RT::Logger->warning("No ticket object handed to $self\n");
-      
-  }
-
-    
-
-my $template_id;
-foreach my $line (split(/\n/,$self->TemplateObj->Content)) {
-        if ($line =~ /^===Create-Ticket: (.*)$/) {
-                $template_id = $1;
-                push @{$self->{'template_order'}},$template_id;
-        } else {
-                $self->{'templates'}->{$template_id} .= $line."\n";
-        }       
-        
-        
-}
-  
-  return 1;
-  
-}
-
-# }}}
-
-# }}}
-
-eval "require RT::Action::CreateTickets_Vendor";
-die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/CreateTickets_Vendor.pm});
-eval "require RT::Action::CreateTickets_Local";
-die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/CreateTickets_Local.pm});
-
-1;
-