File Coverage

blib/lib/Mango/BSON/ObjectID.pm
Criterion Covered Total %
statement 28 29 96.5
branch 4 4 100.0
condition 4 6 66.6
subroutine 11 13 84.6
pod 5 5 100.0
total 52 57 91.2


line stmt bran cond sub pod time code
1             package Mango::BSON::ObjectID;
2 11     11   37 use Mojo::Base -base;
  11         10  
  11         61  
3 11     11   1522 use overload bool => sub {1}, '""' => sub { shift->to_string }, fallback => 1;
  11     0   13  
  11     0   101  
  0         0  
  8         343  
4              
5 11     11   652 use Carp 'croak';
  11         11  
  11         451  
6 11     11   48 use Mojo::Util 'md5_bytes';
  11         11  
  11         378  
7 11     11   4392 use Sys::Hostname 'hostname';
  11         8885  
  11         3653  
8              
9             # 3 byte machine identifier
10             my $MACHINE = substr md5_bytes(hostname), 0, 3;
11              
12             # Global counter
13             my $COUNTER = int(rand(0xffffff));
14              
15             sub from_epoch {
16 2     2 1 10 my ($self, $epoch) = @_;
17 2         3 $self->{oid} = _generate($epoch);
18 2         5 return $self;
19             }
20              
21             sub new {
22 13     13 1 18 my ($class, $oid) = @_;
23 13 100       36 return $class->SUPER::new unless defined $oid;
24 10 100       485 croak qq{Invalid object id "$oid"} if $oid !~ /^[0-9a-fA-F]{24}\z/;
25 6         32 return $class->SUPER::new(oid => pack('H*', $oid));
26             }
27              
28 14   66 14 1 111 sub to_bytes { shift->{oid} //= _generate() }
29              
30 3     3 1 14 sub to_epoch { unpack 'N', substr(shift->to_bytes, 0, 4) }
31              
32 9     9 1 17 sub to_string { unpack 'H*', shift->to_bytes }
33              
34             sub _generate {
35              
36 3     3   5 $COUNTER = ($COUNTER + 1) % 0xffffff;
37              
38 3   66     28 return pack('N', shift // time) # 4 byte time
39             . $MACHINE # 3 byte machine identifier
40             . pack('n', $$ % 0xffff) # 2 byte process id
41             . substr pack('V', $COUNTER), 0, 3; # 3 byte counter
42             }
43              
44             1;
45              
46             =encoding utf8
47              
48             =head1 NAME
49              
50             Mango::BSON::ObjectID - Object ID type
51              
52             =head1 SYNOPSIS
53              
54             use Mango::BSON::ObjectID;
55              
56             my $oid = Mango::BSON::ObjectID->new('1a2b3c4e5f60718293a4b5c6');
57             say $oid->to_epoch;
58              
59             =head1 DESCRIPTION
60              
61             L is a container for the BSON object id type used by
62             L.
63              
64             =head1 METHODS
65              
66             L inherits all methods from L and
67             implements the following new ones.
68              
69             =head2 from_epoch
70              
71             my $oid = $oid->from_epoch(1359840145);
72              
73             Generate new object id with specific epoch time.
74              
75             =head2 new
76              
77             my $oid = Mango::BSON::ObjectID->new;
78             my $oid = Mango::BSON::ObjectID->new('1a2b3c4e5f60718293a4b5c6');
79              
80             Construct a new L object.
81              
82             =head2 to_bytes
83              
84             my $bytes = $oid->to_bytes;
85              
86             Object id in binary form.
87              
88             =head2 to_epoch
89              
90             my $epoch = $oid->to_epoch;
91              
92             Extract epoch seconds from object id.
93              
94             =head2 to_string
95              
96             my $str = $oid->to_string;
97              
98             Stringify object id.
99              
100             =head1 OPERATORS
101              
102             L overloads the following operators.
103              
104             =head2 bool
105              
106             my $bool = !!$oid;
107              
108             Always true.
109              
110             =head2 stringify
111              
112             my $str = "$oid";
113              
114             Alias for L.
115              
116             =head1 SEE ALSO
117              
118             L, L, L.
119              
120             =cut