5 use RT::Test tests => 102;
9 use_ok('RT::ScripConditions');
10 use_ok('RT::ScripActions');
11 use_ok('RT::Template');
16 my $filename = File::Spec->catfile( RT::Test->temp_directory, 'link_count' );
17 open my $fh, '>', $filename or die $!;
20 my $link_acl_checks_orig = RT->Config->Get( 'StrictLinkACL' );
21 RT->Config->Set( 'StrictLinkACL', 1);
23 my $condition = RT::ScripCondition->new( RT->SystemUser );
24 $condition->Load('User Defined');
26 my $action = RT::ScripAction->new( RT->SystemUser );
27 $action->Load('User Defined');
29 my $template = RT::Template->new( RT->SystemUser );
30 $template->Load('Blank');
33 my $q1 = RT::Queue->new(RT->SystemUser);
34 my ($id,$msg) = $q1->Create(Name => "LinkTest1.$$");
36 my $q2 = RT::Queue->new(RT->SystemUser);
37 ($id,$msg) = $q2->Create(Name => "LinkTest2.$$");
40 my $commit_code = <<END;
41 open( my \$file, '<', "$filename" ) or die "couldn't open $filename";
45 \$RT::Logger->debug("Data is \$data");
47 open( \$file, '>', "$filename" ) or die "couldn't open $filename";
48 if (\$self->TransactionObj->Type eq 'AddLink') {
49 \$RT::Logger->debug("AddLink");
50 print \$file \$data+1, "\n";
52 elsif (\$self->TransactionObj->Type eq 'DeleteLink') {
53 \$RT::Logger->debug("DeleteLink");
54 print \$file \$data-1, "\n";
57 \$RT::Logger->error("THIS SHOULDN'T HAPPEN");
64 my $Scrips = RT::Scrips->new( RT->SystemUser );
66 while ( my $Scrip = $Scrips->Next ) {
67 $Scrip->Delete if $Scrip->Description and $Scrip->Description =~ /Add or Delete Link \d+/;
71 my $scrip = RT::Scrip->new(RT->SystemUser);
72 ($id,$msg) = $scrip->Create( Description => "Add or Delete Link $$",
73 ScripCondition => $condition->id,
74 ScripAction => $action->id,
75 Template => $template->id,
76 Stage => 'TransactionCreate',
78 CustomIsApplicableCode => '$self->TransactionObj->Type =~ /(Add|Delete)Link/;',
79 CustomPrepareCode => '1;',
80 CustomCommitCode => $commit_code,
82 ok($id, "Scrip created");
84 my $u1 = RT::User->new(RT->SystemUser);
85 ($id,$msg) = $u1->Create(Name => "LinkTestUser.$$");
88 # grant ShowTicket right to allow count transactions
89 ($id,$msg) = $u1->PrincipalObj->GrantRight ( Object => $q1, Right => 'ShowTicket');
91 ($id,$msg) = $u1->PrincipalObj->GrantRight ( Object => $q2, Right => 'ShowTicket');
93 ($id,$msg) = $u1->PrincipalObj->GrantRight ( Object => $q1, Right => 'CreateTicket');
96 my $creator = RT::CurrentUser->new($u1->id);
98 diag('Create tickets without rights to link');
100 # on q2 we have no rights, yet
101 my $parent = RT::Ticket->new( RT->SystemUser );
102 my ($id,$tid,$msg) = $parent->Create( Subject => 'Link test 1', Queue => $q2->id );
104 my $child = RT::Ticket->new( $creator );
105 ($id,$tid,$msg) = $child->Create( Subject => 'Link test 1', Queue => $q1->id, MemberOf => $parent->id );
107 $child->CurrentUser( RT->SystemUser );
108 is($child->_Links('Base')->Count, 0, 'link was not created, no permissions');
109 is($child->_Links('Target')->Count, 0, 'link was not create, no permissions');
112 diag('Create tickets with rights checks on one end of a link');
114 # on q2 we have no rights, but use checking one only on thing
115 RT->Config->Set( StrictLinkACL => 0 );
116 my $parent = RT::Ticket->new( RT->SystemUser );
117 my ($id,$tid,$msg) = $parent->Create( Subject => 'Link test 1', Queue => $q2->id );
119 my $child = RT::Ticket->new( $creator );
120 ($id,$tid,$msg) = $child->Create( Subject => 'Link test 1', Queue => $q1->id, MemberOf => $parent->id );
122 $child->CurrentUser( RT->SystemUser );
123 is($child->_Links('Base')->Count, 1, 'link was created');
124 is($child->_Links('Target')->Count, 0, 'link was created only one');
125 # only one scrip run (on second ticket) since this is on a ticket Create txn
126 is(link_count($filename), 1, "scrips ok");
127 RT->Config->Set( StrictLinkACL => 1 );
130 ($id,$msg) = $u1->PrincipalObj->GrantRight ( Object => $q1, Right => 'ModifyTicket');
133 diag('try to add link without rights');
135 # on q2 we have no rights, yet
136 my $parent = RT::Ticket->new( RT->SystemUser );
137 my ($id,$tid,$msg) = $parent->Create( Subject => 'Link test 1', Queue => $q2->id );
139 my $child = RT::Ticket->new( $creator );
140 ($id,$tid,$msg) = $child->Create( Subject => 'Link test 1', Queue => $q1->id );
142 ($id, $msg) = $child->AddLink(Type => 'MemberOf', Target => $parent->id);
144 is(link_count($filename), 0, "scrips ok");
145 $child->CurrentUser( RT->SystemUser );
146 is($child->_Links('Base')->Count, 0, 'link was not created, no permissions');
147 is($child->_Links('Target')->Count, 0, 'link was not create, no permissions');
150 diag('add link with rights only on base');
152 # on q2 we have no rights, but use checking one only on thing
153 RT->Config->Set( StrictLinkACL => 0 );
154 my $parent = RT::Ticket->new( RT->SystemUser );
155 my ($id,$tid,$msg) = $parent->Create( Subject => 'Link test 1', Queue => $q2->id );
157 my $child = RT::Ticket->new( $creator );
158 ($id,$tid,$msg) = $child->Create( Subject => 'Link test 1', Queue => $q1->id );
160 ($id, $msg) = $child->AddLink(Type => 'MemberOf', Target => $parent->id);
162 is(link_count($filename), 2, "scrips ok");
163 $child->CurrentUser( RT->SystemUser );
164 is($child->_Links('Base')->Count, 1, 'link was created');
165 is($child->_Links('Target')->Count, 0, 'link was created only one');
166 $child->CurrentUser( $creator );
168 # turn off feature and try to delete link, we should fail
169 RT->Config->Set( StrictLinkACL => 1 );
170 ($id, $msg) = $child->DeleteLink(Type => 'MemberOf', Target => $parent->id);
172 is(link_count($filename), 0, "scrips ok");
173 $child->CurrentUser( RT->SystemUser );
174 $child->_Links('Base')->_DoCount;
175 is($child->_Links('Base')->Count, 1, 'link was not deleted');
176 $child->CurrentUser( $creator );
178 # try to delete link, we should success as feature is active
179 RT->Config->Set( StrictLinkACL => 0 );
180 ($id, $msg) = $child->DeleteLink(Type => 'MemberOf', Target => $parent->id);
182 is(link_count($filename), -2, "scrips ok");
183 $child->CurrentUser( RT->SystemUser );
184 $child->_Links('Base')->_DoCount;
185 is($child->_Links('Base')->Count, 0, 'link was deleted');
186 RT->Config->Set( StrictLinkACL => 1 );
190 my $ticket = RT::Ticket->new( $creator);
191 ok($ticket->isa('RT::Ticket'));
192 ($id,$tid, $msg) = $ticket->Create(Subject => 'Link test 1', Queue => $q1->id);
195 diag('try link to itself');
198 ($id, $msg) = $ticket->AddLink(Type => 'RefersTo', Target => $ticket->id);
199 } qr/Can't link a ticket to itself/;
201 is(link_count($filename), 0, "scrips ok");
204 my $ticket2 = RT::Ticket->new(RT->SystemUser);
205 ($id, $tid, $msg) = $ticket2->Create(Subject => 'Link test 2', Queue => $q2->id);
207 ($id,$msg) =$ticket->AddLink(Type => 'RefersTo', Target => $ticket2->id);
209 is(link_count($filename), 0, "scrips ok");
211 ($id,$msg) = $u1->PrincipalObj->GrantRight ( Object => $q2, Right => 'CreateTicket');
213 ($id,$msg) = $u1->PrincipalObj->GrantRight ( Object => $q2, Right => 'ModifyTicket');
215 ($id,$msg) = $ticket->AddLink(Type => 'RefersTo', Target => $ticket2->id);
217 is(link_count($filename), 2, "scrips ok");
220 ($id,$msg) = $ticket->AddLink(Type => 'RefersTo', Target => -1);
222 qr/Could not determine a URI scheme for -1/,
225 ($id,$msg) = $ticket->AddLink(Type => 'RefersTo', Target => $ticket2->id);
227 is(link_count($filename), 0, "scrips ok"); # already added
229 my $transactions = $ticket2->Transactions;
230 $transactions->Limit( FIELD => 'Type', VALUE => 'AddLink' );
231 is( $transactions->Count, 1, "Transaction found in other ticket" );
232 is( $transactions->First->Field , 'ReferredToBy');
233 is( $transactions->First->NewValue , $ticket->URI );
235 ($id,$msg) = $ticket->DeleteLink(Type => 'RefersTo', Target => $ticket2->id);
237 is(link_count($filename), -2, "scrips ok");
238 $transactions = $ticket2->Transactions;
239 $transactions->Limit( FIELD => 'Type', VALUE => 'DeleteLink' );
240 is( $transactions->Count, 1, "Transaction found in other ticket" );
241 is( $transactions->First->Field , 'ReferredToBy');
242 is( $transactions->First->OldValue , $ticket->URI );
244 ($id,$msg) =$ticket->AddLink(Type => 'RefersTo', Target => $ticket2->id);
246 is(link_count($filename), 2, "scrips ok");
247 ($id,$msg) =$ticket->DeleteLink(Type => 'RefersTo', Target => $ticket2->id);
249 is(link_count($filename), -2, "scrips ok");
251 # tests for silent behaviour
252 ($id,$msg) = $ticket->AddLink(Type => 'RefersTo', Target => $ticket2->id, Silent => 1);
254 is(link_count($filename), 0, "scrips ok");
256 my $transactions = $ticket->Transactions;
257 $transactions->Limit( FIELD => 'Type', VALUE => 'AddLink' );
258 is( $transactions->Count, 2, "Still two txns on the base" );
260 $transactions = $ticket2->Transactions;
261 $transactions->Limit( FIELD => 'Type', VALUE => 'AddLink' );
262 is( $transactions->Count, 2, "Still two txns on the target" );
265 ($id,$msg) =$ticket->DeleteLink(Type => 'RefersTo', Target => $ticket2->id, Silent => 1);
267 is(link_count($filename), 0, "scrips ok");
269 ($id,$msg) = $ticket->AddLink(Type => 'RefersTo', Target => $ticket2->id, SilentBase => 1);
271 is(link_count($filename), 1, "scrips ok");
273 my $transactions = $ticket->Transactions;
274 $transactions->Limit( FIELD => 'Type', VALUE => 'AddLink' );
275 is( $transactions->Count, 2, "still five txn on the base" );
277 $transactions = $ticket2->Transactions;
278 $transactions->Limit( FIELD => 'Type', VALUE => 'AddLink' );
279 is( $transactions->Count, 3, "+1 txn on the target" );
282 ($id,$msg) =$ticket->DeleteLink(Type => 'RefersTo', Target => $ticket2->id, SilentBase => 1);
284 is(link_count($filename), -1, "scrips ok");
286 ($id,$msg) = $ticket->AddLink(Type => 'RefersTo', Target => $ticket2->id, SilentTarget => 1);
288 is(link_count($filename), 1, "scrips ok");
290 my $transactions = $ticket->Transactions;
291 $transactions->Limit( FIELD => 'Type', VALUE => 'AddLink' );
292 is( $transactions->Count, 3, "+1 txn on the base" );
294 $transactions = $ticket2->Transactions;
295 $transactions->Limit( FIELD => 'Type', VALUE => 'AddLink' );
296 is( $transactions->Count, 3, "three txns on the target" );
298 ($id,$msg) =$ticket->DeleteLink(Type => 'RefersTo', Target => $ticket2->id, SilentTarget => 1);
300 is(link_count($filename), -1, "scrips ok");
304 RT->Config->Set( StrictLinkACL => $link_acl_checks_orig );
307 my $Scrips = RT::Scrips->new( RT->SystemUser );
308 $Scrips->Limit( FIELD => 'Description', OPERATOR => 'STARTSWITH', VALUE => 'Add or Delete Link ');
309 while ( my $s = $Scrips->Next ) { $s->Delete };
313 my $link = RT::Link->new( RT->SystemUser );
314 ($id,$msg) = $link->Create( Base => $ticket->URI, Target => $ticket2->URI, Type => 'MyLinkType' );
316 ok($link->LocalBase == $ticket->id, "LocalBase set correctly");
317 ok($link->LocalTarget == $ticket2->id, "LocalTarget set correctly");
321 *RT::NotTicket::Id = sub { return $$ };
322 *RT::NotTicket::id = \&RT::NotTicket::Id;
326 package RT::URI::not_ticket;
329 @ISA = qw/RT::URI::base/;
331 sub Object { return bless {}, 'RT::NotTicket'; }
334 my $orig_getresolver = \&RT::URI::_GetResolver;
336 no warnings 'redefine';
337 *RT::URI::_GetResolver = sub {
341 $scheme =~ s/(\.|-)/_/g;
343 my $module = "RT::URI::$scheme";
344 $resolver = $module->new($self->CurrentUser);
347 $self->{'resolver'} = $resolver;
349 $self->{'resolver'} = RT::URI::base->new($self->CurrentUser);
354 ($id,$msg) = $link->Create( Base => "not_ticket::$RT::Organization/notticket/$$", Target => $ticket2->URI, Type => 'MyLinkType' );
356 ok($link->LocalBase == 0, "LocalBase set correctly");
357 ok($link->LocalTarget == $ticket2->id, "LocalTarget set correctly");
359 ($id,$msg) = $link->Create( Target => "not_ticket::$RT::Organization/notticket/$$", Base => $ticket->URI, Type => 'MyLinkType' );
361 ok($link->LocalTarget == 0, "LocalTarget set correctly");
362 ok($link->LocalBase == $ticket->id, "LocalBase set correctly");
364 ($id,$msg) = $link->Create(
365 Target => "not_ticket::$RT::Organization/notticket/1$$",
366 Base => "not_ticket::$RT::Organization/notticket/$$",
367 Type => 'MyLinkType' );
370 ok($link->LocalTarget == 0, "LocalTarget set correctly");
371 ok($link->LocalBase == 0, "LocalBase set correctly");
373 # restore _GetResolver
375 no warnings 'redefine';
376 *RT::URI::_GetResolver = $orig_getresolver;
381 open( my $fh, '<', $file ) or die "couldn't open $file";
386 return 0 unless defined $data;