Moved UUIDColumns.pm over from main DBIx::Class dist
[dbsrgits/DBIx-Class-UUIDColumns.git] / lib / DBIx / Class / UUIDColumns.pm
1 package DBIx::Class::UUIDColumns;
2
3 use strict;
4 use warnings;
5
6 use base qw/DBIx::Class/;
7
8 __PACKAGE__->mk_classdata( 'uuid_auto_columns' => [] );
9 __PACKAGE__->mk_classdata( 'uuid_maker' );
10 __PACKAGE__->uuid_class( __PACKAGE__->_find_uuid_module );
11
12 # be compatible with Class::DBI::UUID
13 sub uuid_columns {
14     my $self = shift;
15     for (@_) {
16         $self->throw_exception("column $_ doesn't exist") unless $self->has_column($_);
17     }
18     $self->uuid_auto_columns(\@_);
19 }
20
21 sub uuid_class {
22     my ($self, $class) = @_;
23
24     if ($class) {
25         $class = "DBIx::Class::UUIDMaker$class" if $class =~ /^::/;
26
27         if (!eval "require $class") {
28             $self->throw_exception("$class could not be loaded: $@");
29         } elsif (!$class->isa('DBIx::Class::UUIDMaker')) {
30             $self->throw_exception("$class is not a UUIDMaker subclass");
31         } else {
32             $self->uuid_maker($class->new);
33         };
34     };
35
36     return ref $self->uuid_maker;
37 };
38
39 sub insert {
40     my $self = shift;
41     for my $column (@{$self->uuid_auto_columns}) {
42         $self->store_column( $column, $self->get_uuid )
43             unless defined $self->get_column( $column );
44     }
45     $self->next::method(@_);
46 }
47
48 sub get_uuid {
49     return shift->uuid_maker->as_string;
50 }
51
52 sub _find_uuid_module {
53     if (eval{require Data::UUID}) {
54         return '::Data::UUID';
55     } elsif ($^O ne 'openbsd' && eval{require APR::UUID}) {
56         # APR::UUID on openbsd causes some as yet unfound nastiness for XS
57         return '::APR::UUID';
58     } elsif (eval{require UUID}) {
59         return '::UUID';
60     } elsif (eval{
61             # squelch the 'too late for INIT' warning in Win32::API::Type
62             local $^W = 0;
63             require Win32::Guidgen;
64         }) {
65         return '::Win32::Guidgen';
66     } elsif (eval{require Win32API::GUID}) {
67         return '::Win32API::GUID';
68     } else {
69         shift->throw_exception('no suitable uuid module could be found')
70     };
71 };
72
73 1;
74 __END__
75
76 =head1 NAME
77
78 DBIx::Class::UUIDColumns - Implicit uuid columns
79
80 =head1 SYNOPSIS
81
82   package Artist;
83   __PACKAGE__->load_components(qw/UUIDColumns Core DB/);
84   __PACKAGE__->uuid_columns( 'artist_id' );
85
86 =head1 DESCRIPTION
87
88 This L<DBIx::Class> component resembles the behaviour of
89 L<Class::DBI::UUID>, to make some columns implicitly created as uuid.
90
91 When loaded, C<UUIDColumns> will search for a suitable uuid generation module
92 from the following list of supported modules:
93
94   Data::UUID
95   APR::UUID*
96   UUID
97   Win32::Guidgen
98   Win32API::GUID
99
100 If no supporting module can be found, an exception will be thrown.
101
102 *APR::UUID will not be loaded under OpenBSD due to an as yet unidentified XS
103 issue.
104
105 If you would like to use a specific module, you can set C<uuid_class>:
106
107   __PACKAGE__->uuid_class('::Data::UUID');
108   __PACKAGE__->uuid_class('MyUUIDGenerator');
109
110 Note that the component needs to be loaded before Core.
111
112 =head1 METHODS
113
114 =head2 uuid_columns(@columns)
115
116 Takes a list of columns to be filled with uuids during insert.
117
118   __PACKAGE__->uuid_columns('id');
119
120 =head2 uuid_class($classname)
121
122 Takes the name of a UUIDMaker subclass to be used for uuid value generation.
123 This can be a fully qualified class name, or a shortcut name starting with ::
124 that matches one of the available DBIx::Class::UUIDMaker subclasses:
125
126   __PACKAGE__->uuid_class('CustomUUIDGenerator');
127   # loads CustomeUUIDGenerator
128
129   __PACKAGE->uuid_class('::Data::UUID');
130   # loads DBIx::Class::UUIDMaker::Data::UUID;
131
132 Note that C<uuid_class> chacks to see that the specified class isa
133 DBIx::Class::UUIDMaker subbclass and throws and exception if it isn't.
134
135 =head2 uuid_maker
136
137 Returns the current UUIDMaker instance for the given module.
138
139   my $uuid = __PACKAGE__->uuid_maker->as_string;
140
141 =head1 SEE ALSO
142
143 L<DBIx::Class::UUIDMaker>
144
145 =head1 AUTHORS
146
147 Chia-liang Kao <clkao@clkao.org>
148 Chris Laco <claco@chrislaco.com>
149
150 =head1 LICENSE
151
152 You may distribute this code under the same terms as Perl itself.