| 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; |