From: Matt S Trout Date: Sat, 18 Mar 2006 22:38:07 +0000 (+0000) Subject: (no commit message) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c17c525c5db20008c195405199271113a53cd289;p=dbsrgits%2FDBIx-Class-Historic.git --- diff --git a/lib/DBIx/Class/UUIDColumns.pm b/lib/DBIx/Class/UUIDColumns.pm index 8a58527..1853145 100644 --- a/lib/DBIx/Class/UUIDColumns.pm +++ b/lib/DBIx/Class/UUIDColumns.pm @@ -113,30 +113,57 @@ 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; +sub uuid_class { + my ($self, $class) = @_; -Note that C chacks to see that the specified class isa -DBIx::Class::UUIDMaker subbclass and throws and exception if it isn't. + if ($class) { + $class = "DBIx::Class::UUIDMaker$class" if $class =~ /^::/; -=head2 uuid_maker + 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); + }; + }; -Returns the current UUIDMaker instance for the given module. + return ref $self->uuid_maker; +}; - my $uuid = __PACKAGE__->uuid_maker->as_string; +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(@_); +} -=head1 SEE ALSO +sub get_uuid { + return shift->uuid_maker->as_string; +} -L +sub _find_uuid_module { + if ($^O ne 'openbsd' && eval{require APR::UUID}) { + # APR::UUID on openbsd causes some as yet unfound nastyness for XS + return '::APR::UUID'; + } elsif (eval{require UUID}) { + return '::UUID'; + } elsif (eval{require Data::UUID}) { + return '::Data::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') + }; +}; =head1 AUTHORS diff --git a/lib/DBIx/Class/UUIDColumns.pm~ b/lib/DBIx/Class/UUIDColumns.pm~ new file mode 100644 index 0000000..1873c90 --- /dev/null +++ b/lib/DBIx/Class/UUIDColumns.pm~ @@ -0,0 +1,63 @@ +package DBIx::Class::UUIDColumns; +use base qw/DBIx::Class/; + +use Data::UUID; + +__PACKAGE__->mk_classdata( 'uuid_auto_columns' => [] ); + +=head1 NAME + +DBIx::Class::UUIDColumns - Implicit uuid columns + +=head1 SYNOPSIS + + pacakge Artist; + __PACKAGE__->load_components(qw/UUIDColumns Core DB/); + __PACKAGE__->uuid_columns( 'artist_id' );x + +=head1 DESCRIPTION + +This L component resambles the behaviour of +L, to make some columns implicitly created as uuid. + +Note that the component needs to be loaded before Core. + +=head1 METHODS + +=head2 uuid_columns + +=cut + +# 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 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 Data::UUID->new->to_string(Data::UUID->new->create), +} + +=head1 AUTHORS + +Chia-liang Kao + +=head1 LICENSE + +You may distribute this code under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/DBIx/Class/UUIDMaker.pm b/lib/DBIx/Class/UUIDMaker.pm index b9c196c..67061ad 100644 --- a/lib/DBIx/Class/UUIDMaker.pm +++ b/lib/DBIx/Class/UUIDMaker.pm @@ -9,48 +9,3 @@ sub as_string { }; 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 encantations... - 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, -L, -L, -L, -L, -L, -L - -=head1 AUTHOR - -Chris Laco - -=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 index 136ec5f..65305f0 100644 --- a/lib/DBIx/Class/UUIDMaker/APR/UUID.pm +++ b/lib/DBIx/Class/UUIDMaker/APR/UUID.pm @@ -7,40 +7,3 @@ sub as_string { }; 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 - -=head1 AUTHOR - -Chris Laco - -=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 index 820669c..ffa1afb 100644 --- a/lib/DBIx/Class/UUIDMaker/Data/UUID.pm +++ b/lib/DBIx/Class/UUIDMaker/Data/UUID.pm @@ -7,40 +7,3 @@ sub as_string { }; 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 - -=head1 AUTHOR - -Chris Laco - -=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 index 8d9a29d..61bf347 100644 --- a/lib/DBIx/Class/UUIDMaker/Data/Uniqid.pm +++ b/lib/DBIx/Class/UUIDMaker/Data/Uniqid.pm @@ -7,38 +7,3 @@ sub as_string { }; 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 - -=head1 AUTHOR - -Chris Laco - -=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 index 7a647a9..28a34b9 100644 --- a/lib/DBIx/Class/UUIDMaker/UUID.pm +++ b/lib/DBIx/Class/UUIDMaker/UUID.pm @@ -11,40 +11,3 @@ sub as_string { }; 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 - -=head1 AUTHOR - -Chris Laco - -=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 index 3c34b9a..9afa652 100644 --- a/lib/DBIx/Class/UUIDMaker/Win32/Guidgen.pm +++ b/lib/DBIx/Class/UUIDMaker/Win32/Guidgen.pm @@ -4,46 +4,9 @@ use Win32::Guidgen (); sub as_string { my $uuid = Win32::Guidgen::create(); - $uuid =~ s/(^\{|\}$)//g; + $uuid =~ s/(^\{|\}$)//; 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 - -=head1 AUTHOR - -Chris Laco - -=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 index 85caad1..463bbba 100644 --- a/lib/DBIx/Class/UUIDMaker/Win32API/GUID.pm +++ b/lib/DBIx/Class/UUIDMaker/Win32API/GUID.pm @@ -7,40 +7,3 @@ sub as_string { }; 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 - -=head1 AUTHOR - -Chris Laco - -=head1 LICENSE - -You may distribute this code under the same terms as Perl itself.