File Coverage

blib/lib/STIX/Common/Binary.pm
Criterion Covered Total %
statement 28 28 100.0
branch 1 2 50.0
condition n/a
subroutine 11 11 100.0
pod 2 2 100.0
total 42 43 97.6


line stmt bran cond sub pod time code
1             package STIX::Common::Binary;
2              
3 25     25   514 use 5.010001;
  25         109  
4 25     25   156 use strict;
  25         84  
  25         878  
5 25     25   185 use warnings;
  25         88  
  25         3042  
6 25     25   168 use utf8;
  25         250  
  25         3523  
7              
8 25     25   2860 use overload '""' => \&to_string, fallback => 1;
  25         687  
  25         303  
9              
10 25     25   2431 use Carp;
  25         292  
  25         2215  
11 25     25   174 use MIME::Base64;
  25         48  
  25         1505  
12              
13 25     25   149 use Moo;
  25         54  
  25         182  
14              
15             around BUILDARGS => sub {
16              
17             my ($orig, $class, @args) = @_;
18              
19             return {value => $args[0]} if @args == 1;
20             return $class->$orig(@args);
21              
22             };
23              
24             my $BASE64_REGEXP = qr{^([A-Za-z0-9+/]{4})*([A-Za-z0-9+/]{4}|[A-Za-z0-9+/]{3}=|[A-Za-z0-9+/]{2}==)$};
25              
26             has value => (
27             is => 'rw',
28             isa => sub { Carp::croak 'MUST be base64-encoded string' unless $_[0] =~ /$BASE64_REGEXP/ },
29             coerce => sub { _parse($_[0]) }
30             );
31              
32             sub _parse {
33              
34 3     3   10 my $bin = shift;
35              
36 3 50       52 return $bin if $bin =~ /$BASE64_REGEXP/;
37 3         90 return encode_base64($bin, '');
38              
39             }
40              
41 162     162 1 59061 sub to_string { shift->value }
42 66     66 1 2072 sub TO_JSON { shift->value }
43              
44              
45             1;
46              
47             =encoding utf-8
48              
49             =head1 NAME
50              
51             STIX::Common::Binary - Binary type
52              
53             =head1 SYNOPSIS
54              
55             use STIX::Common::Binary;
56              
57             my $bin_object = STIX::Common::Binary->new(value => $bin);
58              
59             say $bin_object; # base64-encoded string
60              
61              
62             =head1 DESCRIPTION
63              
64             The binary data type represents a sequence of bytes. In order to allow pattern
65             matching on custom objects, for all properties that use the binary type, the
66             property name MUST end with '_bin'.
67              
68             =head2 PROPERTIES
69              
70             =over
71              
72             =item value
73              
74             =back
75              
76             =head2 HELPERS
77              
78             =over
79              
80             =item $binary->TO_JSON
81              
82             Helper for JSON encoders.
83              
84             =item $binary->to_string
85              
86             Encode the object in JSON.
87              
88             =back
89              
90              
91             =head1 SUPPORT
92              
93             =head2 Bugs / Feature Requests
94              
95             Please report any bugs or feature requests through the issue tracker
96             at L.
97             You will be notified automatically of any progress on your issue.
98              
99             =head2 Source Code
100              
101             This is open source software. The code repository is available for
102             public review and contribution under the terms of the license.
103              
104             L
105              
106             git clone https://github.com/giterlizzi/perl-STIX.git
107              
108              
109             =head1 AUTHOR
110              
111             =over 4
112              
113             =item * Giuseppe Di Terlizzi
114              
115             =back
116              
117              
118             =head1 LICENSE AND COPYRIGHT
119              
120             This software is copyright (c) 2024 by Giuseppe Di Terlizzi.
121              
122             This is free software; you can redistribute it and/or modify it under
123             the same terms as the Perl 5 programming language system itself.
124              
125             =cut