File: base.t

package info (click to toggle)
libmetabase-fact-perl 0.022-1
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 328 kB
  • ctags: 125
  • sloc: perl: 1,021; makefile: 2
file content (90 lines) | stat: -rw-r--r-- 2,945 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
# Copyright (c) 2010 by David Golden. All rights reserved.
# Licensed under terms of Perl itself (the "License").
# You may not use this file except in compliance with the License.
# A copy of the License was distributed with this file or you may obtain a 
# copy of the License from http://dev.perl.org/licenses/

use strict;
use warnings;

use Test::More;
use Test::Exception;

use lib 't/lib';

plan tests => 14;

require_ok( 'Metabase::Resource' );
require_ok( 'Metabase::Resource::metabase' );

#--------------------------------------------------------------------------#
# fixtures
#--------------------------------------------------------------------------#    

my ($obj, $err);

#--------------------------------------------------------------------------#
# required parameters missing
#--------------------------------------------------------------------------#

eval { $obj = Metabase::Resource->new() };
$err = $@;
like( $err, qr/no resource string provided/, "new() without string throws error" );

#--------------------------------------------------------------------------#
# fake an object and test methods
#--------------------------------------------------------------------------#

# unimplemented
for my $m ( qw/validate/ ) {
    my $obj = bless {} => 'Metabase::Resource';
    eval { $obj->$m };
    like( $@, qr/$m not implemented by Metabase::Resource/, "$m not implemented");
}

# bad schema
eval { $obj = Metabase::Resource->new("noschema") };
like( $@, qr/could not determine URI scheme from/, "no schema found" );

#--------------------------------------------------------------------------#
# new should create proper subtype object
#--------------------------------------------------------------------------#

my $string = "metabase:user:b66c7662-1d34-11de-a668-0df08d1878c0";

lives_ok{ $obj = Metabase::Resource->new( $string ) } 
    "Metabase::Resource->new(\$string) should not die";

isa_ok( $obj, 'Metabase::Resource::metabase' ); 
isa_ok( $obj, 'Metabase::Resource::metabase::user' ); 

is( $obj->resource, $string, "\$obj->resource correct" );
is( "$obj", $string, "string overloading working correctly" );

#--------------------------------------------------------------------------#
# generates typed metadata
#--------------------------------------------------------------------------#

# test metadata

my $metadata_types = {
  type  => '//str',
  guid    => '//str',
};

my $expected_metadata = {
  type => 'Metabase-Resource-metabase-user',
  guid    => 'b66c7662-1d34-11de-a668-0df08d1878c0',
};

is_deeply( $metadata_types, $obj->metadata_types, "Metadata types" );
is_deeply( $expected_metadata, $obj->metadata, "Metadata" );

#--------------------------------------------------------------------------#
# accessors
#--------------------------------------------------------------------------#

for my $k ( sort keys %$expected_metadata ) {
  is($obj->$k, $expected_metadata->{$k}, "\$obj->$k");
}