line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Object::ID; |
2
|
|
|
|
|
|
|
|
3
|
7
|
|
|
7
|
|
389888
|
use 5.008_008; |
|
7
|
|
|
|
|
30
|
|
|
7
|
|
|
|
|
956
|
|
4
|
|
|
|
|
|
|
|
5
|
7
|
|
|
7
|
|
57
|
use strict; |
|
7
|
|
|
|
|
14
|
|
|
7
|
|
|
|
|
347
|
|
6
|
7
|
|
|
7
|
|
85
|
use warnings; |
|
7
|
|
|
|
|
29
|
|
|
7
|
|
|
|
|
235
|
|
7
|
|
|
|
|
|
|
|
8
|
7
|
|
|
7
|
|
11991
|
use version; our $VERSION = qv("v0.1.2"); |
|
7
|
|
|
|
|
14905
|
|
|
7
|
|
|
|
|
51
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
# Over 2x faster than Hash::Util::FieldHash |
11
|
7
|
|
|
7
|
|
11012
|
use Hash::FieldHash qw(fieldhashes); |
|
7
|
|
|
|
|
17177
|
|
|
7
|
|
|
|
|
714
|
|
12
|
7
|
|
|
7
|
|
7860
|
use Sub::Name qw(subname); |
|
7
|
|
|
|
|
8307
|
|
|
7
|
|
|
|
|
1068
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
# Even though we're not using Exporter, be polite for introspection purposes |
15
|
|
|
|
|
|
|
our @EXPORT = qw(object_id object_uuid); |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub import { |
18
|
8
|
|
|
8
|
|
61
|
my $caller = caller; |
19
|
|
|
|
|
|
|
|
20
|
8
|
|
|
|
|
31
|
for my $method (qw) { |
21
|
16
|
|
|
|
|
42
|
my $name = "$caller\::$method"; |
22
|
7
|
|
|
7
|
|
99
|
no strict 'refs'; |
|
7
|
|
|
|
|
20
|
|
|
7
|
|
|
|
|
2551
|
|
23
|
|
|
|
|
|
|
# In a client class using namespace::autoclean, the exported methods |
24
|
|
|
|
|
|
|
# are indistinguishable from exported functions, and therefore get |
25
|
|
|
|
|
|
|
# autocleaned out of existence. So use subname() to rename them as |
26
|
|
|
|
|
|
|
# things that namespace::autoclean will interpret as methods. |
27
|
16
|
|
|
|
|
12241
|
*$name = subname($name, \&$method); |
28
|
|
|
|
|
|
|
} |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
# All glory to Vincent Pit for coming up with this implementation |
33
|
|
|
|
|
|
|
{ |
34
|
|
|
|
|
|
|
fieldhashes \my(%IDs, %UUIDs); |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
my $Last_ID = "a"; |
37
|
|
|
|
|
|
|
sub object_id { |
38
|
26
|
|
|
26
|
|
13772
|
my $self = shift; |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
# This is 15% faster than ||= |
41
|
26
|
100
|
|
|
|
149
|
return $IDs{$self} if exists $IDs{$self}; |
42
|
13
|
|
|
|
|
131
|
return $IDs{$self} = ++$Last_ID; |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
if ( eval { require Data::UUID } ) { |
46
|
|
|
|
|
|
|
my $UG; |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
*object_uuid = sub { |
49
|
|
|
|
|
|
|
my $self = shift; |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
# Because the mere presense of a Data::UUID object will |
52
|
|
|
|
|
|
|
# cause problems with threads, don't initialize it until |
53
|
|
|
|
|
|
|
# absolutely necessary. |
54
|
|
|
|
|
|
|
$UG ||= Data::UUID->new; |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
return $UUIDs{$self} if exists $UUIDs{$self}; |
57
|
|
|
|
|
|
|
return $UUIDs{$self} = $UG->create_str; |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
else { |
61
|
|
|
|
|
|
|
*object_uuid = sub { |
62
|
0
|
|
|
0
|
|
|
require Carp; |
63
|
0
|
|
|
|
|
|
Carp::croak("object_uuid() requires Data::UUID"); |
64
|
|
|
|
|
|
|
}; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=head1 NAME |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
Object::ID - A unique identifier for any object |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=head1 SYNOPSIS |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
package My::Object; |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
# Imports the object_id method |
78
|
|
|
|
|
|
|
use Object::ID; |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=head1 DESCRIPTION |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
This is a unique identifier for any object, regardless of its type, |
84
|
|
|
|
|
|
|
structure or contents. Its features are: |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
* Works on ANY object of any type |
87
|
|
|
|
|
|
|
* Does not modify the object in any way |
88
|
|
|
|
|
|
|
* Does not change with the object's contents |
89
|
|
|
|
|
|
|
* Is O(1) to calculate (ie. doesn't matter how big the object is) |
90
|
|
|
|
|
|
|
* The id is unique for the life of the process |
91
|
|
|
|
|
|
|
* The id is always a true value |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
=head1 USAGE |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
Object::ID is a role, rather than inheriting its methods they are |
97
|
|
|
|
|
|
|
imported into your class. To make your class use Object::ID, simply |
98
|
|
|
|
|
|
|
C<< use Object::ID >> in your class. |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
package My::Class; |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
use Object::ID; |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
Then write your class however you want. |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=head1 METHODS |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
The following methods are made available to your class. |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
=head2 object_id |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
my $id = $object->object_id; |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
Returns an identifier unique to the C<$object>. |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
The identifier is not related to the content of the object. It is |
118
|
|
|
|
|
|
|
only unique for the life of the process. There is no guarantee as to |
119
|
|
|
|
|
|
|
the format of the identifier from version to version. |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
For example: |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
my $obj = My::Class->new; |
124
|
|
|
|
|
|
|
my $copy = $obj; |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
# This is true, $obj and $copy refer to the same object |
127
|
|
|
|
|
|
|
$obj->object_id eq $copy->object_id; |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
my $obj2 = My::Class->new; |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
# This is false, $obj and $obj2 are different objects. |
132
|
|
|
|
|
|
|
$obj->object_id eq $obj2->object_id; |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
use Clone; |
135
|
|
|
|
|
|
|
my $clone = clone($obj); |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
# This is false, even though they contain the same data. |
138
|
|
|
|
|
|
|
$obj->object_id eq $clone->object_id; |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
=head2 object_uuid |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
my $uuid = $object->object_uuid |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
Like C<< $object->object_id >> but returns a UUID unique to the $object. |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
Only works if Data::UUID is installed. |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
See L for more details about UUID. |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
=head1 FAQ |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
=head2 Why not just use the object's reference? |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
References are not unique over the life of a process. Perl will reuse |
156
|
|
|
|
|
|
|
references of destroyed objects, as demonstrated by this code snippet: |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
{ |
159
|
|
|
|
|
|
|
package Foo; |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
sub new { |
162
|
|
|
|
|
|
|
my $class = shift; |
163
|
|
|
|
|
|
|
my $string = shift; |
164
|
|
|
|
|
|
|
return bless {}, $class; |
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
for(1..3) { |
169
|
|
|
|
|
|
|
my $obj = Foo->new; |
170
|
|
|
|
|
|
|
print "Object's reference is $obj\n"; |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
This will print, for example, C<< Object's reference is |
174
|
|
|
|
|
|
|
Foo=HASH(0x803704) >> three times. |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
=head2 How much memory does it use? |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
Very little. |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
Object::ID stores the ID and address of each object you've asked the |
182
|
|
|
|
|
|
|
ID of. Once the object has been destroyed it no longer stores it. In |
183
|
|
|
|
|
|
|
other words, you only pay for what you use. When you're done with it, |
184
|
|
|
|
|
|
|
you don't pay for it any more. |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
=head1 LICENSE |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
Copyright 2010, Michael G Schwern . |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or |
192
|
|
|
|
|
|
|
modify it under the same terms as Perl itself. |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
See L |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
=head1 THANKS |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
Thank you to Vincent Pit for coming up with the implementation. |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
=cut |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
1; |