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