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