File Coverage

blib/lib/SBOM/CycloneDX/Timestamp.pm
Criterion Covered Total %
statement 23 37 62.1
branch 0 12 0.0
condition n/a
subroutine 8 11 72.7
pod 2 2 100.0
total 33 62 53.2


line stmt bran cond sub pod time code
1             package SBOM::CycloneDX::Timestamp;
2              
3 16     16   305 use 5.010001;
  16         63  
4 16     16   103 use strict;
  16         34  
  16         529  
5 16     16   80 use warnings;
  16         33  
  16         846  
6 16     16   118 use utf8;
  16         31  
  16         145  
7              
8 16     16   704 use Carp;
  16         30  
  16         1171  
9 16     16   1896 use Time::Piece;
  16         38493  
  16         168  
10              
11 16     16   2015 use overload '""' => \&to_string, fallback => 1;
  16         41  
  16         251  
12              
13 16     16   1613 use Moo;
  16         36  
  16         118  
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             has value => (is => 'rw', default => sub { Time::Piece->new }, coerce => sub { _parse($_[0]) });
25              
26             my @PATTERNS = (
27             ['%Y-%m-%dT%H:%M:%S', qr/(\d{4}-\d{2}-\d{2}[T]\d{2}:\d{2}:\d{2})\.\d+Z/],
28             ['%Y-%m-%dT%H:%M:%S', qr/(\d{4}-\d{2}-\d{2}[T]\d{2}:\d{2}:\d{2})/],
29             ['%Y-%m-%d %H:%M:%S', qr/(\d{4}-\d{2}-\d{2}\s\d{2}:\d{2}:\d{2})/],
30             ['%Y-%m-%d', qr/(\d{4}-\d{2}-\d{2})/],
31             );
32              
33             sub _parse {
34              
35 0     0     my $datetime = shift;
36              
37 0 0         return $datetime if (ref $datetime eq 'Time::Piece');
38              
39 0 0         return $datetime->value if ($datetime->isa('SBOM::CycloneDX::Timestamp'));
40              
41 0 0         return Time::Piece->new unless $datetime;
42              
43 0 0         return Time::Piece->new($datetime) if ($datetime =~ /^([0-9]+)$/);
44 0 0         return Time::Piece->new if ($datetime eq 'now');
45              
46 0           foreach my $pattern (@PATTERNS) {
47 0           my ($format, $regexp) = @{$pattern};
  0            
48 0 0         return Time::Piece->strptime($1, $format) if ($datetime =~ /$regexp/);
49             }
50              
51 0           Carp::carp 'Malformed timestamp';
52              
53 0           return Time::Piece->new;
54              
55             }
56              
57 0     0 1   sub to_string { shift->TO_JSON }
58              
59 0     0 1   sub TO_JSON { shift->value->datetime . '.000Z' }
60              
61             1;
62              
63             =encoding utf-8
64              
65             =head1 NAME
66              
67             SBOM::CycloneDX::Timestamp - Timestamp representation for CycloneDX
68              
69             =head1 SYNOPSIS
70              
71             SBOM::CycloneDX::Timestamp->new('2025-01-01');
72              
73             SBOM::CycloneDX::Timestamp->new('2025-01-01 00:00:00');
74              
75             SBOM::CycloneDX::Timestamp->new('2025-01-01T00:00:00');
76              
77             SBOM::CycloneDX::Timestamp->new(Time::Piece->new);
78              
79              
80             =head1 DESCRIPTION
81              
82             L provides represents the timestamp for L.
83              
84             =head2 METHODS
85              
86             =over
87              
88             =item SBOM::CycloneDX::Timestamp->new( %PARAMS )
89              
90             =item $ts->value
91              
92             Return L object.
93              
94             =item $ts->to_string
95              
96             =item $ts->TO_JSON
97              
98             Return timestamp in JSON format.
99              
100             =back
101              
102             =head1 SUPPORT
103              
104             =head2 Bugs / Feature Requests
105              
106             Please report any bugs or feature requests through the issue tracker
107             at L.
108             You will be notified automatically of any progress on your issue.
109              
110             =head2 Source Code
111              
112             This is open source software. The code repository is available for
113             public review and contribution under the terms of the license.
114              
115             L
116              
117             git clone https://github.com/giterlizzi/perl-SBOM-CycloneDX.git
118              
119              
120             =head1 AUTHOR
121              
122             =over 4
123              
124             =item * Giuseppe Di Terlizzi
125              
126             =back
127              
128              
129             =head1 LICENSE AND COPYRIGHT
130              
131             This software is copyright (c) 2025-2026 by Giuseppe Di Terlizzi.
132              
133             This is free software; you can redistribute it and/or modify it under
134             the same terms as the Perl 5 programming language system itself.
135              
136             =cut