From: Christopher H. Laco Date: Sun, 6 May 2007 00:59:25 +0000 (+0000) Subject: Updated props X-Git-Tag: v0.01001^0 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class-UUIDColumns.git;a=commitdiff_plain;h=refs%2Ftags%2Fv0.01001 Updated props --- diff --git a/Build.PL b/Build.PL index 05e4288..e66d269 100644 --- a/Build.PL +++ b/Build.PL @@ -1,2 +1,2 @@ -# $Id: Build.PL 3236 2007-05-05 16:24:35Z claco $ -require 'Makefile.PL'; +# $Id$ +require 'Makefile.PL'; diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP index 1d46b05..c6fceaa 100644 --- a/MANIFEST.SKIP +++ b/MANIFEST.SKIP @@ -1,17 +1,17 @@ -\bRCS\b -\bCVS\b -,v$ -\B\.svn\b -t/var -^blib/ -^pm_to_blib -^MakeMaker-\d -Makefile$ -Makefile.old$ -Build.PL -Build.bat -\.db -t/TEST$ -t/SMOKE$ -^blibdirs\.ts +\bRCS\b +\bCVS\b +,v$ +\B\.svn\b +t/var +^blib/ +^pm_to_blib +^MakeMaker-\d +Makefile$ +Makefile.old$ +Build.PL +Build.bat +\.db +t/TEST$ +t/SMOKE$ +^blibdirs\.ts \.gz \ No newline at end of file diff --git a/Makefile.PL b/Makefile.PL index cfc559d..e03aaa2 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -1,41 +1,41 @@ -# $Id: Makefile.PL 3236 2007-05-05 16:24:35Z claco $ -use strict; -use warnings; -use inc::Module::Install 0.65; - -name 'DBIx-Class-UUIDColumns'; -license 'perl'; -perl_version '5.008001'; -all_from 'lib/DBIx/Class/UUIDColumns.pm'; - -requires 'DBIx::Class' => '0.07005'; - -if ( - !eval 'require Data::UUID' && - !eval 'require ARE::UUID' && - !eval 'require UUID' && - !eval 'require Win32::Guidgen' && - !eval 'require Win32API::GUID' && - !eval 'require Data::Uniqid' - ) { - requires 'Data::UUID'; -}; - -build_requires 'DBD::SQLite' => '1.11'; - -recommends 'Data::UUID'; -recommends 'Data::Uniqid'; -recommends 'APR::UUID'; -recommends 'UUID'; -recommends 'Win32::Guidgen'; -recommends 'Win32API::GUID'; - -tests "t/*.t t/*/*.t"; -clean_files "DBIx-Class-UUIDColumns-* t/var"; - -eval { - system 'pod2text lib/DBIx/Class/UUIDColumns.pm > README'; -}; - -auto_install; -WriteAll; +# $Id$ +use strict; +use warnings; +use inc::Module::Install 0.65; + +name 'DBIx-Class-UUIDColumns'; +license 'perl'; +perl_version '5.008001'; +all_from 'lib/DBIx/Class/UUIDColumns.pm'; + +requires 'DBIx::Class' => '0.07005'; + +if ( + !eval 'require Data::UUID' && + !eval 'require ARE::UUID' && + !eval 'require UUID' && + !eval 'require Win32::Guidgen' && + !eval 'require Win32API::GUID' && + !eval 'require Data::Uniqid' + ) { + requires 'Data::UUID'; +}; + +build_requires 'DBD::SQLite' => '1.11'; + +recommends 'Data::UUID'; +recommends 'Data::Uniqid'; +recommends 'APR::UUID'; +recommends 'UUID'; +recommends 'Win32::Guidgen'; +recommends 'Win32API::GUID'; + +tests "t/*.t t/*/*.t"; +clean_files "DBIx-Class-UUIDColumns-* t/var"; + +eval { + system 'pod2text lib/DBIx/Class/UUIDColumns.pm > README'; +}; + +auto_install; +WriteAll; diff --git a/README b/README index 292a405..80aacf0 100644 --- a/README +++ b/README @@ -1,79 +1,79 @@ -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" checks to see that the specified class isa - DBIx::Class::UUIDColumns::UUIDMaker subclass 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 - -CONTRIBUTERS - Chris Laco - -LICENSE - You may distribute this code under the same terms as Perl itself. - +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" checks to see that the specified class isa + DBIx::Class::UUIDColumns::UUIDMaker subclass 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 + +CONTRIBUTERS + Chris Laco + +LICENSE + You may distribute this code under the same terms as Perl itself. + diff --git a/t/basic.t b/t/basic.t index 6a3b646..e415094 100644 --- a/t/basic.t +++ b/t/basic.t @@ -1,12 +1,12 @@ -#!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 => 2; - - use_ok('DBIx::Class::UUIDColumns'); - use_ok('DBIx::Class::UUIDColumns::UUIDMaker'); -}; +#!perl -wT +# $Id$ +use strict; +use warnings; + +BEGIN { + use lib 't/lib'; + use DBIC::Test tests => 2; + + use_ok('DBIx::Class::UUIDColumns'); + use_ok('DBIx::Class::UUIDColumns::UUIDMaker'); +}; diff --git a/t/lib/DBIC/Test.pm b/t/lib/DBIC/Test.pm index 6f254a3..e34e705 100644 --- a/t/lib/DBIC/Test.pm +++ b/t/lib/DBIC/Test.pm @@ -1,112 +1,112 @@ -# $Id: Test.pm 3236 2007-05-05 16:24:35Z claco $ -package DBIC::Test; -use strict; -use warnings; - -BEGIN { - # little trick by Ovid to pretend to subclass+exporter Test::More - use base qw/Test::Builder::Module Class::Accessor::Grouped/; - use Test::More; - use File::Spec::Functions qw/catfile catdir/; - - @DBIC::Test::EXPORT = @Test::More::EXPORT; - - __PACKAGE__->mk_group_accessors('inherited', qw/db_dir db_file/); -}; - -__PACKAGE__->db_dir(catdir('t', 'var')); -__PACKAGE__->db_file('test.db'); - -## cribbed and modified from DBICTest in DBIx::Class tests -sub init_schema { - my ($self, %args) = @_; - my $db_dir = $args{'db_dir'} || $self->db_dir; - my $db_file = $args{'db_file'} || $self->db_file; - my $namespace = $args{'namespace'} || 'DBIC::TestSchema'; - my $db = catfile($db_dir, $db_file); - - eval 'use DBD::SQLite'; - if ($@) { - BAIL_OUT('DBD::SQLite not installed'); - - return; - }; - - eval 'use DBIC::Test::Schema'; - if ($@) { - BAIL_OUT("Could not load DBIC::Test::Schema: $@"); - - return; - }; - - unlink($db) if -e $db; - unlink($db . '-journal') if -e $db . '-journal'; - mkdir($db_dir) unless -d $db_dir; - - my $dsn = 'dbi:SQLite:' . $db; - my $schema = DBIC::Test::Schema->compose_namespace($namespace)->connect($dsn); - $schema->storage->on_connect_do([ - 'PRAGMA synchronous = OFF', - 'PRAGMA temp_store = MEMORY' - ]); - - __PACKAGE__->deploy_schema($schema, %args); - __PACKAGE__->populate_schema($schema, %args) unless $args{'no_populate'}; - - return $schema; -}; - -sub deploy_schema { - my ($self, $schema, %options) = @_; - my $eval = $options{'eval_deploy'}; - - eval 'use SQL::Translator'; - if (!$@ && !$options{'no_deploy'}) { - eval { - $schema->deploy(); - }; - if ($@ && !$eval) { - die $@; - }; - } else { - open IN, catfile('t', 'sql', 'test.sqlite.sql'); - my $sql; - { local $/ = undef; $sql = ; } - close IN; - eval { - ($schema->storage->dbh->do($_) || print "Error on SQL: $_\n") for split(/;\n/, $sql); - }; - if ($@ && !$eval) { - die $@; - }; - }; -}; - -sub clear_schema { - my ($self, $schema, %options) = @_; - - foreach my $source ($schema->sources) { - $schema->resultset($source)->delete_all; - }; -}; - -sub populate_schema { - my ($self, $schema, %options) = @_; - - if ($options{'clear'}) { - $self->clear_schema($schema, %options); - }; -}; - -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; +# $Id$ +package DBIC::Test; +use strict; +use warnings; + +BEGIN { + # little trick by Ovid to pretend to subclass+exporter Test::More + use base qw/Test::Builder::Module Class::Accessor::Grouped/; + use Test::More; + use File::Spec::Functions qw/catfile catdir/; + + @DBIC::Test::EXPORT = @Test::More::EXPORT; + + __PACKAGE__->mk_group_accessors('inherited', qw/db_dir db_file/); +}; + +__PACKAGE__->db_dir(catdir('t', 'var')); +__PACKAGE__->db_file('test.db'); + +## cribbed and modified from DBICTest in DBIx::Class tests +sub init_schema { + my ($self, %args) = @_; + my $db_dir = $args{'db_dir'} || $self->db_dir; + my $db_file = $args{'db_file'} || $self->db_file; + my $namespace = $args{'namespace'} || 'DBIC::TestSchema'; + my $db = catfile($db_dir, $db_file); + + eval 'use DBD::SQLite'; + if ($@) { + BAIL_OUT('DBD::SQLite not installed'); + + return; + }; + + eval 'use DBIC::Test::Schema'; + if ($@) { + BAIL_OUT("Could not load DBIC::Test::Schema: $@"); + + return; + }; + + unlink($db) if -e $db; + unlink($db . '-journal') if -e $db . '-journal'; + mkdir($db_dir) unless -d $db_dir; + + my $dsn = 'dbi:SQLite:' . $db; + my $schema = DBIC::Test::Schema->compose_namespace($namespace)->connect($dsn); + $schema->storage->on_connect_do([ + 'PRAGMA synchronous = OFF', + 'PRAGMA temp_store = MEMORY' + ]); + + __PACKAGE__->deploy_schema($schema, %args); + __PACKAGE__->populate_schema($schema, %args) unless $args{'no_populate'}; + + return $schema; +}; + +sub deploy_schema { + my ($self, $schema, %options) = @_; + my $eval = $options{'eval_deploy'}; + + eval 'use SQL::Translator'; + if (!$@ && !$options{'no_deploy'}) { + eval { + $schema->deploy(); + }; + if ($@ && !$eval) { + die $@; + }; + } else { + open IN, catfile('t', 'sql', 'test.sqlite.sql'); + my $sql; + { local $/ = undef; $sql = ; } + close IN; + eval { + ($schema->storage->dbh->do($_) || print "Error on SQL: $_\n") for split(/;\n/, $sql); + }; + if ($@ && !$eval) { + die $@; + }; + }; +}; + +sub clear_schema { + my ($self, $schema, %options) = @_; + + foreach my $source ($schema->sources) { + $schema->resultset($source)->delete_all; + }; +}; + +sub populate_schema { + my ($self, $schema, %options) = @_; + + if ($options{'clear'}) { + $self->clear_schema($schema, %options); + }; +}; + +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; diff --git a/t/lib/DBIC/Test/Schema.pm b/t/lib/DBIC/Test/Schema.pm index 94f2362..2035e88 100644 --- a/t/lib/DBIC/Test/Schema.pm +++ b/t/lib/DBIC/Test/Schema.pm @@ -1,15 +1,15 @@ -# $Id: Schema.pm 3236 2007-05-05 16:24:35Z claco $ -package DBIC::Test::Schema; -use strict; -use warnings; - -BEGIN { - use base qw/DBIx::Class::Schema/; -}; -__PACKAGE__->load_classes; - -sub dsn { - return shift->storage->connect_info->[0]; -}; - -1; +# $Id$ +package DBIC::Test::Schema; +use strict; +use warnings; + +BEGIN { + use base qw/DBIx::Class::Schema/; +}; +__PACKAGE__->load_classes; + +sub dsn { + return shift->storage->connect_info->[0]; +}; + +1; diff --git a/t/lib/DBIC/Test/Schema/Test.pm b/t/lib/DBIC/Test/Schema/Test.pm index 798d91c..229958a 100644 --- a/t/lib/DBIC/Test/Schema/Test.pm +++ b/t/lib/DBIC/Test/Schema/Test.pm @@ -1,21 +1,21 @@ -# $Id: Test.pm 3236 2007-05-05 16:24:35Z claco $ -package DBIC::Test::Schema::Test; -use strict; -use warnings; - -BEGIN { - use base qw/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$ +package DBIC::Test::Schema::Test; +use strict; +use warnings; + +BEGIN { + use base qw/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; diff --git a/t/manifest.t b/t/manifest.t index 5a6206f..8367a8b 100644 --- a/t/manifest.t +++ b/t/manifest.t @@ -1,22 +1,22 @@ -#!perl -wT -# $Id: manifest.t 3236 2007-05-05 16:24:35Z claco $ -use strict; -use warnings; - -BEGIN { - use lib 't/lib'; - use DBIC::Test; - - plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR}; - - eval 'use Test::CheckManifest 0.09'; - if($@) { - plan skip_all => 'Test::CheckManifest 0.09 not installed'; - }; -}; - -ok_manifest({ - exclude => ['/t/var', '/cover_db'], - filter => [qr/\.svn/, qr/cover/, qr/Build(.(PL|bat))?/, qr/_build/], - bool => 'or' -}); +#!perl -wT +# $Id$ +use strict; +use warnings; + +BEGIN { + use lib 't/lib'; + use DBIC::Test; + + plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR}; + + eval 'use Test::CheckManifest 0.09'; + if($@) { + plan skip_all => 'Test::CheckManifest 0.09 not installed'; + }; +}; + +ok_manifest({ + exclude => ['/t/var', '/cover_db'], + filter => [qr/\.svn/, qr/cover/, qr/Build(.(PL|bat))?/, qr/_build/], + bool => 'or' +}); diff --git a/t/pod_coverage.t b/t/pod_coverage.t index c5aad16..c77d2af 100644 --- a/t/pod_coverage.t +++ b/t/pod_coverage.t @@ -1,23 +1,23 @@ -#!perl -wT -# $Id: pod_coverage.t 3236 2007-05-05 16:24:35Z claco $ -use strict; -use warnings; - -BEGIN { - use lib 't/lib'; - use DBIC::Test; - - plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR}; - - eval 'use Test::Pod::Coverage 1.04'; - plan skip_all => 'Test::Pod::Coverage 1.04' if $@; - - eval 'use Pod::Coverage 0.14'; - plan skip_all => 'Pod::Coverage 0.14 not installed' if $@; -}; - -my $trustme = { - trustme => [qr/^(g|s)et_component_class$/] -}; - -all_pod_coverage_ok($trustme); +#!perl -wT +# $Id$ +use strict; +use warnings; + +BEGIN { + use lib 't/lib'; + use DBIC::Test; + + plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR}; + + eval 'use Test::Pod::Coverage 1.04'; + plan skip_all => 'Test::Pod::Coverage 1.04' if $@; + + eval 'use Pod::Coverage 0.14'; + plan skip_all => 'Pod::Coverage 0.14 not installed' if $@; +}; + +my $trustme = { + trustme => [qr/^(g|s)et_component_class$/] +}; + +all_pod_coverage_ok($trustme); diff --git a/t/pod_spelling.t b/t/pod_spelling.t index ae4f8c4..acbacdb 100644 --- a/t/pod_spelling.t +++ b/t/pod_spelling.t @@ -1,32 +1,32 @@ -#!perl -w -# $Id: pod_spelling.t 3235 2007-05-05 16:23:08Z claco $ -use strict; -use warnings; - -BEGIN { - use lib 't/lib'; - use DBIC::Test; - - plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR}; - - eval 'use Test::Spelling 0.11'; - plan skip_all => 'Test::Spelling 0.11 not installed' if $@; -}; - -set_spell_cmd('aspell list'); - -add_stopwords(); - -all_pod_files_spelling_ok(); - -__DATA__ -uuid -uuids -Chia -liang -Kao -Laco -OpenBSD -UUIDMaker -behaviour -isa +#!perl -w +# $Id$ +use strict; +use warnings; + +BEGIN { + use lib 't/lib'; + use DBIC::Test; + + plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR}; + + eval 'use Test::Spelling 0.11'; + plan skip_all => 'Test::Spelling 0.11 not installed' if $@; +}; + +set_spell_cmd('aspell list'); + +add_stopwords(); + +all_pod_files_spelling_ok(); + +__DATA__ +uuid +uuids +Chia +liang +Kao +Laco +OpenBSD +UUIDMaker +behaviour +isa diff --git a/t/pod_syntax.t b/t/pod_syntax.t index 63c0224..80d4611 100644 --- a/t/pod_syntax.t +++ b/t/pod_syntax.t @@ -1,16 +1,16 @@ -#!perl -wT -# $Id: pod_syntax.t 3236 2007-05-05 16:24:35Z claco $ -use strict; -use warnings; - -BEGIN { - use lib 't/lib'; - use DBIC::Test; - - plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR}; - - eval 'use Test::Pod 1.00'; - plan skip_all => 'Test::Pod 1.00 not installed' if $@; -}; - -all_pod_files_ok(); +#!perl -wT +# $Id$ +use strict; +use warnings; + +BEGIN { + use lib 't/lib'; + use DBIC::Test; + + plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR}; + + eval 'use Test::Pod 1.00'; + plan skip_all => 'Test::Pod 1.00 not installed' if $@; +}; + +all_pod_files_ok(); diff --git a/t/sql/test.sqlite.sql b/t/sql/test.sqlite.sql index eff88cb..c43825d 100644 --- a/t/sql/test.sqlite.sql +++ b/t/sql/test.sqlite.sql @@ -1,3 +1,3 @@ -CREATE TABLE test ( - id VARVHAR(36) PRIMARY KEY NOT NULL -); +CREATE TABLE test ( + id VARVHAR(36) PRIMARY KEY NOT NULL +); diff --git a/t/strict.t b/t/strict.t index 9524740..48cbe3f 100644 --- a/t/strict.t +++ b/t/strict.t @@ -1,53 +1,53 @@ -#!perl -wT -# $Id: strict.t 3236 2007-05-05 16:24:35Z claco $ -use strict; -use warnings; - -BEGIN { - use lib 't/lib'; - use DBIC::Test; - use File::Find; - use File::Basename; - - plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR}; - - eval 'use Test::Strict'; - plan skip_all => 'Test::Strict not installed' if $@; - plan skip_all => 'Need untaint in newer File::Find' if $] <= 5.006; -}; - -## I hope this can go away if Test::Strict or File::Find::Rule -## finally run under -T. Until then, I'm on my own here. ;-) -my @files; -my %trusted = ( - -); - -find({ wanted => \&wanted, - untaint => 1, - untaint_pattern => qr|^([-+@\w./]+)$|, - untaint_skip => 1, - no_chdir => 1 -}, qw(lib t)); - -sub wanted { - my $name = $File::Find::name; - my $file = fileparse($name); - - return if $name =~ /TestApp/; - - if ($name =~ /\.(pm|pl|t)$/i && !exists($trusted{$file})) { - push @files, $name; - }; -}; - -if (scalar @files) { - plan tests => scalar @files; -} else { - plan tests => 1; - fail 'No perl files found for Test::Strict checks!'; -}; - -foreach (@files) { - strict_ok($_); -}; +#!perl -wT +# $Id$ +use strict; +use warnings; + +BEGIN { + use lib 't/lib'; + use DBIC::Test; + use File::Find; + use File::Basename; + + plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR}; + + eval 'use Test::Strict'; + plan skip_all => 'Test::Strict not installed' if $@; + plan skip_all => 'Need untaint in newer File::Find' if $] <= 5.006; +}; + +## I hope this can go away if Test::Strict or File::Find::Rule +## finally run under -T. Until then, I'm on my own here. ;-) +my @files; +my %trusted = ( + +); + +find({ wanted => \&wanted, + untaint => 1, + untaint_pattern => qr|^([-+@\w./]+)$|, + untaint_skip => 1, + no_chdir => 1 +}, qw(lib t)); + +sub wanted { + my $name = $File::Find::name; + my $file = fileparse($name); + + return if $name =~ /TestApp/; + + if ($name =~ /\.(pm|pl|t)$/i && !exists($trusted{$file})) { + push @files, $name; + }; +}; + +if (scalar @files) { + plan tests => scalar @files; +} else { + plan tests => 1; + fail 'No perl files found for Test::Strict checks!'; +}; + +foreach (@files) { + strict_ok($_); +}; diff --git a/t/style_no_tabs.t b/t/style_no_tabs.t index 406ad00..3327a8d 100644 --- a/t/style_no_tabs.t +++ b/t/style_no_tabs.t @@ -1,16 +1,16 @@ -#!perl -wT -# $Id: style_no_tabs.t 3236 2007-05-05 16:24:35Z claco $ -use strict; -use warnings; - -BEGIN { - use lib 't/lib'; - use DBIC::Test; - - plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR}; - - eval 'use Test::NoTabs 0.03'; - plan skip_all => 'Test::NoTabs 0.03 not installed' if $@; -}; - -all_perl_files_ok('lib'); +#!perl -wT +# $Id$ +use strict; +use warnings; + +BEGIN { + use lib 't/lib'; + use DBIC::Test; + + plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR}; + + eval 'use Test::NoTabs 0.03'; + plan skip_all => 'Test::NoTabs 0.03 not installed' if $@; +}; + +all_perl_files_ok('lib'); diff --git a/t/uuid.t b/t/uuid.t index e28ad8c..9a58c15 100644 --- a/t/uuid.t +++ b/t/uuid.t @@ -1,5 +1,5 @@ #!perl -wT -# $Id: basic.t 3235 2007-05-05 16:23:08Z claco $ +# $Id$ use strict; use warnings; diff --git a/t/warnings.t b/t/warnings.t index 8f0eb31..355f8ea 100644 --- a/t/warnings.t +++ b/t/warnings.t @@ -1,53 +1,53 @@ -#!perl -wT -# $Id: warnings.t 3236 2007-05-05 16:24:35Z claco $ -use strict; -use warnings; - -BEGIN { - use lib 't/lib'; - use DBIC::Test; - use File::Find; - use File::Basename; - - plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR}; - - eval 'use Test::Strict 0.05'; - plan skip_all => 'Test::Strict 0.05 not installed' if $@; - plan skip_all => 'Need untaint in newer File::Find' if $] <= 5.006; -}; - -## I hope this can go away if Test::Strict or File::Find::Rule -## finally run under -T. Until then, I'm on my own here. ;-) -my @files; -my %trusted = ( - -); - -find({ wanted => \&wanted, - untaint => 1, - untaint_pattern => qr|^([-+@\w./]+)$|, - untaint_skip => 1, - no_chdir => 1 -}, qw(lib t)); - -sub wanted { - my $name = $File::Find::name; - my $file = fileparse($name); - - return if $name =~ /TestApp/; - - if ($name =~ /\.(pm|pl|t)$/i && !exists($trusted{$file})) { - push @files, $name; - }; -}; - -if (scalar @files) { - plan tests => scalar @files; -} else { - plan tests => 1; - fail 'No perl files found for Test::Strict checks!'; -}; - -foreach (@files) { - warnings_ok($_); -}; +#!perl -wT +# $Id$ +use strict; +use warnings; + +BEGIN { + use lib 't/lib'; + use DBIC::Test; + use File::Find; + use File::Basename; + + plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR}; + + eval 'use Test::Strict 0.05'; + plan skip_all => 'Test::Strict 0.05 not installed' if $@; + plan skip_all => 'Need untaint in newer File::Find' if $] <= 5.006; +}; + +## I hope this can go away if Test::Strict or File::Find::Rule +## finally run under -T. Until then, I'm on my own here. ;-) +my @files; +my %trusted = ( + +); + +find({ wanted => \&wanted, + untaint => 1, + untaint_pattern => qr|^([-+@\w./]+)$|, + untaint_skip => 1, + no_chdir => 1 +}, qw(lib t)); + +sub wanted { + my $name = $File::Find::name; + my $file = fileparse($name); + + return if $name =~ /TestApp/; + + if ($name =~ /\.(pm|pl|t)$/i && !exists($trusted{$file})) { + push @files, $name; + }; +}; + +if (scalar @files) { + plan tests => scalar @files; +} else { + plan tests => 1; + fail 'No perl files found for Test::Strict checks!'; +}; + +foreach (@files) { + warnings_ok($_); +};