X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FDeploymentHandler%2FDeployMethod%2FSQL%2FTranslator.pm;h=84340c5b06ab6999aace06daea62a58eabf8a6a0;hb=4f85efc6aee3c4bbb15b6bd3e6d44837fa97f360;hp=996a58b11564bd3b997ecc5b5b60a55b7a2055b0;hpb=fc4b7602052e267368ca63a07f882be01a2ba8a7;p=dbsrgits%2FDBIx-Class-DeploymentHandler.git diff --git a/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm index 996a58b..84340c5 100644 --- a/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm +++ b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm @@ -170,19 +170,18 @@ method _run_sql_and_perl($filenames) { $storage->_query_end($line); } } elsif ( $filename =~ /^(.+)\.pl$/ ) { - my $package = $1; my $filedata = do { local( @ARGV, $/ ) = $filename; <> }; - # make the package name more palateable to perl - $package =~ s/\W/_/g; no warnings 'redefine'; - eval "package $package;\n\n$filedata"; + my $fn = eval "$filedata"; use warnings; - if (my $fn = $package->can('run')) { - $fn->($self->schema); + if ($@) { + carp "$filename failed to compile: $@"; + } elsif (ref $fn eq 'CODE') { + $fn->($self->schema) } else { - carp "$filename should define a run method that takes a schema but it didn't!"; + carp "$filename should define an anonymouse sub that takes a schema but it didn't!"; } } else { croak "A file ($filename) got to deploy that wasn't sql or perl!"; @@ -216,18 +215,18 @@ sub preinstall_scripts { for my $filename (@files) { # We ignore sql for now (till I figure out what to do with it) if ( $filename =~ /^(.+)\.pl$/ ) { - my $package = $1; my $filedata = do { local( @ARGV, $/ ) = $filename; <> }; - # make the package name more palateable to perl - $package =~ s/\W/_/g; - no warnings 'redefine'; - eval "package $package;\n\n$filedata"; + no warnings 'redefine'; + my $fn = eval "$filedata"; use warnings; - if (my $fn = $package->can('run')) { + + if ($@) { + carp "$filename failed to compile: $@"; + } elsif (ref $fn eq 'CODE') { $fn->() } else { - carp "$filename should define a run sub but it didn't!"; + carp "$filename should define an anonymous sub but it didn't!"; } } else { croak "A file ($filename) got to preinstall_scripts that wasn't sql or perl!"; @@ -494,7 +493,7 @@ like the best way to describe the layout is with the following example: $sql_migration_dir |- SQLite | |- down - | | `- 1-2 + | | `- 2-1 | | `- 001-auto.sql | |- schema | | `- 1 @@ -506,14 +505,14 @@ like the best way to describe the layout is with the following example: | `- 001-auto.sql |- _common | |- down - | | `- 1-2 + | | `- 2-1 | | `- 002-remove-customers.pl | `- up | `- 1-2 | `- 002-generate-customers.pl |- _generic | |- down - | | `- 1-2 + | | `- 2-1 | | `- 001-auto.sql | |- schema | | `- 1 @@ -524,7 +523,7 @@ like the best way to describe the layout is with the following example: | `- 002-create-stored-procedures.sql `- MySQL |- down - | `- 1-2 + | `- 2-1 | `- 001-auto.sql |- schema | `- 1 @@ -554,8 +553,8 @@ generic enough to run on all databases. Good luck with that one. =head1 PERL SCRIPTS -A perl script for this tool is very simple. It merely needs to contain a -sub called C that takes a L as it's only argument. +A perl script for this tool is very simple. It merely needs to contain an +anonymous sub that takes a L as it's only argument. A very basic perl script might look like: #!perl @@ -563,7 +562,7 @@ A very basic perl script might look like: use strict; use warnings; - sub run { + sub { my $schema = shift; $schema->resultset('Users')->create({