-use strict;
-use Module::Build;
-
-my %arguments = (
- create_makefile_pl => 'passthrough',
- license => 'perl',
- module_name => 'DBIx::Class::UUIDColumns',
- requires => {
- 'DBIx::Class' => 0.06002,
- },
- build_requires => {
- 'DBD::SQLite' => 1.11,
- 'SQL::Translator' => 0.07
- },
- recommends => {
- 'Data::UUID' => 0,
- 'APR::UUID' => 0,
- 'UUID' => 0,
- 'Win32::Guidgen' => 0,
- 'Win32API::GUID' => 0,
- },
- create_makefile_pl => 'passthrough',
- create_readme => 1,
- test_files => [ glob('t/*.t')],
- add_to_cleanup => ['t/var/*']
-);
-
-Module::Build->new(%arguments)->create_build_script;
-
+# $Id: Build.PL 3236 2007-05-05 16:24:35Z claco $\r
+require 'Makefile.PL';\r
Revision history for DBIx::Class::UUIDColumns
+0.01001 Sat May 05 20:01:13 2007
+ - RT#22364 (ASH) hopefully fixed with updated prereq
+ - Added Data::GUID support
+ - Fixed ::Win32API::GUID incorrect subclass
+ - Converted to Module::Install
+ - Added cargo tests/TEST_AUTHOR
+ - Much improved test coverage
+ - Fixed case where no uuid module found so that it dies with error, not with
+ method not found
+
0.00001
- - initial release
\ No newline at end of file
+ - initial release
\ No newline at end of file
+++ /dev/null
-Build.PL
-Changes
-lib/DBIx/Class/UUIDColumns.pm
-lib/DBIx/Class/UUIDColumns/UUIDMaker.pm
-lib/DBIx/Class/UUIDColumns/UUIDMaker/APR/UUID.pm
-lib/DBIx/Class/UUIDColumns/UUIDMaker/Data/Uniqid.pm
-lib/DBIx/Class/UUIDColumns/UUIDMaker/Data/UUID.pm
-lib/DBIx/Class/UUIDColumns/UUIDMaker/UUID.pm
-lib/DBIx/Class/UUIDColumns/UUIDMaker/Win32/Guidgen.pm
-lib/DBIx/Class/UUIDColumns/UUIDMaker/Win32API/GUID.pm
-Makefile.PL
-MANIFEST This list of files
-MANIFEST.SKIP
-META.yml
-README
-t/02pod.t
-t/03podcoverage.t
-t/04basic.t
-t/05uuid.t
-t/lib/CustomUUIDMaker.pm
-t/lib/UUIDTest.pm
-t/lib/UUIDTest/Schema.pm
-t/lib/UUIDTest/Schema/Test.pm
-t/lib/UUIDTest/Setup.pm
-# Avoid version control files.
-\bRCS\b
-\bCVS\b
-,v$
-\B\.svn\b
-
-# Avoid Makemaker generated and utility files.
-\bMakefile$
-\bblib
-\bMakeMaker-\d
-\bpm_to_blib$
-\bblibdirs$
-^MANIFEST\.SKIP$
-
-# for developers only :)
-^TODO$
-
-# Avoid Module::Build generated and utility files.
-\bBuild$
-\b_build
-
-# Avoid temp and backup files.
-~$
-\.tmp$
-\.old$
-\.bak$
-\#$
-\b\.#
-
-# avoid OS X finder files
-\.DS_Store$
-
-# Don't ship the test db
-^t/var
-
-# Don't ship the last dist we built :)
-\.tar\.gz$
-
-# Skip maint stuff
-^maint/
+\bRCS\b\r
+\bCVS\b\r
+,v$\r
+\B\.svn\b\r
+t/var\r
+^blib/\r
+^pm_to_blib\r
+^MakeMaker-\d\r
+Makefile$\r
+Makefile.old$\r
+Build.PL\r
+Build.bat\r
+\.db\r
+t/TEST$\r
+t/SMOKE$\r
+^blibdirs\.ts\r
+\.gz
\ No newline at end of file
+++ /dev/null
----
-name: DBIx-Class-UUIDColumns
-version: 0.01000
-author:
- - 'Chia-liang Kao <clkao@clkao.org>'
-abstract: Implicit uuid columns
-license: perl
-requires:
- DBIx::Class: 0.06002
-recommends:
- APR::UUID: 0
- Data::UUID: 0
- UUID: 0
- Win32::Guidgen: 0
- Win32API::GUID: 0
-build_requires:
- DBD::SQLite: 1.11
- SQL::Translator: 0.07
-provides:
- DBIx::Class::UUIDColumns:
- file: lib/DBIx/Class/UUIDColumns.pm
- version: 0.01000
- DBIx::Class::UUIDColumns::UUIDMaker:
- file: lib/DBIx/Class/UUIDColumns/UUIDMaker.pm
- DBIx::Class::UUIDColumns::UUIDMaker::APR::UUID:
- file: lib/DBIx/Class/UUIDColumns/UUIDMaker/APR/UUID.pm
- DBIx::Class::UUIDColumns::UUIDMaker::Data::UUID:
- file: lib/DBIx/Class/UUIDColumns/UUIDMaker/Data/UUID.pm
- DBIx::Class::UUIDColumns::UUIDMaker::Data::Uniqid:
- file: lib/DBIx/Class/UUIDColumns/UUIDMaker/Data/Uniqid.pm
- DBIx::Class::UUIDColumns::UUIDMaker::UUID:
- file: lib/DBIx/Class/UUIDColumns/UUIDMaker/UUID.pm
- DBIx::Class::UUIDColumns::UUIDMaker::Win32::Guidgen:
- file: lib/DBIx/Class/UUIDColumns/UUIDMaker/Win32/Guidgen.pm
- DBIx::Class::UUIDColumns::UUIDMaker::Win32API::GUID:
- file: lib/DBIx/Class/UUIDColumns/UUIDMaker/Win32API/GUID.pm
-generated_by: Module::Build version 0.26
-# Note: this file was auto-generated by Module::Build::Compat version 0.03
-
- unless (eval "use Module::Build::Compat 0.02; 1" ) {
- print "This module requires Module::Build to install itself.\n";
-
- require ExtUtils::MakeMaker;
- my $yn = ExtUtils::MakeMaker::prompt
- (' Install Module::Build now from CPAN?', 'y');
-
- unless ($yn =~ /^y/i) {
- die " *** Cannot install without Module::Build. Exiting ...\n";
- }
-
- require Cwd;
- require File::Spec;
- require CPAN;
-
- # Save this 'cause CPAN will chdir all over the place.
- my $cwd = Cwd::cwd();
- my $makefile = File::Spec->rel2abs($0);
-
- CPAN::Shell->install('Module::Build::Compat')
- or die " *** Cannot install without Module::Build. Exiting ...\n";
-
- chdir $cwd or die "Cannot chdir() back to $cwd: $!";
- }
- eval "use Module::Build::Compat 0.02; 1" or die $@;
- use lib '_build/lib';
- Module::Build::Compat->run_build_pl(args => \@ARGV);
- require Module::Build;
- Module::Build::Compat->write_makefile(build_class => 'Module::Build');
+# $Id: Makefile.PL 3236 2007-05-05 16:24:35Z claco $\r
+use strict;\r
+use warnings;\r
+use inc::Module::Install 0.65;\r
+\r
+name 'DBIx-Class-UUIDColumns';\r
+license 'perl';\r
+perl_version '5.008001';\r
+all_from 'lib/DBIx/Class/UUIDColumns.pm';\r
+\r
+requires 'DBIx::Class' => '0.07005';\r
+\r
+if (\r
+ !eval 'require Data::UUID' &&\r
+ !eval 'require ARE::UUID' &&\r
+ !eval 'require UUID' &&\r
+ !eval 'require Win32::Guidgen' &&\r
+ !eval 'require Win32API::GUID' &&\r
+ !eval 'require Data::Uniqid'\r
+ ) {\r
+ requires 'Data::UUID';\r
+};\r
+\r
+build_requires 'DBD::SQLite' => '1.11';\r
+\r
+recommends 'Data::UUID';\r
+recommends 'Data::Uniqid';\r
+recommends 'APR::UUID';\r
+recommends 'UUID';\r
+recommends 'Win32::Guidgen';\r
+recommends 'Win32API::GUID';\r
+\r
+tests "t/*.t t/*/*.t";\r
+clean_files "DBIx-Class-UUIDColumns-* t/var";\r
+\r
+eval {\r
+ system 'pod2text lib/DBIx/Class/UUIDColumns.pm > README';\r
+};\r
+\r
+auto_install;\r
+WriteAll;\r
-NAME
- DBIx::Class::UUIDColumns - Implicit uuid columns
-
-SYNOPSIS
- In your DBIx::Class table class:
-
- __PACKAGE__->load_components(qw/UUIDColumns ... Core/);
- __PACKAGE__->uuid_columns('artist_id');
-
- Note: The component needs to be loaded *before* Core.
-
-DESCRIPTION
- This DBIx::Class component resembles the behaviour of Class::DBI::UUID,
- to make some columns implicitly created as uuid.
-
- When loaded, "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 "uuid_class":
-
- __PACKAGE__->uuid_class('::Data::UUID');
- __PACKAGE__->uuid_class('MyUUIDGenerator');
-
-METHODS
- get_uuid
- Returns a uuid string from the current uuid_maker.
-
- insert
- Inserts a new uuid string into each column in "uuid_columns".
-
- uuid_columns
- Takes a list of columns to be filled with uuids during insert.
-
- __PACKAGE__->uuid_columns('artist_id');
-
- 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
- DBIx::Class::UUIDColumns::UUIDMaker subclasses:
-
- __PACKAGE__->uuid_class('CustomUUIDGenerator');
- # loads CustomeUUIDGenerator
-
- __PACKAGE__->uuid_class('::Data::UUID');
- # loads DBIx::Class::UUIDMaker::Data::UUID;
-
- Note that "uuid_class" chacks to see that the specified class isa
- DBIx::Class::UUIDColumns::UUIDMaker subbclass and throws and exception
- if it isn't.
-
- uuid_maker
- Returns the current UUIDMaker instance for the given module.
-
- my $uuid = __PACKAGE__->uuid_maker->as_string;
-
-SEE ALSO
- DBIx::Class::UUIDColumns::UUIDMaker
-
-AUTHOR
- Chia-liang Kao <clkao@clkao.org>
-
-CONTRIBUTERS
- Chris Laco <claco@chrislaco.com>
-
-LICENSE
- You may distribute this code under the same terms as Perl itself.
-
+NAME\r
+ DBIx::Class::UUIDColumns - Implicit uuid columns\r
+\r
+SYNOPSIS\r
+ In your DBIx::Class table class:\r
+\r
+ __PACKAGE__->load_components(qw/UUIDColumns ... Core/);\r
+ __PACKAGE__->uuid_columns('artist_id');\r
+\r
+ Note: The component needs to be loaded *before* Core.\r
+\r
+DESCRIPTION\r
+ This DBIx::Class component resembles the behaviour of Class::DBI::UUID,\r
+ to make some columns implicitly created as uuid.\r
+\r
+ When loaded, "UUIDColumns" will search for a suitable uuid generation\r
+ module from the following list of supported modules:\r
+\r
+ Data::UUID\r
+ APR::UUID*\r
+ UUID\r
+ Win32::Guidgen\r
+ Win32API::GUID\r
+\r
+ If no supporting module can be found, an exception will be thrown.\r
+\r
+ *APR::UUID will not be loaded under OpenBSD due to an as yet\r
+ unidentified XS issue.\r
+\r
+ If you would like to use a specific module, you can set "uuid_class":\r
+\r
+ __PACKAGE__->uuid_class('::Data::UUID');\r
+ __PACKAGE__->uuid_class('MyUUIDGenerator');\r
+\r
+METHODS\r
+ get_uuid\r
+ Returns a uuid string from the current uuid_maker.\r
+\r
+ insert\r
+ Inserts a new uuid string into each column in "uuid_columns".\r
+\r
+ uuid_columns\r
+ Takes a list of columns to be filled with uuids during insert.\r
+\r
+ __PACKAGE__->uuid_columns('artist_id');\r
+\r
+ uuid_class\r
+ Takes the name of a UUIDMaker subclass to be used for uuid value\r
+ generation. This can be a fully qualified class name, or a shortcut name\r
+ starting with :: that matches one of the available\r
+ DBIx::Class::UUIDColumns::UUIDMaker subclasses:\r
+\r
+ __PACKAGE__->uuid_class('CustomUUIDGenerator');\r
+ # loads CustomeUUIDGenerator\r
+\r
+ __PACKAGE__->uuid_class('::Data::UUID');\r
+ # loads DBIx::Class::UUIDMaker::Data::UUID;\r
+\r
+ Note that "uuid_class" checks to see that the specified class isa\r
+ DBIx::Class::UUIDColumns::UUIDMaker subclass and throws and exception if\r
+ it isn't.\r
+\r
+ uuid_maker\r
+ Returns the current UUIDMaker instance for the given module.\r
+\r
+ my $uuid = __PACKAGE__->uuid_maker->as_string;\r
+\r
+SEE ALSO\r
+ DBIx::Class::UUIDColumns::UUIDMaker\r
+\r
+AUTHOR\r
+ Chia-liang Kao <clkao@clkao.org>\r
+\r
+CONTRIBUTERS\r
+ Chris Laco <claco@chrislaco.com>\r
+\r
+LICENSE\r
+ You may distribute this code under the same terms as Perl itself.\r
+\r
# 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.01000';
+$VERSION = '0.01001';
sub uuid_columns {
my $self = shift;
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';
__PACKAGE__->uuid_class('::Data::UUID');
# loads DBIx::Class::UUIDMaker::Data::UUID;
-Note that C<uuid_class> chacks to see that the specified class isa
-L<DBIx::Class::UUIDColumns::UUIDMaker> subbclass and throws and exception if it isn't.
+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
--- /dev/null
+package DBIx::Class::UUIDColumns::UUIDMaker::Data::GUID;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::UUIDColumns::UUIDMaker/;
+use Data::GUID ();
+
+sub as_string {
+ return Data::GUID->new->as_string;
+};
+
+1;
+__END__
+
+=head1 NAME
+
+DBIx::Class::UUIDColumns::UUIDMaker::Data::GUID - Create uuids using Data::GUID
+
+=head1 SYNOPSIS
+
+ package Artist;
+ __PACKAGE__->load_components(qw/UUIDColumns Core DB/);
+ __PACKAGE__->uuid_columns( 'artist_id' );
+ __PACKAGE__->uuid_class('::Data::GUID');
+
+=head1 DESCRIPTION
+
+This DBIx::Class::UUIDColumns::UUIDMaker subclass uses Data::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<Data::GUID>
+
+=head1 AUTHOR
+
+Chris Laco <claco@chrislaco.com>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
use strict;
use warnings;
-use base qw/DBIx::Class::UUIDMaker/;
+use base qw/DBIx::Class::UUIDColumns::UUIDMaker/;
use Win32API::GUID ();
sub as_string {
+++ /dev/null
-use Test::More;
-
-eval "use Test::Pod 1.14";
-plan skip_all => 'Test::Pod 1.14 required' if $@;
-
-all_pod_files_ok();
+++ /dev/null
-use Test::More;
-
-eval "use Test::Pod::Coverage 1.04";
-plan skip_all => 'Test::Pod::Coverage 1.04 required' if $@;
-plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD};
-
-all_pod_coverage_ok();
+++ /dev/null
-use strict;
-use warnings;
-use Test::More;
-
-BEGIN {
- eval "use DBD::SQLite";
- plan $@
- ? ( skip_all => 'needs DBD::SQLite for testing' )
- : ( tests => 2 );
-}
-
-use lib qw(t/lib);
-
-use_ok('DBIx::Class::UUIDColumns');
-use_ok('DBIx::Class::UUIDColumns::UUIDMaker');
\ No newline at end of file
+++ /dev/null
-use strict;
-use warnings;
-use Test::More;
-
-BEGIN {
- plan skip_all => 'needs Data::UUID for testing'
- unless
- eval 'require Data::UUID' ||
- eval 'require APR::UUID' ||
- eval 'require UUID' ||
- eval 'require Win32::Guidgen' ||
- eval 'require Win32API::GUID';
-
- plan skip_all => 'needs SQL::Translator for testing'
- unless eval 'require SQL::Translator';
-
- plan tests => 3;
-}
-
-use lib qw(t/lib);
-
-use UUIDTest;
-use UUIDTest::Setup;
-
-my $schema = UUIDTest->schema;
-my $row;
-
-
-$row = $schema->resultset('Test')->create({ });
-ok UUIDTest::is_uuid( $row->id ), 'got something that loks like a UUID from Auto';
-
-UUIDTest::Schema::Test->uuid_class('CustomUUIDMaker');
-Class::C3->reinitialize();
-$row = $schema->resultset('Test')->create({ });
-ok UUIDTest::is_uuid( $row->id ), 'got something that loks like a UUID from CustomUUIDMaker';
-
-UUIDTest::Schema::Test->uuid_class('::Data::UUID');
-Class::C3->reinitialize();
-$row = $schema->resultset('Test')->create({ });
-ok UUIDTest::is_uuid( $row->id ), 'got something that loks like a UUID from Data::UUID';
-
-1;
--- /dev/null
+#!perl -wT\r
+# $Id: basic.t 3235 2007-05-05 16:23:08Z claco $\r
+use strict;\r
+use warnings;\r
+\r
+BEGIN {\r
+ use lib 't/lib';\r
+ use DBIC::Test tests => 2;\r
+\r
+ use_ok('DBIx::Class::UUIDColumns');\r
+ use_ok('DBIx::Class::UUIDColumns::UUIDMaker');\r
+};\r
--- /dev/null
+package BadUUIDMaker;
+
+use strict;
+use warnings;
+
+sub as_string {
+ return '12345678-1234-2345-3456-123456789090';
+};
+
+1;
+__END__
\ No newline at end of file
use warnings;
use base qw/DBIx::Class::UUIDColumns::UUIDMaker/;
-use Data::UUID ();
sub as_string {
- return Data::UUID->new->to_string(Data::UUID->new->create);
+ return '12345678-1234-2345-3456-123456789090';
};
1;
--- /dev/null
+# $Id: Test.pm 3236 2007-05-05 16:24:35Z claco $\r
+package DBIC::Test;\r
+use strict;\r
+use warnings;\r
+\r
+BEGIN {\r
+ # little trick by Ovid to pretend to subclass+exporter Test::More\r
+ use base qw/Test::Builder::Module Class::Accessor::Grouped/;\r
+ use Test::More;\r
+ use File::Spec::Functions qw/catfile catdir/;\r
+\r
+ @DBIC::Test::EXPORT = @Test::More::EXPORT;\r
+\r
+ __PACKAGE__->mk_group_accessors('inherited', qw/db_dir db_file/);\r
+};\r
+\r
+__PACKAGE__->db_dir(catdir('t', 'var'));\r
+__PACKAGE__->db_file('test.db');\r
+\r
+## cribbed and modified from DBICTest in DBIx::Class tests\r
+sub init_schema {\r
+ my ($self, %args) = @_;\r
+ my $db_dir = $args{'db_dir'} || $self->db_dir;\r
+ my $db_file = $args{'db_file'} || $self->db_file;\r
+ my $namespace = $args{'namespace'} || 'DBIC::TestSchema';\r
+ my $db = catfile($db_dir, $db_file);\r
+\r
+ eval 'use DBD::SQLite';\r
+ if ($@) {\r
+ BAIL_OUT('DBD::SQLite not installed');\r
+\r
+ return;\r
+ };\r
+\r
+ eval 'use DBIC::Test::Schema';\r
+ if ($@) {\r
+ BAIL_OUT("Could not load DBIC::Test::Schema: $@");\r
+\r
+ return;\r
+ };\r
+\r
+ unlink($db) if -e $db;\r
+ unlink($db . '-journal') if -e $db . '-journal';\r
+ mkdir($db_dir) unless -d $db_dir;\r
+\r
+ my $dsn = 'dbi:SQLite:' . $db;\r
+ my $schema = DBIC::Test::Schema->compose_namespace($namespace)->connect($dsn);\r
+ $schema->storage->on_connect_do([\r
+ 'PRAGMA synchronous = OFF',\r
+ 'PRAGMA temp_store = MEMORY'\r
+ ]);\r
+\r
+ __PACKAGE__->deploy_schema($schema, %args);\r
+ __PACKAGE__->populate_schema($schema, %args) unless $args{'no_populate'};\r
+\r
+ return $schema;\r
+};\r
+\r
+sub deploy_schema {\r
+ my ($self, $schema, %options) = @_;\r
+ my $eval = $options{'eval_deploy'};\r
+\r
+ eval 'use SQL::Translator';\r
+ if (!$@ && !$options{'no_deploy'}) {\r
+ eval {\r
+ $schema->deploy();\r
+ };\r
+ if ($@ && !$eval) {\r
+ die $@;\r
+ };\r
+ } else {\r
+ open IN, catfile('t', 'sql', 'test.sqlite.sql');\r
+ my $sql;\r
+ { local $/ = undef; $sql = <IN>; }\r
+ close IN;\r
+ eval {\r
+ ($schema->storage->dbh->do($_) || print "Error on SQL: $_\n") for split(/;\n/, $sql);\r
+ };\r
+ if ($@ && !$eval) {\r
+ die $@;\r
+ };\r
+ };\r
+};\r
+\r
+sub clear_schema {\r
+ my ($self, $schema, %options) = @_;\r
+\r
+ foreach my $source ($schema->sources) {\r
+ $schema->resultset($source)->delete_all;\r
+ };\r
+};\r
+\r
+sub populate_schema {\r
+ my ($self, $schema, %options) = @_;\r
+ \r
+ if ($options{'clear'}) {\r
+ $self->clear_schema($schema, %options);\r
+ };\r
+};\r
+\r
+sub is_uuid {\r
+ my $value = defined $_[0] ? shift : '';\r
+\r
+ return ($value =~ m/ ^[0-9a-f]{8}-\r
+ [0-9a-f]{4}-\r
+ [0-9a-f]{4}-\r
+ [0-9a-f]{4}-\r
+ [0-9a-f]{12}$\r
+ /ix);\r
+};\r
+\r
+1;\r
--- /dev/null
+# $Id: Schema.pm 3236 2007-05-05 16:24:35Z claco $\r
+package DBIC::Test::Schema;\r
+use strict;\r
+use warnings;\r
+\r
+BEGIN {\r
+ use base qw/DBIx::Class::Schema/;\r
+};\r
+__PACKAGE__->load_classes;\r
+\r
+sub dsn {\r
+ return shift->storage->connect_info->[0];\r
+};\r
+\r
+1;\r
-package # hide from PAUSE
- UUIDTest::Schema::Test;
-
-use base 'DBIx::Class::Core';
-
-__PACKAGE__->load_components(qw/UUIDColumns Core/);
-__PACKAGE__->table('test');
-__PACKAGE__->add_columns(
- 'id' => {
- data_type => 'varchar',
- size => 36,
- },
-);
-__PACKAGE__->set_primary_key('id');
-__PACKAGE__->uuid_columns('id');
-
-1;
+# $Id: Test.pm 3236 2007-05-05 16:24:35Z claco $\r
+package DBIC::Test::Schema::Test;\r
+use strict;\r
+use warnings;\r
+\r
+BEGIN {\r
+ use base qw/DBIx::Class::Core/;\r
+};\r
+\r
+__PACKAGE__->load_components(qw/UUIDColumns Core/);\r
+__PACKAGE__->table('test');\r
+__PACKAGE__->add_columns(\r
+ 'id' => {\r
+ data_type => 'varchar',\r
+ size => 36,\r
+ },\r
+);\r
+__PACKAGE__->set_primary_key('id');\r
+__PACKAGE__->uuid_columns('id');\r
+\r
+1;\r
+++ /dev/null
-package # hide from PAUSE
- UUIDTest;
-
-use strict;
-use warnings;
-use UUIDTest::Schema;
-
-sub initialise {
-
- my $db_file = "t/var/UUIDTest.db";
-
- unlink($db_file) if -e $db_file;
- unlink($db_file . "-journal") if -e $db_file . "-journal";
- mkdir("t/var") unless -d "t/var";
-
- my $dsn = "dbi:SQLite:${db_file}";
-
- return UUIDTest::Schema->compose_connection('UUIDTest' => $dsn);
-}
-
-sub is_uuid {
- my $value = defined $_[0] ? shift : '';
-
- return ($value =~ m/ ^[0-9a-f]{8}-
- [0-9a-f]{4}-
- [0-9a-f]{4}-
- [0-9a-f]{4}-
- [0-9a-f]{12}$
- /ix);
-};
-
-1;
+++ /dev/null
-package # hide from PAUSE
- UUIDTest::Schema;
-
-use base qw/DBIx::Class::Schema/;
-
-no warnings qw/qw/;
-
-__PACKAGE__->load_classes(qw/ Test /);
-
-1;
+++ /dev/null
-use strict;
-use warnings;
-use UUIDTest;
-
-my $schema = UUIDTest->initialise;
-
-$schema->storage->on_connect_do([ "PRAGMA synchronous = OFF" ]);
-
-my $dbh = $schema->storage->dbh;
-
-$schema->deploy;
-
-$schema->storage->dbh->do("PRAGMA synchronous = OFF");
-
-1;
--- /dev/null
+#!perl -wT\r
+# $Id: manifest.t 3236 2007-05-05 16:24:35Z claco $\r
+use strict;\r
+use warnings;\r
+\r
+BEGIN {\r
+ use lib 't/lib';\r
+ use DBIC::Test;\r
+\r
+ plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR};\r
+\r
+ eval 'use Test::CheckManifest 0.09';\r
+ if($@) {\r
+ plan skip_all => 'Test::CheckManifest 0.09 not installed';\r
+ };\r
+};\r
+\r
+ok_manifest({\r
+ exclude => ['/t/var', '/cover_db'],\r
+ filter => [qr/\.svn/, qr/cover/, qr/Build(.(PL|bat))?/, qr/_build/],\r
+ bool => 'or'\r
+});\r
--- /dev/null
+#!perl -wT\r
+# $Id: pod_coverage.t 3236 2007-05-05 16:24:35Z claco $\r
+use strict;\r
+use warnings;\r
+\r
+BEGIN {\r
+ use lib 't/lib';\r
+ use DBIC::Test;\r
+\r
+ plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR};\r
+\r
+ eval 'use Test::Pod::Coverage 1.04';\r
+ plan skip_all => 'Test::Pod::Coverage 1.04' if $@;\r
+\r
+ eval 'use Pod::Coverage 0.14';\r
+ plan skip_all => 'Pod::Coverage 0.14 not installed' if $@;\r
+};\r
+\r
+my $trustme = {\r
+ trustme => [qr/^(g|s)et_component_class$/]\r
+};\r
+\r
+all_pod_coverage_ok($trustme);\r
--- /dev/null
+#!perl -w\r
+# $Id: pod_spelling.t 3235 2007-05-05 16:23:08Z claco $\r
+use strict;\r
+use warnings;\r
+\r
+BEGIN {\r
+ use lib 't/lib';\r
+ use DBIC::Test;\r
+\r
+ plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR};\r
+\r
+ eval 'use Test::Spelling 0.11';\r
+ plan skip_all => 'Test::Spelling 0.11 not installed' if $@;\r
+};\r
+\r
+set_spell_cmd('aspell list');\r
+\r
+add_stopwords(<DATA>);\r
+\r
+all_pod_files_spelling_ok();\r
+\r
+__DATA__\r
+uuid\r
+uuids\r
+Chia\r
+liang\r
+Kao\r
+Laco\r
+OpenBSD\r
+UUIDMaker\r
+behaviour\r
+isa\r
--- /dev/null
+#!perl -wT\r
+# $Id: pod_syntax.t 3236 2007-05-05 16:24:35Z claco $\r
+use strict;\r
+use warnings;\r
+\r
+BEGIN {\r
+ use lib 't/lib';\r
+ use DBIC::Test;\r
+\r
+ plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR};\r
+\r
+ eval 'use Test::Pod 1.00';\r
+ plan skip_all => 'Test::Pod 1.00 not installed' if $@;\r
+};\r
+\r
+all_pod_files_ok();\r
--- /dev/null
+CREATE TABLE test (\r
+ id VARVHAR(36) PRIMARY KEY NOT NULL\r
+);\r
--- /dev/null
+#!perl -wT\r
+# $Id: strict.t 3236 2007-05-05 16:24:35Z claco $\r
+use strict;\r
+use warnings;\r
+\r
+BEGIN {\r
+ use lib 't/lib';\r
+ use DBIC::Test;\r
+ use File::Find;\r
+ use File::Basename;\r
+\r
+ plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR};\r
+\r
+ eval 'use Test::Strict';\r
+ plan skip_all => 'Test::Strict not installed' if $@;\r
+ plan skip_all => 'Need untaint in newer File::Find' if $] <= 5.006;\r
+};\r
+\r
+## I hope this can go away if Test::Strict or File::Find::Rule\r
+## finally run under -T. Until then, I'm on my own here. ;-)\r
+my @files;\r
+my %trusted = (\r
+\r
+);\r
+\r
+find({ wanted => \&wanted,\r
+ untaint => 1,\r
+ untaint_pattern => qr|^([-+@\w./]+)$|,\r
+ untaint_skip => 1,\r
+ no_chdir => 1\r
+}, qw(lib t));\r
+\r
+sub wanted {\r
+ my $name = $File::Find::name;\r
+ my $file = fileparse($name);\r
+\r
+ return if $name =~ /TestApp/;\r
+\r
+ if ($name =~ /\.(pm|pl|t)$/i && !exists($trusted{$file})) {\r
+ push @files, $name;\r
+ };\r
+};\r
+\r
+if (scalar @files) {\r
+ plan tests => scalar @files;\r
+} else {\r
+ plan tests => 1;\r
+ fail 'No perl files found for Test::Strict checks!';\r
+};\r
+\r
+foreach (@files) {\r
+ strict_ok($_);\r
+};\r
--- /dev/null
+#!perl -wT\r
+# $Id: style_no_tabs.t 3236 2007-05-05 16:24:35Z claco $\r
+use strict;\r
+use warnings;\r
+\r
+BEGIN {\r
+ use lib 't/lib';\r
+ use DBIC::Test;\r
+\r
+ plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR};\r
+\r
+ eval 'use Test::NoTabs 0.03';\r
+ plan skip_all => 'Test::NoTabs 0.03 not installed' if $@;\r
+};\r
+\r
+all_perl_files_ok('lib');\r
--- /dev/null
+#!perl -wT
+# $Id: basic.t 3235 2007-05-05 16:23:08Z claco $
+use strict;
+use warnings;
+
+BEGIN {
+ use lib 't/lib';
+ use DBIC::Test tests => 13;
+};
+
+my $schema = DBIC::Test->init_schema;
+my $row;
+
+$row = $schema->resultset('Test')->create({ });
+ok DBIC::Test::is_uuid( $row->id ), 'got something that looks like a UUID from Auto';
+
+DBIC::Test::Schema::Test->uuid_class('CustomUUIDMaker');
+Class::C3->reinitialize();
+$row = $schema->resultset('Test')->create({ });
+ok DBIC::Test::is_uuid( $row->id ), 'got something that looks like a UUID from CustomUUIDMaker';
+
+is(DBIx::Class::UUIDColumns::UUIDMaker->as_string, undef);
+
+SKIP: {
+ skip 'Data::UUID not installed', 2 unless eval 'require Data::UUID';
+
+ DBIC::Test::Schema::Test->uuid_class('::Data::UUID');
+ Class::C3->reinitialize();
+ is(DBIC::Test::Schema::Test->uuid_class, 'DBIx::Class::UUIDColumns::UUIDMaker::Data::UUID');
+ $row = $schema->resultset('Test')->create({ });
+ ok DBIC::Test::is_uuid( $row->id ), 'got something that looks like a UUID from Data::UUID';
+};
+
+SKIP: {
+ skip 'Data::GUID not installed', 1 unless eval 'require Data::GUID';
+
+ DBIC::Test::Schema::Test->uuid_class('::Data::GUID');
+ Class::C3->reinitialize();
+ $row = $schema->resultset('Test')->create({ });
+ ok DBIC::Test::is_uuid( $row->id ), 'got something that looks like a UUID from Data::GUID';
+};
+
+SKIP: {
+ skip 'APR::UUID not installed', 1 unless eval 'require APR::UUID and $^O ne \'openbsd\'';
+
+ DBIC::Test::Schema::Test->uuid_class('::APR::UUID');
+ Class::C3->reinitialize();
+ $row = $schema->resultset('Test')->create({ });
+ ok DBIC::Test::is_uuid( $row->id ), 'got something that looks like a UUID from APR::UUID';
+};
+
+SKIP: {
+ skip 'UUID not installed', 1 unless eval 'require UUID';
+
+ DBIC::Test::Schema::Test->uuid_class('::UUID');
+ Class::C3->reinitialize();
+ $row = $schema->resultset('Test')->create({ });
+ ok DBIC::Test::is_uuid( $row->id ), 'got something that looks like a UUID from UUID';
+};
+
+SKIP: {
+ skip 'Win32::Guidgen not installed', 1 unless eval 'require Win32::Guidgen';
+
+ DBIC::Test::Schema::Test->uuid_class('::Win32::Guidgen');
+ Class::C3->reinitialize();
+ $row = $schema->resultset('Test')->create({ });
+ ok DBIC::Test::is_uuid( $row->id ), 'got something that looks like a UUID from Win32::Guidgen';
+};
+
+SKIP: {
+ skip 'Win32API::GUID not installed', 1 unless eval 'require Win32API::GUID';
+
+ DBIC::Test::Schema::Test->uuid_class('::Win32API::GUID');
+ Class::C3->reinitialize();
+ $row = $schema->resultset('Test')->create({ });
+ ok DBIC::Test::is_uuid( $row->id ), 'got something that looks like a UUID from Win32API::GUID';
+};
+
+SKIP: {
+ skip 'Data::Uniqid not installed', 1 unless eval 'require Data::Uniqid';
+
+ DBIC::Test::Schema::Test->uuid_class('::Data::Uniqid');
+ Class::C3->reinitialize();
+ $row = $schema->resultset('Test')->create({ });
+ ok $row->id, 'got something from Data::Uniqid';
+};
+
+eval {
+ DBIC::Test::Schema::Test->uuid_class('::JunkIDMaker');
+};
+if ($@ && $@ =~ /could not be loaded/i) {
+ pass;
+} else {
+ fail('uuid_class dies when class can not be loaded');
+};
+
+eval {
+ DBIC::Test::Schema::Test->uuid_class('BadUUIDMaker');
+};
+if ($@ && $@ =~ /is not a UUIDMaker subclass/i) {
+ pass;
+} else {
+ fail('uuid_class dies when class no isa DBIx::Class::UUIDColumns::UUIDMaker');
+};
+
+1;
--- /dev/null
+#!perl -wT\r
+# $Id: warnings.t 3236 2007-05-05 16:24:35Z claco $\r
+use strict;\r
+use warnings;\r
+\r
+BEGIN {\r
+ use lib 't/lib';\r
+ use DBIC::Test;\r
+ use File::Find;\r
+ use File::Basename;\r
+\r
+ plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR};\r
+\r
+ eval 'use Test::Strict 0.05';\r
+ plan skip_all => 'Test::Strict 0.05 not installed' if $@;\r
+ plan skip_all => 'Need untaint in newer File::Find' if $] <= 5.006;\r
+};\r
+\r
+## I hope this can go away if Test::Strict or File::Find::Rule\r
+## finally run under -T. Until then, I'm on my own here. ;-)\r
+my @files;\r
+my %trusted = (\r
+\r
+);\r
+\r
+find({ wanted => \&wanted,\r
+ untaint => 1,\r
+ untaint_pattern => qr|^([-+@\w./]+)$|,\r
+ untaint_skip => 1,\r
+ no_chdir => 1\r
+}, qw(lib t));\r
+\r
+sub wanted {\r
+ my $name = $File::Find::name;\r
+ my $file = fileparse($name);\r
+\r
+ return if $name =~ /TestApp/;\r
+\r
+ if ($name =~ /\.(pm|pl|t)$/i && !exists($trusted{$file})) {\r
+ push @files, $name;\r
+ };\r
+};\r
+\r
+if (scalar @files) {\r
+ plan tests => scalar @files;\r
+} else {\r
+ plan tests => 1;\r
+ fail 'No perl files found for Test::Strict checks!';\r
+};\r
+\r
+foreach (@files) {\r
+ warnings_ok($_);\r
+};\r
projects / dbsrgits/DBIx-Class-UUIDColumns.git / commitdiff