root/lang/perl/UUID-Generator-PurePerl/trunk/lib/UUID/Generator/PurePerl.pm @ 32529

Revision 32529, 6.9 kB (checked in by dayflower, 5 years ago)

changed the way to inherit Exporter's import() method (prior to Exporter 5.57)

Line 
1package UUID::Generator::PurePerl;
2
3use strict;
4use warnings;
5use 5.006;
6
7our $VERSION = '0.04_01';
8
9use Carp;
10use Digest;
11use Time::HiRes;
12use UUID::Object;
13use UUID::Generator::PurePerl::RNG;
14use UUID::Generator::PurePerl::NodeID;
15use UUID::Generator::PurePerl::Util;
16
17sub new {
18    my $class = shift;
19    my $self  = bless {}, $class;
20
21    return $self;
22}
23
24sub rng {
25    my ($self) = @_;
26
27    if (! defined $self->{rng}) {
28        $self->{rng} = UUID::Generator::PurePerl::RNG->singleton();
29    }
30
31    return $self->{rng};
32}
33
34sub node_getter {
35    my ($self) = @_;
36
37    if (! defined $self->{node_getter}) {
38        $self->{node_getter} = UUID::Generator::PurePerl::NodeID->singleton();
39    }
40
41    return $self->{node_getter};
42}
43
44sub get_timestamp {
45    return Time::HiRes::time();
46}
47
48sub get_clk_seq {
49    my $self = shift;
50    my $node_id = shift;
51
52    my $inc_seq = 0;
53
54    my $ts = $self->get_timestamp();
55    if (! defined $self->{last_ts} || $ts <= $self->{last_ts}) {
56        $inc_seq ++;
57    }
58    $self->{last_ts} = $ts;
59
60    if (! defined $self->{last_node}) {
61        if (defined $node_id) {
62            $inc_seq ++;
63        }
64    }
65    else {
66        if (! defined $node_id || $node_id ne $self->{last_node}) {
67            $inc_seq ++;
68        }
69    }
70    $self->{last_node} = $node_id;
71
72    if (! defined $self->{clk_seq}) {
73        $self->{clk_seq} = $self->_generate_clk_seq();
74        return $self->{clk_seq} & 0x03ff;
75    }
76
77    if ($inc_seq) {
78        $self->{clk_seq} = ($self->{clk_seq} + 1) % 65536;
79    }
80
81    return $self->{clk_seq} & 0x03ff;
82}
83
84sub _generate_clk_seq {
85    my $self = shift;
86
87    my @data;
88    push @data, q{}  . $$;
89    push @data, q{:} . Time::HiRes::time();
90
91    return digest_as_16bit(@data);
92}
93
94sub generate_v1 {
95    my $self = shift;
96
97    my $node = $self->node_getter->node_id();
98    my $ts   = $self->get_timestamp();
99
100    return
101        UUID::Object->create_from_hash({
102            variant => 2,
103            version => 1,
104            node    => $node,
105            time    => $ts,
106            clk_seq => $self->get_clk_seq($node),
107        });
108}
109
110sub generate_v1mc {
111    my $self = shift;
112
113    my $node = $self->node_getter->random_node_id();
114    my $ts   = $self->get_timestamp();
115
116    return
117        UUID::Object->create_from_hash({
118            variant => 2,
119            version => 1,
120            node    => $node,
121            time    => $ts,
122            clk_seq => $self->get_clk_seq(undef),
123        });
124}
125
126sub generate_v4 {
127    my ($self) = @_;
128
129    my $b = q{};
130    for (1 .. 4) {
131        $b .= pack 'I', $self->rng->rand_32bit;
132    }
133
134    my $u = UUID::Object->create_from_binary($b);
135
136    $u->variant(2);
137    $u->version(4);
138
139    return $u;
140}
141
142sub generate_v3 {
143    my ($self, $ns, $data) = @_;
144
145    return $self->_generate_digest(3, 'MD5', $ns, $data);
146}
147
148sub generate_v5 {
149    my ($self, $ns, $data) = @_;
150
151    return $self->_generate_digest(5, 'SHA-1', $ns, $data);
152}
153
154sub _generate_digest {
155    my ($self, $version, $digest, $ns, $data) = @_;
156
157    $ns = UUID::Object->new($ns)->as_binary;
158
159    my $dg = Digest->new($digest);
160
161    $dg->reset();
162
163    $dg->add($ns);
164
165    $dg->add($data);
166
167    my $u = UUID::Object->create_from_binary($dg->digest);
168    $u->variant(2);
169    $u->version($version);
170
171    return $u;
172}
173
1741;
175__END__
176
177=encoding utf-8
178
179=for stopwords
180
181=head1 NAME
182
183UUID::Generator::PurePerl - Universally Unique IDentifier (UUID) Generator
184
185=head1 SYNOPSIS
186
187  use UUID::Generator::PurePerl;
188 
189  $ug = UUID::Generator::PurePerl->new();
190 
191  $uuid1 = $ug->generate_v1();
192  print $uuid1->as_string();          #=>
193
194=head1 DESCRIPTION
195
196UUID::Generator::PurePerl is UUID
197(Universally Unique IDentifier; described in RFC 4122) generator class.
198
199=head1 METHODS
200
201Following methods generate a UUID as an instance of L<UUID::Object>.
202For information about retrieving some representation
203(such as string, Base64 string, etc) from generated UUID,
204please refer to <UUID::Object> document.
205
206=head2 $uuidgen->generate_v1()
207
208This method generates a version 1 UUID.
209
210Version 1 UUID is constructed from machine dependent information
211(such as MAC address bound with network interface)
212and high resolution time-stamp,
213so in most cases generated UUIDs are guaranteed to be unique over world.
214
215But for the same reason, this sort of UUIDs are not suitable for
216security-aware software.
217
218=head2 $uuidgen->generate_v1mc()
219
220This method generates a version 1 UUID,
221where node address is multicast MAC address created randomly.
222
223=head2 $uuidgen->generate_v3($namespace, $name)
224
225This method generates a version 3 UUID.
226
227Version 3 UUID is for unique id of any names belonging to
228some sort of namespace.
229Generator calculates digest of that namespace and that name,
230and uses it as source of UUID.
231
232In version 3, MD5 mechanism is used as digest function.
233
234Module for calculating MD5 digest
235(such as Digest::MD5)
236is required to use this method,
237but in modern version perl, those modules are included as core module.
238
239=head2 $uuidgen->generate_v4()
240
241This method generates a version 4 UUID.
242
243Version 4 UUID is constructed from random numbers.
244UUIDs have variant and version field with fixed values,
245so not whole entity (128-bit) is scattered randomly,
246only 122 bits are from random numbers.
247
248=head2 $uuidgen->generate_v5($namespace, $name)
249
250This method generates a version 5 UUID.
251
252Algorithm for creating version 5 UUID is quite similar to one of version 3.
253The difference is, SHA-1 is used for digest of name on version 5 UUID,
254whereas MD5 is used on version 3.
255
256Module for calculating SHA-1 digest
257(such as Digest::SHA)
258is required to use this method.
259
260=head1 CONSTANTS
261
262Namespace UUIDs are not defined in this package.
263Use L<UUID::Object> instead.
264
265=head1 NOTICE
266
267In RFC 4122, a principle for creating a time-based UUID (version1 UUID)
268is described as follows.
269
270=over 2
271
272=item Obtain a system-wide global lock
273
274=item From a system-wide shared stable store, read the UUID generator state (such as time-stamp, clock sequence, and node ID).
275
276=item Retrieve current time-stamp and node ID
277
278=item Generate a UUID
279
280=item Save the state back to the stable storage.
281
282=item Release the global lock
283
284=back
285
286But in this package, system-wide global locking and persistent storage are
287not used.
288This class only acts on a small world around a process,
289so same UUIDs will be generated on some conditions over processes, over time.
290This nature of uniqueness might not be suitable for your application.
291
292In addition, node ID is a not real physical hardware address in current implementation.
293In return, pseudo node ID is calculated from system information.
294I have a plan to make real node ID retrieval functionality,
295but not yet.
296
297=head1 AUTHOR
298
299ITO Nobuaki E<lt>banb@cpan.orgE<gt>
300
301=head1 LICENSE
302
303This library is free software; you can redistribute it and/or modify
304it under the same terms as Perl itself.
305
306=head1 SEE ALSO
307
308L<UUID::Object>, L<UUID::Generator::PurePerl::Compat>.
309
310RFC 4122: "A Universally Unique IDentifier (UUID) URN Namespace", 2005, L<http://www.ietf.org/rfc/rfc4122.txt>.
311
312=cut
Note: See TracBrowser for help on using the browser.