[Bps-public-commit] r17098 - in RTx-WorkflowBuilder: bin lib lib/RTx t
clkao at bestpractical.com
clkao at bestpractical.com
Thu Dec 4 08:23:09 EST 2008
Author: clkao
Date: Thu Dec 4 08:23:08 2008
New Revision: 17098
Added:
RTx-WorkflowBuilder/Makefile.PL
RTx-WorkflowBuilder/bin/
RTx-WorkflowBuilder/bin/rt-workflow
RTx-WorkflowBuilder/lib/
RTx-WorkflowBuilder/lib/RTx/
RTx-WorkflowBuilder/lib/RTx/WorkflowBuilder.pm
RTx-WorkflowBuilder/t/
RTx-WorkflowBuilder/t/basic.t
Log:
first cut of RTx::WorkflowBuilder
Added: RTx-WorkflowBuilder/Makefile.PL
==============================================================================
--- (empty file)
+++ RTx-WorkflowBuilder/Makefile.PL Thu Dec 4 08:23:08 2008
@@ -0,0 +1,15 @@
+use inc::Module::Install;
+
+RTx('RT-Authen-OpenID');
+
+name ('RT-Authen-OpenID');
+abstract ('Allows RT to do authentication via a service which supports the OpenID API');
+author ('Artur Bergman <sky at crucially.net> and Jesse Vincent <jesse at bestpractical.com>');
+version_from ('lib/RT/Authen/OpenID.pm');
+license ('GPL version 2');
+
+requires ('Net::OpenID::Consumer');
+requires ('LWPx::ParanoidAgent');
+requires ('Cache::FileCache');
+
+&WriteAll;
Added: RTx-WorkflowBuilder/bin/rt-workflow
==============================================================================
--- (empty file)
+++ RTx-WorkflowBuilder/bin/rt-workflow Thu Dec 4 08:23:08 2008
@@ -0,0 +1,81 @@
+#!/usr/bin/perl -w
+use strict;
+use warnings;
+use Getopt::Long;
+use RTx::WorkflowBuilder;
+
+my ($queue, $wf_name) = @ARGV;
+
+my %opts;
+GetOptions( \%opts, "create" );
+
+use RT::Interface::CLI qw(CleanEnv
+ GetCurrentUser GetMessageContent);
+CleanEnv();
+
+#Load etc/config.pm and drop privs
+RT::LoadConfig();
+RT::Init();
+
+my $q = RT::Queue->new($RT::SystemUser);
+$q->Load($queue) or die "Can't load queue: $queue";
+
+my $stages = RT::Config->Get('WorkflowBuilderStages');
+
+my $workflows = RT::Config->Get('WorkflowBuilderRules');
+
+my $scrips = RT::Scrips->new($RT::SystemUser);
+$scrips->Limit( FIELD => 'Queue',
+ VALUE => $q->Id );
+
+my $workflow_script;
+
+die "no workflow named $wf_name found" unless $workflows->{$wf_name};
+
+# XXX: ensure all stages exist
+
+while (my $scrip = $scrips->Next) {
+ # XXX: make sure it's *our* scrip
+ # next unless .....
+
+ warn $scrip->TemplateObj->Name;
+ if ($workflow_script) {
+ die "two scrips exist for queue @{[ $q->Name ]} workflow: ";
+ }
+ $workflow_script = $scrip;
+}
+
+my $approval_template = RTx::WorkflowBuilder->new
+ ({ stages => $stages,
+ rule => $workflows->{$wf_name} })
+ ->compile_template;
+
+warn $approval_template;
+
+if (!$workflow_script) {
+ die "no workflow found, use --create" unless $opts{create};
+
+ my $scrip = RT::Scrip->new($RT::SystemUser);
+
+ my $apptemp = RT::Template->new($RT::SystemUser);
+ $apptemp->Create( Content => $approval_template,
+ Name => $wf_name, Queue => $q->Id);
+
+ my ($sval, $smsg) = $scrip->Create( ScripCondition => 'On Create',
+ ScripAction => 'Create Tickets',
+ Template => $apptemp->Id,
+ Queue => $q->Id);
+}
+else {
+ die "workflow already exists" if $opts{create};
+ warn "updating... $wf_name for @{[ $q->Name ]}";
+
+ warn "template name changed"
+ if $workflow_script->TemplateObj->Name ne $wf_name;
+ $workflow_script->TemplateObj->SetContent($approval_template);
+ $workflow_script->TemplateObj->SetName($wf_name);
+}
+
+
+1;
+
Added: RTx-WorkflowBuilder/lib/RTx/WorkflowBuilder.pm
==============================================================================
--- (empty file)
+++ RTx-WorkflowBuilder/lib/RTx/WorkflowBuilder.pm Thu Dec 4 08:23:08 2008
@@ -0,0 +1,73 @@
+package RTx::WorkflowBuilder;
+use base 'Class::Accessor::Fast';
+
+__PACKAGE__->mk_accessors(qw(stages rule));
+
+sub get_stage_object {
+ my ($self, $stage, $previous, $approving) = @_;
+ if (ref $stage eq 'ARRAY') {
+ my @chain = @$stage;
+ for (0..$#chain) {
+ push @result,
+ $self->get_stage_object($chain[$_],
+ $_ ? $chain[$_-1] : undef,
+ $_ == $#chain ? $approving : undef,
+ );
+ }
+ return \@result;
+ }
+ elsif (ref $stage) {
+ die "invalid argument $stage";
+ }
+ else {
+ die "Stage $stage not defined" unless exists $self->stages->{$stage};
+ return RTx::WorkflowBuilder::Stage->new( { name => $stage,
+ depends_on => $previous,
+ depended_on_by => $approving,
+ %{ $self->stages->{$stage} } });
+ }
+}
+
+sub compile_template {
+ my $self = shift;
+ my $stages = $self->get_stage_object($self->rule, undef, 'TOP');
+ return join('', map { $_->compile_template }
+ map { ref $_ eq 'ARRAY' ? @$_ : $_ } @$stages )."\n"; # flatten with map
+}
+
+package RTx::WorkflowBuilder::Stage;
+use base 'Class::Accessor::Fast';
+
+__PACKAGE__->mk_accessors(qw(name owner content depends_on depended_on_by subject));
+
+sub compile_template {
+ my $self = shift;
+
+ my $attributes = { Queue => '___Approvals',
+ Type => 'approval',
+ Owner => $self->owner,
+ Requestors => '{$Approving->Requestors}',
+ Subject => $self->subject || 'Approval for ticket {$Approving->Id}: {$Approving->Subject}',
+ 'Refers-To' => 'TOP',
+ Due => '{time + 86400}', # XXX: configurable
+ 'Content-Type' => 'text/plain',
+ $self->depends_on ? (
+ 'Depends-On' => "workflow-".$self->depends_on,
+ ) : (),
+ $self->depended_on_by ? (
+ 'Depended-On-By' => $self->depended_on_by,
+ ) : (),
+ };
+
+ for (values %$attributes) {
+ s/\$Approving/\$Tickets{TOP}/g;
+ }
+
+
+ return join("\n",
+ "===Create-Ticket: workflow-".$self->name,
+ (map { "$_: $attributes->{$_}" } keys %$attributes),
+ "Content: @{[$self->content]}\nENDOFCONTENT\n");
+}
+
+1;
Added: RTx-WorkflowBuilder/t/basic.t
==============================================================================
--- (empty file)
+++ RTx-WorkflowBuilder/t/basic.t Thu Dec 4 08:23:08 2008
@@ -0,0 +1,196 @@
+use strict;
+use warnings;
+use Test::More;
+
+BEGIN {
+ eval { require Email::Abstract; require Test::Email; 1 }
+ or plan skip_all => 'require Email::Abstract and Test::Email';
+}
+
+plan tests => 38;
+use RT;
+use RT::Test;
+use RT::Test::Email;
+use_ok('RTx::WorkflowBuilder');
+
+RT->Config->Set( LogToScreen => 'debug' );
+
+my ($baseurl, $m) = RT::Test->started_ok;
+
+my ($user_a, $user_b) = (RT::User->new($RT::SystemUser), RT::User->new($RT::SystemUser));
+my ($user_c) = RT::User->new($RT::SystemUser);
+
+my $q = RT::Queue->new($RT::SystemUser);
+$q->Load('___Approvals');
+
+$q->SetDisabled(0);
+
+my %users;
+for my $user_name (qw(minion jen moss roy cfo ceo )) {
+ my $user = $users{$user_name} = RT::User->new($RT::SystemUser);
+ $user->Create( Name => uc($user_name),
+ Privileged => 1,
+ EmailAddress => $user_name.'@company.com');
+ my ($val, $msg);
+ ($val, $msg) = $user->PrincipalObj->GrantRight(Object =>$q, Right => $_)
+ for qw(ModifyTicket OwnTicket ShowTicket);
+
+}
+
+my $stages =
+ { 'Manager approval' =>
+ { content => '.....',
+ subject => 'Manager Approval for PO: {$Approving->Id} - {$Approving->Subject}',
+ owner => q!{{
+ Fire => "moss",
+ IT => "roy",
+ Marketing => "jen"}->{ $Approving->FirstCustomFieldValue('Department') }}!,
+ },
+ 'Finance approval' =>
+ { content => '... ',
+ owner => 'CFO',
+ },
+ 'CEO approval' =>
+ { content => '..........',
+ owner => 'CEO',
+ }};
+
+my $approvals = RTx::WorkflowBuilder->new({ stages => $stages, rule => [ 'Manager approval' => 'Finance approval', 'CEO approval']})->compile_template;
+my $apptemp = RT::Template->new($RT::SystemUser);
+$apptemp->Create( Content => $approvals, Name => "PO Approvals", Queue => "0");
+
+ok($apptemp->Id);
+
+$q = RT::Queue->new($RT::SystemUser);
+$q->Create(Name => 'PO');
+ok ($q->Id, "Created PO queue");
+
+my $dep_cf = RT::CustomField->new( $RT::SystemUser );
+$dep_cf->Create( Name => 'Department', Type => 'SelectSingle', Queue => $q->id );
+$dep_cf->AddValue( Name => $_ ) for qw(IT Marketing Fire);
+
+
+my $scrip = RT::Scrip->new($RT::SystemUser);
+my ($sval, $smsg) =$scrip->Create( ScripCondition => 'On Create',
+ ScripAction => 'Create Tickets',
+ Template => 'PO 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);
+my ($tid, $ttrans, $tmsg);
+
+mail_ok {
+ ($tid, $ttrans, $tmsg) =
+ $t->Create(Subject => "answering machines",
+ Owner => "root", Requestor => 'minion',
+ 'CustomField-'.$dep_cf->id => 'IT',
+ Queue => $q->Id);
+} { from => qr/PO via RT/,
+ to => 'minion at company.com',
+ subject => qr/answering machines/,
+ body => qr/automatically generated in response/
+};
+
+ok ($tid,$tmsg);
+
+is ($t->ReferredToBy->Count,3, "referred to by the three tickets");
+
+# open the approval tickets that are ready for approval
+mail_ok {
+ for my $ticket ($t->AllDependsOn) {
+ next if $ticket->Type ne 'approval' && $ticket->Status ne 'new';
+ next if $ticket->HasUnresolvedDependencies( Type => 'approval' );
+ $ticket->SetStatus('open');
+ }
+} { from => qr/RT System/,
+ to => 'roy at company.com',
+ subject => qr/New Pending Approval: Manager Approval/,
+ body => qr/pending your approval/
+};
+
+my $deps = $t->DependsOn;
+is ($deps->Count, 1, "The ticket we created depends on one other ticket");
+my $dependson_ceo= $deps->First->TargetObj;
+ok ($dependson_ceo->Id, "It depends on a real ticket");
+like($dependson_ceo->Subject, qr/Approval for ticket.*answering machine/);
+
+$deps = $dependson_ceo->DependsOn;
+is ($deps->Count, 1, "The ticket we created depends on one other ticket");
+my $dependson_cfo = $deps->First->TargetObj;
+ok ($dependson_cfo->Id, "It depends on a real ticket");
+
+$deps = $dependson_cfo->DependsOn;
+is ($deps->Count, 1, "The ticket we created depends on one other ticket");
+my $dependson_roy = $deps->First->TargetObj;
+ok ($dependson_roy->Id, "It depends on a real ticket");
+
+like($dependson_roy->Subject, qr/Manager Approval for PO.*answering machines/);
+
+is_deeply([ map { $_->Status } $t, $dependson_roy, $dependson_cfo, $dependson_ceo ],
+ [ 'new', 'open', 'new', 'new'], 'tickets in correct state');
+
+mail_ok {
+ my $roy = RT::CurrentUser->new;
+ $roy->Load( $users{roy} );
+
+ $dependson_cfo->CurrentUser($roy);
+ my ($ok, $msg) = $dependson_roy->SetStatus( Status => 'resolved' );
+ ok($ok, "roy can approve - $msg");
+
+} { from => qr/RT System/,
+ to => 'cfo at company.com',
+ subject => qr/New Pending Approval/,
+ body => qr/pending your approval/
+},{ from => qr/RT System/, # why is this not roy?
+ to => 'minion at company.com',
+ subject => qr/Ticket Approved:/,
+ body => qr/approved by ROY/
+};
+
+is_deeply([ map { $_->Status } $t, $dependson_roy, $dependson_cfo, $dependson_ceo ],
+ [ 'new', 'resolved', 'open', 'new'], 'tickets in correct state');
+
+# cfo approves
+mail_ok {
+ my $cfo = RT::CurrentUser->new;
+ $cfo->Load( $users{cfo} );
+
+ $dependson_cfo->CurrentUser($cfo);
+ my ($ok, $msg) = $dependson_cfo->SetStatus( Status => 'resolved' );
+ ok($ok, "cfo can approve - $msg");
+
+} { from => qr/RT System/,
+ to => 'ceo at company.com',
+ subject => qr/New Pending Approval/,
+ body => qr/pending your approval/
+},{ from => qr/CFO via RT/,
+ to => 'minion at company.com',
+ subject => qr/Ticket Approved:/,
+ body => qr/approved by CFO/
+};
+
+is_deeply([ map { $_->Status } $t, $dependson_roy, $dependson_cfo, $dependson_ceo ],
+ [ 'new', 'resolved', 'resolved', 'open'], 'tickets in correct state');
+
+# ceo approves
+mail_ok {
+ my $ceo = RT::CurrentUser->new;
+ $ceo->Load( $users{ceo} );
+
+ $dependson_ceo->CurrentUser($ceo);
+ my ($ok, $msg) = $dependson_ceo->SetStatus( Status => 'resolved' );
+ ok($ok, "ceo can approve - $msg");
+
+} { from => qr/CEO via RT/,
+ to => 'minion at company.com',
+ subject => qr/Ticket Approved:/,
+ body => qr/approved by CEO/
+};
+
+is_deeply([ map { $_->Status } $t, $dependson_roy, $dependson_cfo, $dependson_ceo ],
+ [ 'new', 'resolved', 'resolved', 'resolved'], 'tickets in correct state');
More information about the Bps-public-commit
mailing list