Commit | Line | Data |
7da9cd47 |
1 | package DBIx::Class::UUIDColumns; |
1edd1722 |
2 | use base qw/DBIx::Class/; |
7da9cd47 |
3 | |
7da9cd47 |
4 | __PACKAGE__->mk_classdata( 'uuid_auto_columns' => [] ); |
947acfd9 |
5 | __PACKAGE__->mk_classdata( 'uuid_maker' ); |
6 | __PACKAGE__->uuid_class( __PACKAGE__->_find_uuid_module ); |
7da9cd47 |
7 | |
7da9cd47 |
8 | # be compatible with Class::DBI::UUID |
9 | sub uuid_columns { |
10 | my $self = shift; |
11 | for (@_) { |
701da8c4 |
12 | $self->throw_exception("column $_ doesn't exist") unless $self->has_column($_); |
7da9cd47 |
13 | } |
14 | $self->uuid_auto_columns(\@_); |
15 | } |
16 | |
947acfd9 |
17 | sub uuid_class { |
18 | my ($self, $class) = @_; |
19 | |
20 | if ($class) { |
21 | $class = "DBIx::Class::UUIDMaker$class" if $class =~ /^::/; |
22 | |
23 | if (!eval "require $class") { |
24 | $self->throw_exception("$class could not be loaded: $@"); |
25 | } elsif (!$class->isa('DBIx::Class::UUIDMaker')) { |
26 | $self->throw_exception("$class is not a UUIDMaker subclass"); |
27 | } else { |
28 | $self->uuid_maker($class->new); |
29 | }; |
30 | }; |
31 | |
32 | return ref $self->uuid_maker; |
33 | }; |
34 | |
7da9cd47 |
35 | sub insert { |
3b7992e1 |
36 | my $self = shift; |
7da9cd47 |
37 | for my $column (@{$self->uuid_auto_columns}) { |
103647d5 |
38 | $self->store_column( $column, $self->get_uuid ) |
39 | unless defined $self->get_column( $column ); |
7da9cd47 |
40 | } |
3b7992e1 |
41 | $self->next::method(@_); |
7da9cd47 |
42 | } |
43 | |
44 | sub get_uuid { |
947acfd9 |
45 | return shift->uuid_maker->as_string; |
7da9cd47 |
46 | } |
47 | |
947acfd9 |
48 | sub _find_uuid_module { |
e78f023a |
49 | if (eval{require Data::UUID}) { |
50 | return '::Data::UUID'; |
51 | } elsif ($^O ne 'openbsd' && eval{require APR::UUID}) { |
947acfd9 |
52 | # APR::UUID on openbsd causes some as yet unfound nastyness for XS |
53 | return '::APR::UUID'; |
54 | } elsif (eval{require UUID}) { |
55 | return '::UUID'; |
947acfd9 |
56 | } elsif (eval{ |
57 | # squelch the 'too late for INIT' warning in Win32::API::Type |
58 | local $^W = 0; |
59 | require Win32::Guidgen; |
60 | }) { |
61 | return '::Win32::Guidgen'; |
62 | } elsif (eval{require Win32API::GUID}) { |
63 | return '::Win32API::GUID'; |
64 | } else { |
65 | shift->throw_exception('no suitable uuid module could be found') |
66 | }; |
67 | }; |
68 | |
e78f023a |
69 | 1; |
70 | __END__ |
71 | |
72 | =head1 NAME |
73 | |
74 | DBIx::Class::UUIDColumns - Implicit uuid columns |
75 | |
76 | =head1 SYNOPSIS |
77 | |
78 | package Artist; |
79 | __PACKAGE__->load_components(qw/UUIDColumns Core DB/); |
80 | __PACKAGE__->uuid_columns( 'artist_id' ); |
81 | |
82 | =head1 DESCRIPTION |
83 | |
84 | This L<DBIx::Class> component resembles the behaviour of |
85 | L<Class::DBI::UUID>, to make some columns implicitly created as uuid. |
86 | |
87 | When loaded, C<UUIDColumns> will search for a suitable uuid generation module |
88 | from the following list of supported modules: |
89 | |
90 | Data::UUID |
91 | APR::UUID* |
92 | UUID |
93 | Win32::Guidgen |
94 | Win32API::GUID |
95 | |
96 | If no supporting module can be found, an exception will be thrown. |
97 | |
98 | *APR::UUID will not be loaded under OpenBSD due to an as yet unidentified XS |
99 | issue. |
100 | |
101 | If you would like to use a specific module, you can set C<uuid_class>: |
102 | |
103 | __PACKAGE__->uuid_class('::Data::UUID'); |
104 | __PACKAGE__->uuid_class('MyUUIDGenerator'); |
105 | |
106 | Note that the component needs to be loaded before Core. |
107 | |
108 | =head1 METHODS |
109 | |
110 | =head2 uuid_columns(@columns) |
111 | |
112 | Takes a list of columns to be filled with uuids during insert. |
113 | |
114 | __PACKAGE__->uuid_columns('id'); |
115 | |
c17c525c |
116 | sub uuid_class { |
117 | my ($self, $class) = @_; |
e78f023a |
118 | |
c17c525c |
119 | if ($class) { |
120 | $class = "DBIx::Class::UUIDMaker$class" if $class =~ /^::/; |
e78f023a |
121 | |
c17c525c |
122 | if (!eval "require $class") { |
123 | $self->throw_exception("$class could not be loaded: $@"); |
124 | } elsif (!$class->isa('DBIx::Class::UUIDMaker')) { |
125 | $self->throw_exception("$class is not a UUIDMaker subclass"); |
126 | } else { |
947acfd9 |
127 | $self->uuid_maker($class->new); |
128 | }; |
129 | }; |
130 | |
131 | return ref $self->uuid_maker; |
132 | }; |
133 | |
7da9cd47 |
134 | sub insert { |
3b7992e1 |
135 | my $self = shift; |
7da9cd47 |
136 | for my $column (@{$self->uuid_auto_columns}) { |
103647d5 |
137 | $self->store_column( $column, $self->get_uuid ) |
138 | unless defined $self->get_column( $column ); |
7da9cd47 |
139 | } |
3b7992e1 |
140 | $self->next::method(@_); |
7da9cd47 |
141 | } |
142 | |
143 | sub get_uuid { |
947acfd9 |
144 | return shift->uuid_maker->as_string; |
7da9cd47 |
145 | } |
146 | |
947acfd9 |
147 | sub _find_uuid_module { |
e78f023a |
148 | if (eval{require Data::UUID}) { |
149 | return '::Data::UUID'; |
150 | } elsif ($^O ne 'openbsd' && eval{require APR::UUID}) { |
947acfd9 |
151 | # APR::UUID on openbsd causes some as yet unfound nastyness for XS |
152 | return '::APR::UUID'; |
153 | } elsif (eval{require UUID}) { |
154 | return '::UUID'; |
947acfd9 |
155 | } elsif (eval{ |
156 | # squelch the 'too late for INIT' warning in Win32::API::Type |
157 | local $^W = 0; |
158 | require Win32::Guidgen; |
159 | }) { |
160 | return '::Win32::Guidgen'; |
161 | } elsif (eval{require Win32API::GUID}) { |
162 | return '::Win32API::GUID'; |
163 | } else { |
164 | shift->throw_exception('no suitable uuid module could be found') |
165 | }; |
166 | }; |
167 | |
e78f023a |
168 | 1; |
169 | __END__ |
170 | |
171 | =head1 NAME |
172 | |
173 | DBIx::Class::UUIDColumns - Implicit uuid columns |
174 | |
175 | =head1 SYNOPSIS |
176 | |
177 | package Artist; |
178 | __PACKAGE__->load_components(qw/UUIDColumns Core DB/); |
179 | __PACKAGE__->uuid_columns( 'artist_id' ); |
180 | |
181 | =head1 DESCRIPTION |
182 | |
183 | This L<DBIx::Class> component resembles the behaviour of |
184 | L<Class::DBI::UUID>, to make some columns implicitly created as uuid. |
185 | |
186 | When loaded, C<UUIDColumns> will search for a suitable uuid generation module |
187 | from the following list of supported modules: |
188 | |
189 | Data::UUID |
190 | APR::UUID* |
191 | UUID |
192 | Win32::Guidgen |
193 | Win32API::GUID |
194 | |
195 | If no supporting module can be found, an exception will be thrown. |
196 | |
197 | *APR::UUID will not be loaded under OpenBSD due to an as yet unidentified XS |
198 | issue. |
199 | |
200 | If you would like to use a specific module, you can set C<uuid_class>: |
201 | |
202 | __PACKAGE__->uuid_class('::Data::UUID'); |
203 | __PACKAGE__->uuid_class('MyUUIDGenerator'); |
204 | |
205 | Note that the component needs to be loaded before Core. |
206 | |
207 | =head1 METHODS |
208 | |
209 | =head2 uuid_columns(@columns) |
210 | |
211 | Takes a list of columns to be filled with uuids during insert. |
212 | |
213 | __PACKAGE__->uuid_columns('id'); |
214 | |
215 | =head2 uuid_class($classname) |
216 | |
217 | Takes the name of a UUIDMaker subclass to be used for uuid value generation. |
218 | This can be a fully qualified class name, or a shortcut name starting with :: |
219 | that matches one of the available DBIx::Class::UUIDMaker subclasses: |
220 | |
221 | __PACKAGE__->uuid_class('CustomUUIDGenerator'); |
222 | # loads CustomeUUIDGenerator |
223 | |
224 | __PACKAGE->uuid_class('::Data::UUID'); |
225 | # loads DBIx::Class::UUIDMaker::Data::UUID; |
226 | |
227 | Note that C<uuid_class> chacks to see that the specified class isa |
228 | DBIx::Class::UUIDMaker subbclass and throws and exception if it isn't. |
229 | |
230 | =head2 uuid_maker |
231 | |
232 | Returns the current UUIDMaker instance for the given module. |
233 | |
234 | my $uuid = __PACKAGE__->uuid_maker->as_string; |
235 | |
236 | =head1 SEE ALSO |
237 | |
238 | L<DBIx::Class::UUIDMaker> |
239 | |
7da9cd47 |
240 | =head1 AUTHORS |
241 | |
242 | Chia-liang Kao <clkao@clkao.org> |
e78f023a |
243 | Chris Laco <claco@chrislaco.com> |
7da9cd47 |
244 | |
245 | =head1 LICENSE |
246 | |
247 | You may distribute this code under the same terms as Perl itself. |