"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;