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