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
|
#!perl -T
use strict;
use warnings;
use Test::More;
use URI::PackageURL;
my $t1 = 'pkg:cpan/GDT/URI-PackageURL@2.22';
my $t2 = 'pkg:deb/debian/curl@7.50.3-1?arch=i386&distro=jessie';
my $t3 = 'pkg:golang/google.golang.org/genproto@abcdedf#googleapis/api/annotations';
my $t4 = 'pkg:docker/customer/dockerimage@sha256:244fd47e07d1004f0aed9c?repository_url=gcr.io';
my $t5 = 'pkg:generic/ns/n@m#?@version?qualifier=#v@lue#subp@th?';
subtest "Decode '$t1'" => sub {
my $purl = decode_purl($t1);
is($purl->type, 'cpan', 'Type');
is($purl->namespace, 'GDT', 'Namespace');
is($purl->name, 'URI-PackageURL', 'Name');
is($purl->version, '2.22', 'Version');
is($purl->to_string, $t1, 'PackageURL');
};
subtest "Decode '$t2'" => sub {
my $purl = decode_purl($t2);
is($purl->type, 'deb', 'Type');
is($purl->namespace, 'debian', 'Namespace');
is($purl->name, 'curl', 'Name');
is($purl->version, '7.50.3-1', 'Version');
is($purl->qualifiers->{arch}, 'i386', 'Qualifier "arch"');
is($purl->qualifiers->{distro}, 'jessie', 'Qualifier "distro"');
is($purl->to_string, $t2, 'PackageURL');
};
subtest "Decode '$t3'" => sub {
my $purl = decode_purl($t3);
is($purl->type, 'golang', 'Type');
is($purl->namespace, 'google.golang.org', 'Namespace');
is($purl->name, 'genproto', 'Name');
is($purl->version, 'abcdedf', 'Version');
is($purl->subpath, 'googleapis/api/annotations', 'Subpath');
is($purl->to_string, $t3, 'PackageURL');
};
subtest "Decode '$t4'" => sub {
my $purl = decode_purl($t4);
is($purl->type, 'docker', 'Type');
is($purl->namespace, 'customer', 'Namespace');
is($purl->name, 'dockerimage', 'Name');
is($purl->version, 'sha256:244fd47e07d1004f0aed9c', 'Version');
is($purl->qualifiers->{repository_url}, 'gcr.io', 'Qualifier "repository_url"');
is($purl->to_string, $t4, 'PackageURL');
};
subtest "Decode '$t5'" => sub {
my $purl = decode_purl($t5);
is($purl->type, 'generic', 'Type');
is($purl->namespace, 'ns', 'Namespace');
is($purl->name, 'n@m#?', 'Name');
is($purl->version, 'version', 'Version');
is($purl->qualifiers->{qualifier}, '#v@lue', 'Qualifier "qualifier"');
is($purl->subpath, 'subp@th?', 'Subpath');
};
done_testing();
|
