From: Thomas Kratz <tomk@cpan.org>
Date: Thu, 18 May 2006 17:13:14 +0000 (+0000)
Subject: Moved UUIDColumns from DBIX-Class-current into it's own dist in the trunk
X-Git-Tag: v0.01001~8
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class-UUIDColumns.git;a=commitdiff_plain;h=cb9fa024bf2769df770dd29ba837f065eeea2cb3

Moved UUIDColumns from DBIX-Class-current into it's own dist in the trunk
---

diff --git a/lib/DBIx/Class/UUIDColumns.pm b/lib/DBIx/Class/UUIDColumns.pm
new file mode 100644
index 0000000..fdd6adc
--- /dev/null
+++ b/lib/DBIx/Class/UUIDColumns.pm
@@ -0,0 +1,152 @@
+package DBIx::Class::UUIDColumns;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class/;
+
+__PACKAGE__->mk_classdata( 'uuid_auto_columns' => [] );
+__PACKAGE__->mk_classdata( 'uuid_maker' );
+__PACKAGE__->uuid_class( __PACKAGE__->_find_uuid_module );
+
+# be compatible with Class::DBI::UUID
+sub uuid_columns {
+    my $self = shift;
+    for (@_) {
+        $self->throw_exception("column $_ doesn't exist") unless $self->has_column($_);
+    }
+    $self->uuid_auto_columns(\@_);
+}
+
+sub uuid_class {
+    my ($self, $class) = @_;
+
+    if ($class) {
+        $class = "DBIx::Class::UUIDMaker$class" if $class =~ /^::/;
+
+        if (!eval "require $class") {
+            $self->throw_exception("$class could not be loaded: $@");
+        } elsif (!$class->isa('DBIx::Class::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_auto_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 ($^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';
+    } else {
+        shift->throw_exception('no suitable uuid module could be found')
+    };
+};
+
+1;
+__END__
+
+=head1 NAME
+
+DBIx::Class::UUIDColumns - Implicit uuid columns
+
+=head1 SYNOPSIS
+
+  package Artist;
+  __PACKAGE__->load_components(qw/UUIDColumns Core DB/);
+  __PACKAGE__->uuid_columns( 'artist_id' );
+
+=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 C<uuid_class>:
+
+  __PACKAGE__->uuid_class('::Data::UUID');
+  __PACKAGE__->uuid_class('MyUUIDGenerator');
+
+Note that the component needs to be loaded before Core.
+
+=head1 METHODS
+
+=head2 uuid_columns(@columns)
+
+Takes a list of columns to be filled with uuids during insert.
+
+  __PACKAGE__->uuid_columns('id');
+
+=head2 uuid_class($classname)
+
+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 DBIx::Class::UUIDMaker subclasses:
+
+  __PACKAGE__->uuid_class('CustomUUIDGenerator');
+  # loads CustomeUUIDGenerator
+
+  __PACKAGE->uuid_class('::Data::UUID');
+  # loads DBIx::Class::UUIDMaker::Data::UUID;
+
+Note that C<uuid_class> chacks to see that the specified class isa
+DBIx::Class::UUIDMaker subbclass 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::UUIDMaker>
+
+=head1 AUTHORS
+
+Chia-liang Kao <clkao@clkao.org>
+Chris Laco <claco@chrislaco.com>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
diff --git a/lib/DBIx/Class/UUIDMaker.pm b/lib/DBIx/Class/UUIDMaker.pm
new file mode 100644
index 0000000..f492801
--- /dev/null
+++ b/lib/DBIx/Class/UUIDMaker.pm
@@ -0,0 +1,59 @@
+package DBIx::Class::UUIDMaker;
+
+use strict;
+use warnings;
+
+sub new {
+    return bless {}, shift;
+};
+
+sub as_string {
+    return undef;
+};
+
+1;
+__END__
+
+=head1 NAME
+
+DBIx::Class::UUIDMaker - UUID wrapper module
+
+=head1 SYNOPSIS
+
+  package CustomUUIDMaker;
+  use base qw/DBIx::Class::/;
+
+  sub as_string {
+    my $uuid;
+    ...magic incantations...
+    return $uuid;
+  };
+
+=head1 DESCRIPTION
+
+DBIx::Class::UUIDMaker is a base class used by the various uuid generation
+subclasses.
+
+=head1 METHODS
+
+=head2 as_string
+
+Returns the new uuid as a string.
+
+=head1 SEE ALSO
+
+L<DBIx::Class::UUIDMaker>,
+L<DBIx::Class::UUIDMaker::UUID>,
+L<DBIx::Class::UUIDMaker::APR::UUID>,
+L<DBIx::Class::UUIDMaker::Data::UUID>,
+L<DBIx::Class::UUIDMaker::Win32::Guidgen>,
+L<DBIx::Class::UUIDMaker::Win32API::GUID>,
+L<DBIx::Class::UUIDMaker::Data::Uniqid>
+
+=head1 AUTHOR
+
+Chris Laco <claco@chrislaco.com>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
diff --git a/lib/DBIx/Class/UUIDMaker/APR/UUID.pm b/lib/DBIx/Class/UUIDMaker/APR/UUID.pm
new file mode 100644
index 0000000..c7a383d
--- /dev/null
+++ b/lib/DBIx/Class/UUIDMaker/APR/UUID.pm
@@ -0,0 +1,50 @@
+package DBIx::Class::UUIDMaker::APR::UUID;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::UUIDMaker/;
+use APR::UUID ();
+
+sub as_string {
+    return APR::UUID->new->format;
+};
+
+1;
+__END__
+
+=head1 NAME
+
+DBIx::Class::UUIDMaker::APR::UUID - Create uuids using APR::UUID
+
+=head1 SYNOPSIS
+
+  package Artist;
+  __PACKAGE__->load_components(qw/UUIDColumns Core DB/);
+  __PACKAGE__->uuid_columns( 'artist_id' );
+  __PACKAGE__->uuid_class('::APR::UUID');
+
+=head1 DESCRIPTION
+
+This DBIx::Class::UUIDMaker subclass uses APR::UUID to generate uuid
+strings in the following format:
+
+  098f2470-bae0-11cd-b579-08002b30bfeb
+
+=head1 METHODS
+
+=head2 as_string
+
+Returns the new uuid as a string.
+
+=head1 SEE ALSO
+
+L<APR::UUID>
+
+=head1 AUTHOR
+
+Chris Laco <claco@chrislaco.com>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
diff --git a/lib/DBIx/Class/UUIDMaker/Data/UUID.pm b/lib/DBIx/Class/UUIDMaker/Data/UUID.pm
new file mode 100644
index 0000000..f70680c
--- /dev/null
+++ b/lib/DBIx/Class/UUIDMaker/Data/UUID.pm
@@ -0,0 +1,50 @@
+package DBIx::Class::UUIDMaker::Data::UUID;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::UUIDMaker/;
+use Data::UUID ();
+
+sub as_string {
+    return Data::UUID->new->to_string(Data::UUID->new->create);
+};
+
+1;
+__END__
+
+=head1 NAME
+
+DBIx::Class::UUIDMaker::Data::UUID - Create uuids using Data::UUID
+
+=head1 SYNOPSIS
+
+  package Artist;
+  __PACKAGE__->load_components(qw/UUIDColumns Core DB/);
+  __PACKAGE__->uuid_columns( 'artist_id' );
+  __PACKAGE__->uuid_class('::Data::UUID');
+
+=head1 DESCRIPTION
+
+This DBIx::Class::UUIDMaker subclass uses Data::UUID to generate uuid
+strings in the following format:
+
+  098f2470-bae0-11cd-b579-08002b30bfeb
+
+=head1 METHODS
+
+=head2 as_string
+
+Returns the new uuid as a string.
+
+=head1 SEE ALSO
+
+L<Data::UUID>
+
+=head1 AUTHOR
+
+Chris Laco <claco@chrislaco.com>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
diff --git a/lib/DBIx/Class/UUIDMaker/Data/Uniqid.pm b/lib/DBIx/Class/UUIDMaker/Data/Uniqid.pm
new file mode 100644
index 0000000..36189e1
--- /dev/null
+++ b/lib/DBIx/Class/UUIDMaker/Data/Uniqid.pm
@@ -0,0 +1,48 @@
+package DBIx::Class::UUIDMaker::Data::Uniqid;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::UUIDMaker/;
+use Data::Uniqid ();
+
+sub as_string {
+    return Data::Uniqid->luniqid;
+};
+
+1;
+__END__
+
+=head1 NAME
+
+DBIx::Class::UUIDMaker::Data::Uniqid - Create uuids using Data::Uniqid
+
+=head1 SYNOPSIS
+
+  package Artist;
+  __PACKAGE__->load_components(qw/UUIDColumns Core DB/);
+  __PACKAGE__->uuid_columns( 'artist_id' );
+  __PACKAGE__->uuid_class('::Data::Uniqid');
+
+=head1 DESCRIPTION
+
+This DBIx::Class::UUIDMaker subclass uses Data::Uniqid to generate uuid
+strings using Data::Uniqid::luniqid.
+
+=head1 METHODS
+
+=head2 as_string
+
+Returns the new uuid as a string.
+
+=head1 SEE ALSO
+
+L<Data::Data::Uniqid>
+
+=head1 AUTHOR
+
+Chris Laco <claco@chrislaco.com>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
diff --git a/lib/DBIx/Class/UUIDMaker/UUID.pm b/lib/DBIx/Class/UUIDMaker/UUID.pm
new file mode 100644
index 0000000..f6fb802
--- /dev/null
+++ b/lib/DBIx/Class/UUIDMaker/UUID.pm
@@ -0,0 +1,54 @@
+package DBIx::Class::UUIDMaker::UUID;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::UUIDMaker/;
+use UUID ();
+
+sub as_string {
+    my ($uuid, $uuidstring);
+    UUID::generate($uuid);
+    UUID::unparse($uuid, $uuidstring);
+
+    return $uuidstring;
+};
+
+1;
+__END__
+
+=head1 NAME
+
+DBIx::Class::UUIDMaker::UUID - Create uuids using UUID
+
+=head1 SYNOPSIS
+
+  package Artist;
+  __PACKAGE__->load_components(qw/UUIDColumns Core DB/);
+  __PACKAGE__->uuid_columns( 'artist_id' );
+  __PACKAGE__->uuid_class('::UUID');
+
+=head1 DESCRIPTION
+
+This DBIx::Class::UUIDMaker subclass uses UUID to generate uuid
+strings in the following format:
+
+  098f2470-bae0-11cd-b579-08002b30bfeb
+
+=head1 METHODS
+
+=head2 as_string
+
+Returns the new uuid as a string.
+
+=head1 SEE ALSO
+
+L<UUID>
+
+=head1 AUTHOR
+
+Chris Laco <claco@chrislaco.com>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
diff --git a/lib/DBIx/Class/UUIDMaker/Win32/Guidgen.pm b/lib/DBIx/Class/UUIDMaker/Win32/Guidgen.pm
new file mode 100644
index 0000000..d9ba0ce
--- /dev/null
+++ b/lib/DBIx/Class/UUIDMaker/Win32/Guidgen.pm
@@ -0,0 +1,53 @@
+package DBIx::Class::UUIDMaker::Win32::Guidgen;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::UUIDMaker/;
+use Win32::Guidgen ();
+
+sub as_string {
+    my $uuid = Win32::Guidgen::create();
+    $uuid =~ s/(^\{|\}$)//g;
+
+    return $uuid;
+};
+
+1;
+__END__
+
+=head1 NAME
+
+DBIx::Class::UUIDMaker::Win32::Guidgen - Create uuids using Win32::Guidgen
+
+=head1 SYNOPSIS
+
+  package Artist;
+  __PACKAGE__->load_components(qw/UUIDColumns Core DB/);
+  __PACKAGE__->uuid_columns( 'artist_id' );
+  __PACKAGE__->uuid_class('::Win32::Guidgen');
+
+=head1 DESCRIPTION
+
+This DBIx::Class::UUIDMaker subclass uses Win32::Guidgen to generate uuid
+strings in the following format:
+
+  098f2470-bae0-11cd-b579-08002b30bfeb
+
+=head1 METHODS
+
+=head2 as_string
+
+Returns the new uuid as a string.
+
+=head1 SEE ALSO
+
+L<Win32::Guidgen>
+
+=head1 AUTHOR
+
+Chris Laco <claco@chrislaco.com>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
diff --git a/lib/DBIx/Class/UUIDMaker/Win32API/GUID.pm b/lib/DBIx/Class/UUIDMaker/Win32API/GUID.pm
new file mode 100644
index 0000000..89df553
--- /dev/null
+++ b/lib/DBIx/Class/UUIDMaker/Win32API/GUID.pm
@@ -0,0 +1,50 @@
+package DBIx::Class::UUIDMaker::Win32API::GUID;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::UUIDMaker/;
+use Win32API::GUID ();
+
+sub as_string {
+    return Win32API::GUID::CreateGuid();
+};
+
+1;
+__END__
+
+=head1 NAME
+
+DBIx::Class::UUIDMaker::Win32API::GUID - Create uuids using Win32API::GUID
+
+=head1 SYNOPSIS
+
+  package Artist;
+  __PACKAGE__->load_components(qw/UUIDColumns Core DB/);
+  __PACKAGE__->uuid_columns( 'artist_id' );
+  __PACKAGE__->uuid_class('::Win32API::GUID');
+
+=head1 DESCRIPTION
+
+This DBIx::Class::UUIDMaker subclass uses Win32API::GUID to generate uuid
+strings in the following format:
+
+  098f2470-bae0-11cd-b579-08002b30bfeb
+
+=head1 METHODS
+
+=head2 as_string
+
+Returns the new uuid as a string.
+
+=head1 SEE ALSO
+
+L<Win32API::GUID>
+
+=head1 AUTHOR
+
+Chris Laco <claco@chrislaco.com>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.