"Fossies" - the Fresh Open Source Software Archive 
Member "RT-Extension-Assets-1.05/xt/links.t" (8 Nov 2013, 4168 Bytes) of package /linux/misc/RT-Extension-Assets-1.05.tar.gz:
As a special service "Fossies" has tried to format the requested text file into HTML format (style:
standard) with prefixed line numbers.
Alternatively you can here
view or
download the uninterpreted source code file.
1 use strict;
2 use warnings;
3
4 use lib 'xt/lib';
5 use RT::Extension::Assets::Test tests => undef;
6 use Test::Warn;
7
8 my $catalog = create_catalog( Name => "BPS" );
9 ok $catalog && $catalog->id, "Created Catalog";
10
11 ok(
12 create_assets(
13 { Name => "Thinkpad T420s", Catalog => $catalog->id },
14 { Name => "Standing desk", Catalog => $catalog->id },
15 { Name => "Chair", Catalog => $catalog->id },
16 ),
17 "Created assets"
18 );
19
20 my $ticket = RT::Test->create_ticket(
21 Queue => 1,
22 Subject => 'a test ticket',
23 );
24 ok $ticket->id, "Created ticket";
25
26 diag "RT::URI::asset";
27 {
28 my %uris = (
29 # URI => Asset Name
30 "asset:1" => { id => 1, Name => "Thinkpad T420s" },
31 "asset://example.com/2" => { id => 2, Name => "Standing desk" },
32 "asset:13" => undef,
33 );
34
35 while (my ($url, $expected) = each %uris) {
36 my $uri = RT::URI->new( RT->SystemUser );
37 if ($expected) {
38 my $parsed = $uri->FromURI($url);
39 ok $parsed, "Parsed $url";
40
41 my $asset = $uri->Object;
42 ok $asset, "Got object";
43 is ref($asset), "RT::Asset", "... it's a RT::Asset";
44
45 while (my ($field, $value) = each %$expected) {
46 is $asset->$field, $value, "... $field is $value";
47 }
48 } else {
49 my $parsed;
50 warnings_like {
51 $parsed = $uri->FromURI($url);
52 } [qr/\Q$url\E/, qr/\Q$url\E/], "Caught warnings about unknown URI";
53 ok !$parsed, "Failed to parse $url, as expected";
54 }
55 }
56 }
57
58 diag "RT::Asset link support";
59 {
60 my $chair = RT::Asset->new( RT->SystemUser );
61 $chair->LoadByCols( Name => "Chair" );
62 ok $chair->id, "Loaded asset";
63 is $chair->URI, "asset://example.com/".$chair->id, "->URI works";
64
65 my ($link_id, $msg) = $chair->AddLink( Type => 'MemberOf', Target => 'asset:2' );
66 ok $link_id, "Added link: $msg";
67
68 my $parents = $chair->MemberOf;
69 my $desk = $parents->First->TargetObj;
70 is $parents->Count, 1, "1 parent";
71 is $desk->Name, "Standing desk", "Correct parent asset";
72
73 for my $asset ($chair, $desk) {
74 my $txns = $asset->Transactions;
75 $txns->Limit( FIELD => 'Type', VALUE => 'AddLink' );
76 is $txns->Count, 1, "1 AddLink txn on asset ".$asset->Name;
77 }
78
79 my ($ok, $err) = $chair->DeleteLink( Type => 'MemberOf', Target => 'asset:1' );
80 ok !$ok, "Delete link failed on non-existent: $err";
81
82 my ($deleted, $delete_msg) = $chair->DeleteLink( Type => 'MemberOf', Target => $parents->First->Target );
83 ok $deleted, "Deleted link: $delete_msg";
84
85 for my $asset ($chair, $desk) {
86 my $txns = $asset->Transactions;
87 $txns->Limit( FIELD => 'Type', VALUE => 'DeleteLink' );
88 is $txns->Count, 1, "1 DeleteLink txn on asset ".$asset->Name;
89 }
90 };
91
92 diag "Linking to tickets";
93 {
94 my $laptop = RT::Asset->new( RT->SystemUser );
95 $laptop->LoadByCols( Name => "Thinkpad T420s" );
96
97 my ($ok, $msg) = $ticket->AddLink( Type => 'RefersTo', Target => $laptop->URI );
98 ok $ok, "Ticket refers to asset: $msg";
99
100 my $links = $laptop->ReferredToBy;
101 is $links->Count, 1, "Found a ReferredToBy link via asset";
102
103 ($ok, $msg) = $laptop->DeleteLink( Type => 'RefersTo', Base => $ticket->URI );
104 ok $ok, "Deleted link from opposite side: $msg";
105 }
106
107 diag "Links on ->Create";
108 {
109 my $desk = RT::Asset->new( RT->SystemUser );
110 $desk->LoadByCols( Name => "Standing desk" );
111 ok $desk->id, "Loaded standing desk asset";
112
113 my $asset = create_asset(
114 Name => "Anti-fatigue mat",
115 Catalog => $catalog->id,
116 Parent => $desk->URI,
117 ReferredToBy => [$ticket->id],
118 );
119 ok $asset->id, "Created asset with Parent link";
120
121 my $parents = $asset->MemberOf;
122 is $parents->Count, 1, "Found one Parent";
123 is $parents->First->Target, $desk->URI, "... it's a desk!";
124
125 my $referrals = $asset->ReferredToBy;
126 is $referrals->Count, 1, "Found one ReferredToBy";
127 is $referrals->First->Base, $ticket->URI, "... it's the ticket!";
128 }
129
130 done_testing;