--- /dev/null
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
+# <sales@bestpractical.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
+# 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.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+
+package RT::Action::CreateTickets;
+use base 'RT::Action';
+
+use strict;
+use warnings;
+
+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
+
+The CreateTickets ScripAction allows you to create automated workflows in RT,
+creating new tickets in response to actions and conditions from other
+tickets.
+
+=head2 Format
+
+CreateTickets uses the RT template configured in the scrip 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
+
+As shown, you can put one or more C<===Create-Ticket:> sections in
+a template. Each C<===Create-Ticket:> section is evaluated as its own
+L<Text::Template> object, which means that you can embed snippets
+of Perl inside the L<Text::Template> using C<{}> delimiters, but that
+such sections absolutely can not span a C<===Create-Ticket:> boundary.
+
+Note that each C<Value> must come right after the C<Param> on the same
+line. The C<Content:> param can extend over multiple lines, but the text
+of the first line must start right after C<Content:>. Don't try to start
+your C<Content:> section with a newline.
+
+After each ticket is created, it's stuffed into a hash called C<%Tickets>
+making it available during the creation of other tickets during the
+same ScripAction. The hash key for each ticket is C<create-[identifier]>,
+where C<[identifier]> is the value you put after C<===Create-Ticket:>. The hash
+is prepopulated with the ticket which triggered the ScripAction as
+C<$Tickets{'TOP'}>. You can also access that ticket using the shorthand
+C<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,
+ );
+
+ our @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
+ Type: approval
+ Depended-On-By: TOP
+ Refers-To: {$Tickets{"create-approval"}->Id}
+ Queue: ___Approvals
+ Content-Type: text/plain
+ Content: Your approval is requred for this ticket, too.
+ ENDOFCONTENT
+
+As shown above, you can include a block with Perl code to set up some
+values for the new tickets. If you want to access a variable in the
+template section after the block, you must scope it with C<our> rather
+than C<my>. Just as with other RT templates, you can also include
+Perl code in the template sections using C<{}>.
+
+=head2 Acceptable Fields
+
+A complete list of acceptable fields:
+
+ * 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; forces the owner if necessary
+ + Requestor => Email address
+ + Cc => Email address
+ + AdminCc => Email address
+ + RequestorGroup => Group name
+ + CcGroup => Group name
+ + AdminCcGroup => Group name
+ 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. Defaults to
+ 'text/plain'
+ UpdateType => 'correspond' or 'comment'; used in conjunction with
+ 'content' if this is an update. Defaults to
+ 'correspond'
+
+ CustomField-<id#> => custom field value
+ CF-name => custom field value
+ CustomField-name => custom field value
+
+Fields marked with an C<*> are required.
+
+Fields marked with a C<+> may have multiple values, simply
+by repeating the fieldname on a new line with an additional value.
+
+Fields marked with a C<!> have processing postponed until after all
+tickets in the same actions are created. Except for C<Status>, those
+fields can also take a ticket name within the same action (i.e.
+the identifiers after C<===Create-Ticket:>), instead of raw ticket ID
+numbers.
+
+When parsed, field names are converted to lowercase and have hyphens stripped.
+C<Refers-To>, C<RefersTo>, C<refersto>, C<refers-to> and C<r-e-f-er-s-tO> will
+all be treated as the same thing.
+
+=head1 METHODS
+
+=cut
+
+my %LINKTYPEMAP = (
+ MemberOf => {
+ Type => 'MemberOf',
+ Mode => 'Target',
+ },
+ Parents => {
+ Type => 'MemberOf',
+ Mode => 'Target',
+ },
+ Members => {
+ Type => 'MemberOf',
+ Mode => 'Base',
+ },
+ Children => {
+ 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',
+ },
+
+);
+
+
+#Do what we need to do and send it out.
+sub Commit {
+ my $self = shift;
+
+ # Create all the tickets we care about
+ return (1) unless $self->TicketObj->Type eq 'ticket';
+
+ $self->CreateByTemplate( $self->TicketObj );
+ $self->UpdateByTemplate( $self->TicketObj );
+ return (1);
+}
+
+
+
+sub Prepare {
+ my $self = shift;
+
+ unless ( $self->TemplateObj ) {
+ $RT::Logger->warning("No template object handed to $self");
+ }
+
+ unless ( $self->TransactionObj ) {
+ $RT::Logger->warning("No transaction object handed to $self");
+
+ }
+
+ unless ( $self->TicketObj ) {
+ $RT::Logger->warning("No ticket object handed to $self");
+
+ }
+
+ my $active = 0;
+ if ( $self->TemplateObj->Type eq 'Perl' ) {
+ $active = 1;
+ } else {
+ RT->Logger->info(sprintf(
+ "Template #%d is type %s. You most likely want to use a Perl template instead.",
+ $self->TemplateObj->id, $self->TemplateObj->Type
+ ));
+ }
+
+ $self->Parse(
+ Content => $self->TemplateObj->Content,
+ _ActiveContent => $active,
+ );
+ return 1;
+
+}
+
+
+
+sub CreateByTemplate {
+ my $self = shift;
+ my $top = shift;
+
+ $RT::Logger->debug("In CreateByTemplate");
+
+ my @results;
+
+ # XXX: cargo cult programming that works. i'll be back.
+
+ local %T::Tickets = %T::Tickets;
+ local $T::TOP = $T::TOP;
+ local $T::ID = $T::ID;
+ $T::Tickets{'TOP'} = $T::TOP = $top if $top;
+ local $T::TransactionObj = $self->TransactionObj;
+
+ my $ticketargs;
+ my ( @links, @postponed );
+ foreach my $template_id ( @{ $self->{'create_tickets'} } ) {
+ $RT::Logger->debug("Workflow: processing $template_id of $T::TOP")
+ if $T::TOP;
+
+ $T::ID = $template_id;
+ @T::AllID = @{ $self->{'create_tickets'} };
+
+ ( $T::Tickets{$template_id}, $ticketargs )
+ = $self->ParseLines( $template_id, \@links, \@postponed );
+
+ # Now we have a %args to work with.
+ # Make sure we have at least the minimum set of
+ # reasonable data and do our thang
+
+ my ( $id, $transid, $msg )
+ = $T::Tickets{$template_id}->Create(%$ticketargs);
+
+ foreach my $res ( split( '\n', $msg ) ) {
+ push @results,
+ $T::Tickets{$template_id}
+ ->loc( "Ticket [_1]", $T::Tickets{$template_id}->Id ) . ': '
+ . $res;
+ }
+ if ( !$id ) {
+ if ( $self->TicketObj ) {
+ $msg = "Couldn't create related ticket $template_id for "
+ . $self->TicketObj->Id . " "
+ . $msg;
+ } else {
+ $msg = "Couldn't create ticket $template_id " . $msg;
+ }
+
+ $RT::Logger->error($msg);
+ next;
+ }
+
+ $RT::Logger->debug("Assigned $template_id with $id");
+ $T::Tickets{$template_id}->SetOriginObj( $self->TicketObj )
+ if $self->TicketObj
+ && $T::Tickets{$template_id}->can('SetOriginObj');
+
+ }
+
+ $self->PostProcess( \@links, \@postponed );
+
+ return @results;
+}
+
+sub UpdateByTemplate {
+ my $self = shift;
+ my $top = shift;
+
+ # XXX: cargo cult programming that works. i'll be back.
+
+ my @results;
+ local %T::Tickets = %T::Tickets;
+ local $T::ID = $T::ID;
+
+ my $ticketargs;
+ my ( @links, @postponed );
+ foreach my $template_id ( @{ $self->{'update_tickets'} } ) {
+ $RT::Logger->debug("Update Workflow: processing $template_id");
+
+ $T::ID = $template_id;
+ @T::AllID = @{ $self->{'update_tickets'} };
+
+ ( $T::Tickets{$template_id}, $ticketargs )
+ = $self->ParseLines( $template_id, \@links, \@postponed );
+
+ # Now we have a %args to work with.
+ # Make sure we have at least the minimum set of
+ # reasonable data and do our thang
+
+ my @attribs = qw(
+ Subject
+ FinalPriority
+ Priority
+ TimeEstimated
+ TimeWorked
+ TimeLeft
+ Status
+ Queue
+ Due
+ Starts
+ Started
+ Resolved
+ );
+
+ my $id = $template_id;
+ $id =~ s/update-(\d+).*/$1/;
+ my ($loaded, $msg) = $T::Tickets{$template_id}->LoadById($id);
+
+ unless ( $loaded ) {
+ $RT::Logger->error("Couldn't update ticket $template_id: " . $msg);
+ push @results, $self->loc( "Couldn't load ticket '[_1]'", $id );
+ next;
+ }
+
+ my $current = $self->GetBaseTemplate( $T::Tickets{$template_id} );
+
+ $template_id =~ m/^update-(.*)/;
+ my $base_id = "base-$1";
+ my $base = $self->{'templates'}->{$base_id};
+ if ($base) {
+ $base =~ s/\r//g;
+ $base =~ s/\n+$//;
+ $current =~ s/\n+$//;
+
+ # If we have no base template, set what we can.
+ if ( $base ne $current ) {
+ push @results,
+ "Could not update ticket "
+ . $T::Tickets{$template_id}->Id
+ . ": Ticket has changed";
+ next;
+ }
+ }
+ push @results, $T::Tickets{$template_id}->Update(
+ AttributesRef => \@attribs,
+ ARGSRef => $ticketargs
+ );
+
+ if ( $ticketargs->{'Owner'} ) {
+ ($id, $msg) = $T::Tickets{$template_id}->SetOwner($ticketargs->{'Owner'}, "Force");
+ push @results, $msg unless $msg eq $self->loc("That user already owns that ticket");
+ }
+
+ push @results,
+ $self->UpdateWatchers( $T::Tickets{$template_id}, $ticketargs );
+
+ push @results,
+ $self->UpdateCustomFields( $T::Tickets{$template_id}, $ticketargs );
+
+ next unless $ticketargs->{'MIMEObj'};
+ if ( $ticketargs->{'UpdateType'} =~ /^(private|comment)$/i ) {
+ my ( $Transaction, $Description, $Object )
+ = $T::Tickets{$template_id}->Comment(
+ BccMessageTo => $ticketargs->{'Bcc'},
+ MIMEObj => $ticketargs->{'MIMEObj'},
+ TimeTaken => $ticketargs->{'TimeWorked'}
+ );
+ push( @results,
+ $T::Tickets{$template_id}
+ ->loc( "Ticket [_1]", $T::Tickets{$template_id}->id )
+ . ': '
+ . $Description );
+ } elsif ( $ticketargs->{'UpdateType'} =~ /^(public|response|correspond)$/i ) {
+ my ( $Transaction, $Description, $Object )
+ = $T::Tickets{$template_id}->Correspond(
+ BccMessageTo => $ticketargs->{'Bcc'},
+ MIMEObj => $ticketargs->{'MIMEObj'},
+ TimeTaken => $ticketargs->{'TimeWorked'}
+ );
+ push( @results,
+ $T::Tickets{$template_id}
+ ->loc( "Ticket [_1]", $T::Tickets{$template_id}->id )
+ . ': '
+ . $Description );
+ } else {
+ push(
+ @results,
+ $T::Tickets{$template_id}->loc(
+ "Update type was neither correspondence nor comment.")
+ . " "
+ . $T::Tickets{$template_id}->loc("Update not recorded.")
+ );
+ }
+ }
+
+ $self->PostProcess( \@links, \@postponed );
+
+ return @results;
+}
+
+=head2 Parse
+
+Takes (in order) template content, a default queue, a default requestor, and
+active (a boolean flag).
+
+Parses a template in the template content, defaulting queue and requestor if
+unspecified in the template to the values provided as arguments.
+
+If the active flag is true, then we'll use L<Text::Template> to parse the
+templates, allowing you to embed active Perl in your templates.
+
+=cut
+
+sub Parse {
+ my $self = shift;
+ my %args = (
+ Content => undef,
+ Queue => undef,
+ Requestor => undef,
+ _ActiveContent => undef,
+ @_
+ );
+
+ if ( $args{'_ActiveContent'} ) {
+ $self->{'UsePerlTextTemplate'} = 1;
+ } else {
+
+ $self->{'UsePerlTextTemplate'} = 0;
+ }
+
+ if ( substr( $args{'Content'}, 0, 3 ) eq '===' ) {
+ $self->_ParseMultilineTemplate(%args);
+ } elsif ( $args{'Content'} =~ /(?:\t|,)/i ) {
+ $self->_ParseXSVTemplate(%args);
+ } else {
+ RT->Logger->error("Invalid Template Content (Couldn't find ===, and is not a csv/tsv template) - unable to parse: $args{Content}");
+ }
+}
+
+=head2 _ParseMultilineTemplate
+
+Parses mulitline templates. Things like:
+
+ ===Create-Ticket: ...
+
+Takes the same arguments as L</Parse>.
+
+=cut
+
+sub _ParseMultilineTemplate {
+ my $self = shift;
+ my %args = (@_);
+
+ my $template_id;
+ require Encode;
+ require utf8;
+ my ( $queue, $requestor );
+ $RT::Logger->debug("Line: ===");
+ foreach my $line ( split( /\n/, $args{'Content'} ) ) {
+ $line =~ s/\r$//;
+ $RT::Logger->debug( "Line: " . utf8::is_utf8($line)
+ ? Encode::encode_utf8($line)
+ : $line );
+ if ( $line =~ /^===/ ) {
+ if ( $template_id && !$queue && $args{'Queue'} ) {
+ $self->{'templates'}->{$template_id}
+ .= "Queue: $args{'Queue'}\n";
+ }
+ if ( $template_id && !$requestor && $args{'Requestor'} ) {
+ $self->{'templates'}->{$template_id}
+ .= "Requestor: $args{'Requestor'}\n";
+ }
+ $queue = 0;
+ $requestor = 0;
+ }
+ if ( $line =~ /^===Create-Ticket: (.*)$/ ) {
+ $template_id = "create-$1";
+ $RT::Logger->debug("**** Create ticket: $template_id");
+ push @{ $self->{'create_tickets'} }, $template_id;
+ } elsif ( $line =~ /^===Update-Ticket: (.*)$/ ) {
+ $template_id = "update-$1";
+ $RT::Logger->debug("**** Update ticket: $template_id");
+ push @{ $self->{'update_tickets'} }, $template_id;
+ } elsif ( $line =~ /^===Base-Ticket: (.*)$/ ) {
+ $template_id = "base-$1";
+ $RT::Logger->debug("**** Base ticket: $template_id");
+ push @{ $self->{'base_tickets'} }, $template_id;
+ } elsif ( $line =~ /^===#.*$/ ) { # a comment
+ next;
+ } else {
+ if ( $line =~ /^Queue:(.*)/i ) {
+ $queue = 1;
+ my $value = $1;
+ $value =~ s/^\s//;
+ $value =~ s/\s$//;
+ if ( !$value && $args{'Queue'} ) {
+ $value = $args{'Queue'};
+ $line = "Queue: $value";
+ }
+ }
+ if ( $line =~ /^Requestors?:(.*)/i ) {
+ $requestor = 1;
+ my $value = $1;
+ $value =~ s/^\s//;
+ $value =~ s/\s$//;
+ if ( !$value && $args{'Requestor'} ) {
+ $value = $args{'Requestor'};
+ $line = "Requestor: $value";
+ }
+ }
+ $self->{'templates'}->{$template_id} .= $line . "\n";
+ }
+ }
+ if ( $template_id && !$queue && $args{'Queue'} ) {
+ $self->{'templates'}->{$template_id} .= "Queue: $args{'Queue'}\n";
+ }
+ }
+
+sub ParseLines {
+ my $self = shift;
+ my $template_id = shift;
+ my $links = shift;
+ my $postponed = shift;
+
+ my $content = $self->{'templates'}->{$template_id};
+
+ if ( $self->{'UsePerlTextTemplate'} ) {
+
+ $RT::Logger->debug(
+ "Workflow: evaluating\n$self->{templates}{$template_id}");
+
+ my $template = Text::Template->new(
+ TYPE => 'STRING',
+ SOURCE => $content
+ );
+
+ my $err;
+ $content = $template->fill_in(
+ PACKAGE => 'T',
+ BROKEN => sub {
+ $err = {@_}->{error};
+ }
+ );
+
+ $RT::Logger->debug("Workflow: yielding $content");
+
+ if ($err) {
+ $RT::Logger->error( "Ticket creation failed: " . $err );
+ while ( my ( $k, $v ) = each %T::X ) {
+ $RT::Logger->debug(
+ "Eliminating $template_id from ${k}'s parents.");
+ delete $v->{$template_id};
+ }
+ next;
+ }
+ }
+
+ my $TicketObj ||= RT::Ticket->new( $self->CurrentUser );
+
+ my %args;
+ my %original_tags;
+ my @lines = ( split( /\n/, $content ) );
+ while ( defined( my $line = shift @lines ) ) {
+ if ( $line =~ /^(.*?):(?:\s+)(.*?)(?:\s*)$/ ) {
+ my $value = $2;
+ my $original_tag = $1;
+ my $tag = lc($original_tag);
+ $tag =~ s/-//g;
+ $tag =~ s/^(requestor|cc|admincc)s?$/$1/i;
+
+ $original_tags{$tag} = $original_tag;
+
+ 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 =~ /^content$/i ) { #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";
+ }
+ } else {
+ # if it's not content, strip leading and trailing spaces
+ if ( $args{$tag} ) {
+ $args{$tag} =~ s/^\s+//g;
+ $args{$tag} =~ s/\s+$//g;
+ }
+ if (
+ ($tag =~ /^(requestor|cc|admincc)(group)?$/i
+ or grep {lc $_ eq $tag} keys %LINKTYPEMAP)
+ and $args{$tag} =~ /,/
+ ) {
+ $args{$tag} = [ split /,\s*/, $args{$tag} ];
+ }
+ }
+ }
+ }
+
+ foreach my $date (qw(due starts started resolved)) {
+ my $dateobj = RT::Date->new( $self->CurrentUser );
+ next unless $args{$date};
+ if ( $args{$date} =~ /^\d+$/ ) {
+ $dateobj->Set( Format => 'unix', Value => $args{$date} );
+ } else {
+ eval {
+ $dateobj->Set( Format => 'iso', Value => $args{$date} );
+ };
+ if ($@ or $dateobj->Unix <= 0) {
+ $dateobj->Set( Format => 'unknown', Value => $args{$date} );
+ }
+ }
+ $args{$date} = $dateobj->ISO;
+ }
+
+ foreach my $role (qw(requestor cc admincc)) {
+ next unless my $value = $args{ $role . 'group' };
+
+ my $group = RT::Group->new( $self->CurrentUser );
+ $group->LoadUserDefinedGroup( $value );
+ unless ( $group->id ) {
+ $RT::Logger->error("Couldn't load group '$value'");
+ next;
+ }
+
+ $args{ $role } = $args{ $role } ? [$args{ $role }] : []
+ unless ref $args{ $role };
+ push @{ $args{ $role } }, $group->PrincipalObj->id;
+ }
+
+ $args{'requestor'} ||= $self->TicketObj->Requestors->MemberEmailAddresses
+ if $self->TicketObj;
+
+ $args{'type'} ||= 'ticket';
+
+ my %ticketargs = (
+ Queue => $args{'queue'},
+ Subject => $args{'subject'},
+ Status => $args{'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'} || 0,
+ FinalPriority => $args{'finalpriority'} || 0,
+ SquelchMailTo => $args{'squelchmailto'},
+ Type => $args{'type'},
+ $self->Rules
+ );
+
+ if ( $args{content} ) {
+ my $mimeobj = MIME::Entity->new();
+ $mimeobj->build(
+ Type => $args{'contenttype'} || 'text/plain',
+ Data => $args{'content'}
+ );
+ $ticketargs{MIMEObj} = $mimeobj;
+ $ticketargs{UpdateType} = $args{'updatetype'} || 'correspond';
+ }
+
+ foreach my $tag ( keys(%args) ) {
+ # if the tag was added later, skip it
+ my $orig_tag = $original_tags{$tag} or next;
+ if ( $orig_tag =~ /^customfield-?(\d+)$/i ) {
+ $ticketargs{ "CustomField-" . $1 } = $args{$tag};
+ } elsif ( $orig_tag =~ /^(?:customfield|cf)-?(.+)$/i ) {
+ my $cf = RT::CustomField->new( $self->CurrentUser );
+ $cf->LoadByName( Name => $1, Queue => $ticketargs{Queue} );
+ $cf->LoadByName( Name => $1, Queue => 0 ) unless $cf->id;
+ next unless $cf->id;
+ $ticketargs{ "CustomField-" . $cf->id } = $args{$tag};
+ } elsif ($orig_tag) {
+ my $cf = RT::CustomField->new( $self->CurrentUser );
+ $cf->LoadByName( Name => $orig_tag, Queue => $ticketargs{Queue} );
+ $cf->LoadByName( Name => $orig_tag, Queue => 0 ) unless $cf->id;
+ next unless $cf->id;
+ $ticketargs{ "CustomField-" . $cf->id } = $args{$tag};
+
+ }
+ }
+
+ $self->GetDeferred( \%args, $template_id, $links, $postponed );
+
+ return $TicketObj, \%ticketargs;
+}
+
+
+=head2 _ParseXSVTemplate
+
+Parses a tab or comma delimited template. Should only ever be called by
+L</Parse>.
+
+=cut
+
+sub _ParseXSVTemplate {
+ my $self = shift;
+ my %args = (@_);
+
+ use Regexp::Common qw(delimited);
+ my($first, $content) = split(/\r?\n/, $args{'Content'}, 2);
+
+ my $delimiter;
+ if ( $first =~ /\t/ ) {
+ $delimiter = "\t";
+ } else {
+ $delimiter = ',';
+ }
+ my @fields = split( /$delimiter/, $first );
+
+ my $delimiter_re = qr[$delimiter];
+ my $justquoted = qr[$RE{quoted}];
+
+ # Used to generate automatic template ids
+ my $autoid = 1;
+
+ LINE:
+ while ($content) {
+ $content =~ s/^(\s*\r?\n)+//;
+
+ # Keep track of Queue and Requestor, so we can provide defaults
+ my $queue;
+ my $requestor;
+
+ # The template for this line
+ my $template;
+
+ # What column we're on
+ my $i = 0;
+
+ # If the last iteration was the end of the line
+ my $EOL = 0;
+
+ # The template id
+ my $template_id;
+
+ COLUMN:
+ while (not $EOL and length $content and $content =~ s/^($justquoted|.*?)($delimiter_re|$)//smix) {
+ $EOL = not $2;
+
+ # Strip off quotes, if they exist
+ my $value = $1;
+ if ( $value =~ /^$RE{delimited}{-delim=>qq{\'\"}}$/ ) {
+ substr( $value, 0, 1 ) = "";
+ substr( $value, -1, 1 ) = "";
+ }
+
+ # What column is this?
+ my $field = $fields[$i++];
+ next COLUMN unless $field =~ /\S/;
+ $field =~ s/^\s//;
+ $field =~ s/\s$//;
+
+ if ( $field =~ /^id$/i ) {
+ # Special case if this is the ID column
+ if ( $value =~ /^\d+$/ ) {
+ $template_id = 'update-' . $value;
+ push @{ $self->{'update_tickets'} }, $template_id;
+ } elsif ( $value =~ /^#base-(\d+)$/ ) {
+ $template_id = 'base-' . $1;
+ push @{ $self->{'base_tickets'} }, $template_id;
+ } elsif ( $value =~ /\S/ ) {
+ $template_id = 'create-' . $value;
+ push @{ $self->{'create_tickets'} }, $template_id;
+ }
+ } else {
+ # Some translations
+ if ( $field =~ /^Body$/i
+ || $field =~ /^Data$/i
+ || $field =~ /^Message$/i )
+ {
+ $field = 'Content';
+ } elsif ( $field =~ /^Summary$/i ) {
+ $field = 'Subject';
+ } elsif ( $field =~ /^Queue$/i ) {
+ # Note that we found a queue
+ $queue = 1;
+ $value ||= $args{'Queue'};
+ } elsif ( $field =~ /^Requestors?$/i ) {
+ $field = 'Requestor'; # Remove plural
+ # Note that we found a requestor
+ $requestor = 1;
+ $value ||= $args{'Requestor'};
+ }
+
+ # Tack onto the end of the template
+ $template .= $field . ": ";
+ $template .= (defined $value ? $value : "");
+ $template .= "\n";
+ $template .= "ENDOFCONTENT\n"
+ if $field =~ /^Content$/i;
+ }
+ }
+
+ # Ignore blank lines
+ next unless $template;
+
+ # If we didn't find a queue of requestor, tack on the defaults
+ if ( !$queue && $args{'Queue'} ) {
+ $template .= "Queue: $args{'Queue'}\n";
+ }
+ if ( !$requestor && $args{'Requestor'} ) {
+ $template .= "Requestor: $args{'Requestor'}\n";
+ }
+
+ # If we never found an ID, come up with one
+ unless ($template_id) {
+ $autoid++ while exists $self->{'templates'}->{"create-auto-$autoid"};
+ $template_id = "create-auto-$autoid";
+ # Also, it's a ticket to create
+ push @{ $self->{'create_tickets'} }, $template_id;
+ }
+
+ # Save the template we generated
+ $self->{'templates'}->{$template_id} = $template;
+
+ }
+}
+
+sub GetDeferred {
+ my $self = shift;
+ my $args = shift;
+ my $id = shift;
+ my $links = shift;
+ my $postponed = shift;
+
+ # Deferred processing
+ push @$links,
+ (
+ $id,
+ { DependsOn => $args->{'dependson'},
+ DependedOnBy => $args->{'dependedonby'},
+ RefersTo => $args->{'refersto'},
+ ReferredToBy => $args->{'referredtoby'},
+ Children => $args->{'children'},
+ Parents => $args->{'parents'},
+ }
+ );
+
+ push @$postponed, (
+
+ # Status is postponed so we don't violate dependencies
+ $id, { Status => $args->{'status'}, }
+ );
+}
+
+sub GetUpdateTemplate {
+ my $self = shift;
+ my $t = shift;
+
+ my $string;
+ $string .= "Queue: " . $t->QueueObj->Name . "\n";
+ $string .= "Subject: " . $t->Subject . "\n";
+ $string .= "Status: " . $t->Status . "\n";
+ $string .= "UpdateType: correspond\n";
+ $string .= "Content: \n";
+ $string .= "ENDOFCONTENT\n";
+ $string .= "Due: " . $t->DueObj->AsString . "\n";
+ $string .= "Starts: " . $t->StartsObj->AsString . "\n";
+ $string .= "Started: " . $t->StartedObj->AsString . "\n";
+ $string .= "Resolved: " . $t->ResolvedObj->AsString . "\n";
+ $string .= "Owner: " . $t->OwnerObj->Name . "\n";
+ $string .= "Requestor: " . $t->RequestorAddresses . "\n";
+ $string .= "Cc: " . $t->CcAddresses . "\n";
+ $string .= "AdminCc: " . $t->AdminCcAddresses . "\n";
+ $string .= "TimeWorked: " . $t->TimeWorked . "\n";
+ $string .= "TimeEstimated: " . $t->TimeEstimated . "\n";
+ $string .= "TimeLeft: " . $t->TimeLeft . "\n";
+ $string .= "InitialPriority: " . $t->Priority . "\n";
+ $string .= "FinalPriority: " . $t->FinalPriority . "\n";
+
+ foreach my $type ( sort keys %LINKTYPEMAP ) {
+
+ # don't display duplicates
+ if ( $type eq "HasMember"
+ || $type eq "Members"
+ || $type eq "MemberOf" )
+ {
+ next;
+ }
+ $string .= "$type: ";
+
+ my $mode = $LINKTYPEMAP{$type}->{Mode};
+ my $method = $LINKTYPEMAP{$type}->{Type};
+
+ my $links = '';
+ while ( my $link = $t->$method->Next ) {
+ $links .= ", " if $links;
+
+ my $object = $mode . "Obj";
+ my $member = $link->$object;
+ $links .= $member->Id if $member;
+ }
+ $string .= $links;
+ $string .= "\n";
+ }
+
+ return $string;
+}
+
+sub GetBaseTemplate {
+ my $self = shift;
+ my $t = shift;
+
+ my $string;
+ $string .= "Queue: " . $t->Queue . "\n";
+ $string .= "Subject: " . $t->Subject . "\n";
+ $string .= "Status: " . $t->Status . "\n";
+ $string .= "Due: " . $t->DueObj->Unix . "\n";
+ $string .= "Starts: " . $t->StartsObj->Unix . "\n";
+ $string .= "Started: " . $t->StartedObj->Unix . "\n";
+ $string .= "Resolved: " . $t->ResolvedObj->Unix . "\n";
+ $string .= "Owner: " . $t->Owner . "\n";
+ $string .= "Requestor: " . $t->RequestorAddresses . "\n";
+ $string .= "Cc: " . $t->CcAddresses . "\n";
+ $string .= "AdminCc: " . $t->AdminCcAddresses . "\n";
+ $string .= "TimeWorked: " . $t->TimeWorked . "\n";
+ $string .= "TimeEstimated: " . $t->TimeEstimated . "\n";
+ $string .= "TimeLeft: " . $t->TimeLeft . "\n";
+ $string .= "InitialPriority: " . $t->Priority . "\n";
+ $string .= "FinalPriority: " . $t->FinalPriority . "\n";
+
+ return $string;
+}
+
+sub GetCreateTemplate {
+ my $self = shift;
+
+ my $string;
+
+ $string .= "Queue: General\n";
+ $string .= "Subject: \n";
+ $string .= "Status: new\n";
+ $string .= "Content: \n";
+ $string .= "ENDOFCONTENT\n";
+ $string .= "Due: \n";
+ $string .= "Starts: \n";
+ $string .= "Started: \n";
+ $string .= "Resolved: \n";
+ $string .= "Owner: \n";
+ $string .= "Requestor: \n";
+ $string .= "Cc: \n";
+ $string .= "AdminCc:\n";
+ $string .= "TimeWorked: \n";
+ $string .= "TimeEstimated: \n";
+ $string .= "TimeLeft: \n";
+ $string .= "InitialPriority: \n";
+ $string .= "FinalPriority: \n";
+
+ foreach my $type ( keys %LINKTYPEMAP ) {
+
+ # don't display duplicates
+ if ( $type eq "HasMember"
+ || $type eq 'Members'
+ || $type eq 'MemberOf' )
+ {
+ next;
+ }
+ $string .= "$type: \n";
+ }
+ return $string;
+}
+
+sub UpdateWatchers {
+ my $self = shift;
+ my $ticket = shift;
+ my $args = shift;
+
+ my @results;
+
+ foreach my $type (qw(Requestor Cc AdminCc)) {
+ my $method = $type . 'Addresses';
+ my $oldaddr = $ticket->$method;
+
+ # Skip unless we have a defined field
+ next unless defined $args->{$type};
+ my $newaddr = $args->{$type};
+
+ my @old = split( /,\s*/, $oldaddr );
+ my @new;
+ for (ref $newaddr ? @{$newaddr} : split( /,\s*/, $newaddr )) {
+ # Sometimes these are email addresses, sometimes they're
+ # users. Try to guess which is which, as we want to deal
+ # with email addresses if at all possible.
+ if (/^\S+@\S+$/) {
+ push @new, $_;
+ } else {
+ # It doesn't look like an email address. Try to load it.
+ my $user = RT::User->new($self->CurrentUser);
+ $user->Load($_);
+ if ($user->Id) {
+ push @new, $user->EmailAddress;
+ } else {
+ push @new, $_;
+ }
+ }
+ }
+
+ my %oldhash = map { $_ => 1 } @old;
+ my %newhash = map { $_ => 1 } @new;
+
+ my @add = grep( !defined $oldhash{$_}, @new );
+ my @delete = grep( !defined $newhash{$_}, @old );
+
+ foreach (@add) {
+ my ( $val, $msg ) = $ticket->AddWatcher(
+ Type => $type,
+ Email => $_
+ );
+
+ push @results,
+ $ticket->loc( "Ticket [_1]", $ticket->Id ) . ': ' . $msg;
+ }
+
+ foreach (@delete) {
+ my ( $val, $msg ) = $ticket->DeleteWatcher(
+ Type => $type,
+ Email => $_
+ );
+ push @results,
+ $ticket->loc( "Ticket [_1]", $ticket->Id ) . ': ' . $msg;
+ }
+ }
+ return @results;
+}
+
+sub UpdateCustomFields {
+ my $self = shift;
+ my $ticket = shift;
+ my $args = shift;
+
+ my @results;
+ foreach my $arg (keys %{$args}) {
+ next unless $arg =~ /^CustomField-(\d+)$/;
+ my $cf = $1;
+
+ my $CustomFieldObj = RT::CustomField->new($self->CurrentUser);
+ $CustomFieldObj->SetContextObject( $ticket );
+ $CustomFieldObj->LoadById($cf);
+
+ my @values;
+ if ($CustomFieldObj->Type =~ /text/i) { # Both Text and Wikitext
+ @values = ($args->{$arg});
+ } else {
+ @values = split /\n/, $args->{$arg};
+ }
+
+ if ( ($CustomFieldObj->Type eq 'Freeform'
+ && ! $CustomFieldObj->SingleValue) ||
+ $CustomFieldObj->Type =~ /text/i) {
+ foreach my $val (@values) {
+ $val =~ s/\r//g;
+ }
+ }
+
+ foreach my $value (@values) {
+ next unless length($value);
+ my ( $val, $msg ) = $ticket->AddCustomFieldValue(
+ Field => $cf,
+ Value => $value
+ );
+ push ( @results, $msg );
+ }
+ }
+ return @results;
+}
+
+sub PostProcess {
+ my $self = shift;
+ my $links = shift;
+ my $postponed = shift;
+
+ # postprocessing: add links
+
+ while ( my $template_id = shift(@$links) ) {
+ my $ticket = $T::Tickets{$template_id};
+ $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} ) )
+ {
+ next unless $link;
+
+ if ( $link =~ /^TOP$/i ) {
+ $RT::Logger->debug( "Building $type link for $link: "
+ . $T::Tickets{TOP}->Id );
+ $link = $T::Tickets{TOP}->Id;
+
+ } elsif ( $link !~ m/^\d+$/ ) {
+ my $key = "create-$link";
+ if ( !exists $T::Tickets{$key} ) {
+ $RT::Logger->debug(
+ "Skipping $type link for $key (non-existent)");
+ next;
+ }
+ $RT::Logger->debug( "Building $type link for $link: "
+ . $T::Tickets{$key}->Id );
+ $link = $T::Tickets{$key}->Id;
+ } else {
+ $RT::Logger->debug("Building $type link for $link");
+ }
+
+ 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 $template_id = shift(@$postponed) ) {
+ my $ticket = $T::Tickets{$template_id};
+ $RT::Logger->debug( "Handling postponed actions for " . $ticket->id );
+ my %args = %{ shift(@$postponed) };
+ $ticket->SetStatus( $args{Status} ) if defined $args{Status};
+ }
+
+}
+
+sub Options {
+ my $self = shift;
+ my $queues = RT::Queues->new($self->CurrentUser);
+ $queues->UnLimit;
+ my @names;
+ while (my $queue = $queues->Next) {
+ push @names, $queue->Id, $queue->Name;
+ }
+ return (
+ {
+ 'name' => 'Queue',
+ 'label' => 'In queue',
+ 'type' => 'select',
+ 'options' => \@names
+ }
+ )
+}
+
+RT::Base->_ImportOverlays();
+
+1;
+
projects / freeside.git / blobdiff