From: Arthur Axel 'fREW' Schmidt Date: Sat, 8 May 2010 18:18:45 +0000 (-0500) Subject: use coderef instead of run method X-Git-Tag: v0.001000_09~19 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class-DeploymentHandler.git;a=commitdiff_plain;h=5b5defbc43cfd7be49717c832afaec0bb6bc6544 use coderef instead of run method --- diff --git a/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm index e64dd2c..7adfa61 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,20 +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 ($@) { carp "$filename failed to compile: $@"; - } elsif (my $fn = $package->can('run')) { + } 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!"; diff --git a/t/deploy_methods/sql_translator.t b/t/deploy_methods/sql_translator.t index 2d5607d..ad95bab 100644 --- a/t/deploy_methods/sql_translator.t +++ b/t/deploy_methods/sql_translator.t @@ -32,7 +32,7 @@ VERSION1: { mkpath(catfile(qw( t sql SQLite preinstall 1.0 ))); open my $prerun, '>', catfile(qw( t sql SQLite preinstall 1.0 003-semiautomatic.pl )); - print {$prerun} "sub run {use File::Touch; touch(q(foobar));}"; + print {$prerun} "sub {use File::Touch; touch(q(foobar));}"; close $prerun; $dm->preinstall_scripts('1.0'); @@ -140,7 +140,7 @@ VERSION2: { open my $common_pl, '>', catfile(qw( t sql _common up 1.0-2.0 003-semiautomatic.pl )); print {$common_pl} q| - sub run { + sub { my $schema = shift; $schema->resultset('Foo')->create({ bar => 'goodbye',