File Coverage

blib/lib/STIX/Common/Identifier.pm
Criterion Covered Total %
statement 22 24 91.6
branch 1 4 25.0
condition n/a
subroutine 9 10 90.0
pod 2 2 100.0
total 34 40 85.0


line stmt bran cond sub pod time code
1             package STIX::Common::Identifier;
2              
3 2     2   48 use 5.010001;
  2         9  
4 2     2   14 use strict;
  2         6  
  2         91  
5 2     2   13 use warnings;
  2         4  
  2         126  
6 2     2   12 use utf8;
  2         5  
  2         16  
7              
8 2     2   119 use overload '""' => \&to_string, fallback => 1;
  2         5  
  2         24  
9              
10 2     2   235 use Carp;
  2         4  
  2         312  
11 2     2   17 use Moo;
  2         5  
  2         32  
12              
13             around BUILDARGS => sub {
14              
15             my ($orig, $class, @args) = @_;
16              
17             return {value => $args[0]} if @args == 1;
18             return $class->$orig(@args);
19              
20             };
21              
22             my $IDENTIFIER_REGEXP
23             = qr{^[a-z][a-z0-9-]+[a-z0-9]--[0-9a-fA-F]{8}-[0-9a-fA-F]{4}-[1-5][0-9a-fA-F]{3}-[89abAB][0-9a-fA-F]{3}-[0-9a-fA-F]{12}$};
24              
25             has value => (
26             is => 'rw',
27             isa => sub { Carp::croak 'MUST be STIX identifier' unless $_[0] =~ /$IDENTIFIER_REGEXP/ },
28             coerce => sub { _parse($_[0]) }
29             );
30              
31             sub _parse {
32              
33 606 50   606   17219 return $_[0] if $_[0] =~ /$IDENTIFIER_REGEXP/;
34 0 0       0 return $_[0]->id if (ref($_[0]));
35              
36             }
37              
38 4614     4614 1 95726 sub to_string { shift->value }
39 0     0 1   sub TO_JSON { shift->value }
40              
41              
42             1;
43              
44             =encoding utf-8
45              
46             =head1 NAME
47              
48             STIX::Common::Identifier - Identifier type
49              
50             =head1 SYNOPSIS
51              
52             use STIX::Common::Identifier;
53              
54             my $bundle = STIX::Bundle->new( ... );
55              
56             my $id = STIX::Common::Identifier->new(value => $bundle);
57              
58             say $id; # bundle--0e60b95c-3e54-4097-9a0a-d7d637514312
59              
60              
61             =head1 DESCRIPTION
62              
63             An identifier uniquely identifies a STIX Object and MAY do so in a deterministic
64             way. A deterministic identifier means that the identifier generated by more than
65             one producer for the exact same STIX Object using the same namespace,
66             "ID Contributing Properties", and UUID method will have the exact same identifier
67             value.
68              
69             All identifiers, excluding those used in the deprecated Cyber Observable Container,
70             MUST follow the form object-type--UUID, where object-type is the exact value
71             (all type names are lowercase strings, by definition) from the type property of
72             the object being identified or referenced and where the UUID MUST be an
73             RFC 4122-compliant UUID.
74              
75             =head2 PROPERTIES
76              
77             =over
78              
79             =item value
80              
81             =back
82              
83             =head2 HELPERS
84              
85             =over
86              
87             =item $identifier->TO_JSON
88              
89             Encode the object in JSON.
90              
91             =item $identifier->to_string
92              
93             Encode the object in JSON.
94              
95             =back
96              
97              
98             =head1 SUPPORT
99              
100             =head2 Bugs / Feature Requests
101              
102             Please report any bugs or feature requests through the issue tracker
103             at L.
104             You will be notified automatically of any progress on your issue.
105              
106             =head2 Source Code
107              
108             This is open source software. The code repository is available for
109             public review and contribution under the terms of the license.
110              
111             L
112              
113             git clone https://github.com/giterlizzi/perl-STIX.git
114              
115              
116             =head1 AUTHOR
117              
118             =over 4
119              
120             =item * Giuseppe Di Terlizzi
121              
122             =back
123              
124              
125             =head1 LICENSE AND COPYRIGHT
126              
127             This software is copyright (c) 2024 by Giuseppe Di Terlizzi.
128              
129             This is free software; you can redistribute it and/or modify it under
130             the same terms as the Perl 5 programming language system itself.
131              
132             =cut