File Coverage

blib/lib/SBOM/CycloneDX/Attachment.pm
Criterion Covered Total %
statement 37 44 84.0
branch 4 16 25.0
condition 1 9 11.1
subroutine 11 11 100.0
pod 1 1 100.0
total 54 81 66.6


line stmt bran cond sub pod time code
1             package SBOM::CycloneDX::Attachment;
2              
3 2     2   3527 use 5.010001;
  2         9  
4 2     2   26 use strict;
  2         4  
  2         52  
5 2     2   8 use warnings;
  2         3  
  2         108  
6 2     2   10 use utf8;
  2         2  
  2         13  
7              
8 2     2   60 use Carp;
  2         6  
  2         171  
9 2     2   12 use Types::Standard qw(Str FileHandle Enum);
  2         3  
  2         21  
10 2     2   6068 use MIME::Base64 qw(encode_base64);
  2         5  
  2         213  
11 2     2   16 use SBOM::CycloneDX::Util qw(file_read);
  2         6  
  2         117  
12              
13 2     2   13 use Moo;
  2         4  
  2         17  
14 2     2   1134 use namespace::autoclean;
  2         5  
  2         27  
15              
16             extends 'SBOM::CycloneDX::Base';
17              
18             my $BASE64_REGEXP = qr{^([A-Za-z0-9+/]{4})*([A-Za-z0-9+/]{4}|[A-Za-z0-9+/]{3}=|[A-Za-z0-9+/]{2}==)$};
19              
20             has file => (is => 'rw', isa => FileHandle | Str);
21             has content_type => (is => 'rw', isa => Str);
22             has encoding => (is => 'rw', isa => Enum [qw(base64)]);
23             has content => (is => 'rw', required => 1);
24              
25             sub TO_JSON {
26              
27 100     100 1 270 my $self = shift;
28              
29             # TODO use trigger
30             # TODO guess mime/type from content
31              
32 100 50 33     2001 Carp::croak '"file" and "content" cannot be used at the same time.' if ($self->file && $self->content);
33              
34 100         875 my $content = $self->content;
35              
36 100 50       1720 if ($self->encoding) {
37              
38 0         0 my $b64_content = undef;
39              
40 0 0 0     0 if ($self->file && !$content) {
41 0         0 $b64_content = encode_base64(file_read($self->file), '');
42             }
43              
44 0 0 0     0 if (!$self->file && $content) {
45 0 0       0 $b64_content = ($content =~ /$BASE64_REGEXP/) ? $content : encode_base64($content, '');
46             }
47              
48 0 0       0 Carp::croak 'Empty content' unless $b64_content;
49              
50 0         0 $content = $b64_content;
51              
52             }
53              
54 100         784 my $json = {content => $content};
55              
56 100 50       1704 $json->{contentType} = $self->content_type if $self->content_type;
57 100 50       1998 $json->{encoding} = $self->encoding if $self->encoding;
58              
59 100         2010 return $json;
60              
61             }
62              
63             1;
64              
65             =encoding utf-8
66              
67             =head1 NAME
68              
69             SBOM::CycloneDX::Attachment - Attachment utility
70              
71             =head1 SYNOPSIS
72              
73             use SBOM::CycloneDX::Attachment;
74              
75             # Base64 content
76              
77             $attachment = SBOM::CycloneDX::Attachment->new(
78             content => 'Y29uc29sZS5sb2coJ0dvb2RCeWUnKQ==',
79             content_type => 'text/javascript'
80             );
81              
82             # Plain content
83              
84             $attachment = SBOM::CycloneDX::Attachment->new(
85             content => 'Copyright (C) Acme - All Rights Reserved',
86             content_type => 'text/plain'
87             );
88              
89             # File handler
90              
91             open(my $fh, "<", "/path/LICENSE.md");
92              
93             $attachment = SBOM::CycloneDX::Attachment->new(
94             file => $fh
95             );
96              
97             # File path
98              
99             $attachment = SBOM::CycloneDX::Attachment->new(
100             file => $fh
101             );
102              
103              
104             =head1 DESCRIPTION
105              
106             L is a attachment utility.
107              
108              
109             =head2 METHODS
110              
111             L inherits all methods from L
112             and implements the following new ones.
113              
114             =over
115              
116             =item SBOM::CycloneDX::Attachment->new( %PARAMS )
117              
118             Create a new attachment object.
119              
120             Parameters:
121              
122             =over
123              
124             =item * C, File handle or file path
125              
126             =item * C, Plain content (text or BASE64 encoded)
127              
128             =item * C, content MIME/Type
129              
130             =back
131              
132             B: C and C cannot be used at the same time.
133              
134             # Base64 content
135              
136             $attachment = SBOM::CycloneDX::Attachment->new(
137             content => 'Y29uc29sZS5sb2coJ0dvb2RCeWUnKQ==',
138             content_type => 'text/javascript'
139             );
140              
141             # Plain content
142              
143             $attachment = SBOM::CycloneDX::Attachment->new(
144             content => 'Copyright (C) Acme - All Rights Reserved',
145             content_type => 'text/plain'
146             );
147              
148             # File handler
149              
150             open(my $fh, "<", "/path/LICENSE.md");
151              
152             $attachment = SBOM::CycloneDX::Attachment->new(
153             file => $fh
154             );
155              
156             # File path
157              
158             $attachment = SBOM::CycloneDX::Attachment->new(
159             file => '/path/LICENSE.md'
160             );
161              
162             =item $attachment->file
163              
164             File handle or file path
165              
166             =item $attachment->content_type
167              
168             Specifies the format and nature of the data being attached, helping systems
169             correctly interpret and process the content.
170              
171             =item $attachment->content
172              
173             Specifies the encoding the text is represented in.
174              
175             =item $c->TO_JSON
176              
177             Convert the attachment in JSON.
178              
179             say encode_json($attachment);
180              
181             # {
182             # "content": "Y29uc29sZS5sb2coJ0dvb2RCeWUnKQ==",
183             # "contentType": "text/javascript",
184             # "encoding": "base64"
185             # }
186              
187              
188             =back
189              
190              
191             =head1 SUPPORT
192              
193             =head2 Bugs / Feature Requests
194              
195             Please report any bugs or feature requests through the issue tracker
196             at L.
197             You will be notified automatically of any progress on your issue.
198              
199             =head2 Source Code
200              
201             This is open source software. The code repository is available for
202             public review and contribution under the terms of the license.
203              
204             L
205              
206             git clone https://github.com/giterlizzi/perl-SBOM-CycloneDX.git
207              
208              
209             =head1 AUTHOR
210              
211             =over 4
212              
213             =item * Giuseppe Di Terlizzi
214              
215             =back
216              
217              
218             =head1 LICENSE AND COPYRIGHT
219              
220             This software is copyright (c) 2025-2026 by Giuseppe Di Terlizzi.
221              
222             This is free software; you can redistribute it and/or modify it under
223             the same terms as the Perl 5 programming language system itself.
224              
225             =cut