File Coverage

blib/lib/DBIx/Class/UUIDColumns.pm
Criterion Covered Total %
statement 23 50 46.0
branch 7 28 25.0
condition 1 5 20.0
subroutine 6 10 60.0
pod n/a
total 37 93 39.7


line stmt bran cond sub pod time code
1             package DBIx::Class::UUIDColumns;
2 2     2   183037 use strict;
  2         5  
  2         66  
3 2     2   8 use warnings;
  2         3  
  2         49  
4 2     2   9 use vars qw($VERSION);
  2         6  
  2         94  
5              
6             BEGIN {
7 2     2   9 use base qw/DBIx::Class Class::Accessor::Grouped/;
  2         3  
  2         578  
8              
9 2     2   35807 __PACKAGE__->mk_group_accessors('inherited', qw/uuid_auto_columns uuid_maker/);
10             };
11             __PACKAGE__->uuid_class(__PACKAGE__->_find_uuid_module);
12              
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.02006';
18              
19             sub uuid_columns {
20 0     0   0 my $self = shift;
21              
22 0 0       0 if (scalar @_) {
23 0         0 for (@_) {
24 0 0       0 $self->throw_exception("column $_ doesn't exist") unless $self->has_column($_);
25             }
26 0         0 $self->uuid_auto_columns(\@_);
27             };
28              
29 0   0     0 return $self->uuid_auto_columns || [];
30             }
31              
32             sub uuid_class {
33 0     0   0 my ($self, $class) = @_;
34              
35 0 0       0 if ($class) {
36 0 0       0 $class = "DBIx::Class::UUIDColumns::UUIDMaker$class" if $class =~ /^::/;
37              
38 0 0       0 if (!eval "require $class") {
    0          
39 0         0 $self->throw_exception("$class could not be loaded: $@");
40             } elsif (!$class->isa('DBIx::Class::UUIDColumns::UUIDMaker')) {
41 0         0 $self->throw_exception("$class is not a UUIDMaker subclass");
42             } else {
43 0         0 $self->uuid_maker($class->new);
44             };
45             };
46              
47 0         0 return ref $self->uuid_maker;
48             };
49              
50             sub insert {
51 0     0   0 my $self = shift;
52 0         0 for my $column (@{$self->uuid_columns}) {
  0         0  
53 0 0       0 $self->store_column( $column, $self->get_uuid )
54             unless defined $self->get_column( $column );
55             }
56 0         0 $self->next::method(@_);
57             }
58              
59             sub get_uuid {
60 0     0   0 return shift->uuid_maker->as_string;
61             }
62              
63             sub _find_uuid_module {
64 2 50 33 2   3 if (eval{require Data::UUID}) {
  2 50       396  
  2 50       278  
    50          
    50          
    50          
    50          
65 0         0 return '::Data::UUID';
66 2         287 } elsif (eval{require Data::GUID}) {
67 0         0 return '::Data::GUID';
68 2         281 } elsif ($^O ne 'openbsd' && eval{require APR::UUID}) {
69             # APR::UUID on openbsd causes some as yet unfound nastiness for XS
70 0         0 return '::APR::UUID';
71             } elsif (eval{require UUID}) {
72 0         0 return '::UUID';
73             } elsif (eval{
74             # squelch the 'too late for INIT' warning in Win32::API::Type
75 2         7 local $^W = 0;
76 2         288 require Win32::Guidgen;
77 2         277 }) {
78 0         0 return '::Win32::Guidgen';
79 2         267 } elsif (eval{require Win32API::GUID}) {
80 0         0 return '::Win32API::GUID';
81             } elsif (eval{require UUID::Random}) {
82 0         0 return '::UUID::Random';
83             } else {
84 2         45 die 'no suitable uuid module could be found for use with DBIx::Class::UUIDColumns';
85             };
86             };
87              
88             1;
89             __END__