File: perl.t

package info (click to toggle)
libmetabase-fact-perl 0.025-2
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster
  • size: 364 kB
  • ctags: 125
  • sloc: perl: 1,076; makefile: 2
file content (71 lines) | stat: -rw-r--r-- 2,198 bytes parent folder | download | duplicates (3)
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
# 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::Fatal;

use lib 't/lib';

plan tests => 10;

require_ok('Metabase::Resource');

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

my ( $obj, $err );

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

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

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

my $sha1   = "8c57606294f48eb065dff03f7ffefc1e4e2cdce4";
my $string = "perl:///commit/$sha1";

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

isa_ok( $obj, 'Metabase::Resource::perl' );

is( $obj->resource, $string, "object content correct" );

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

# test metadata

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

my $expected_metadata = {
    type => 'Metabase-Resource-perl-commit',
    sha1 => $sha1,
};

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

is( $obj->sha1, $sha1, "sha1() correct" );
is( $obj->full_url, "http://perl5.git.perl.org/perl.git/$sha1", "full_url()", );
is(
    $obj->full_url('example.com'),
    "http://example.com/perl.git/$sha1",
    "full_url('example.com')"
);