X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FDeploymentHandler%2FDeployMethod%2FSQL%2FTranslator.pm;fp=lib%2FDBIx%2FClass%2FDeploymentHandler%2FDeployMethod%2FSQL%2FTranslator.pm;h=d1385eea62a173e094065c7909a4097230451880;hb=a89cd737a24077f9d021d975a8ee628dc23bfb06;hp=e34a6b84aa5437df93a57c5b80dbc18f4299c297;hpb=7c78f0972c8d306eb6d61e8b3941b5b4d6297b96;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 e34a6b8..d1385ee 100644
--- a/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
+++ b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
@@ -290,19 +290,35 @@ sub _run_sql {
   return $self->_run_sql_array($self->_read_sql_file($filename));
 }
 
+# stolen from Plack::Util::_load_sandbox
+sub _load_sandbox {
+  my $_file = shift;
+
+  my $_package = $_file;
+  $_package =~ s/([^A-Za-z0-9_])/sprintf("_%2x", unpack("C", $1))/eg;
+
+  local $0 = $_file; # so FindBin etc. works
+
+  return eval sprintf <<'END_EVAL', $_package;
+package DBICDH::Sandbox::%s;
+{
+  my $app = do $_file;
+  if ( !$app && ( my $error = $@ || $! )) { die $error; }
+  $app;
+}
+END_EVAL
+}
+
 sub _run_perl {
   my ($self, $filename, $versions) = @_;
   log_debug { "Running Perl from $filename" };
   my $filedata = do { local( @ARGV, $/ ) = $filename; <> };
 
-  no warnings 'redefine';
-  my $fn = eval "$filedata";
-  use warnings;
+  my $fn = _load_sandbox($filename);
+
   Dlog_trace { "Running Perl $_" } $fn;
 
-  if ($@) {
-    croak "$filename failed to compile: $@";
-  } elsif (ref $fn eq 'CODE') {
+  if (ref $fn eq 'CODE') {
     $fn->($self->schema, $versions)
   } else {
     croak "$filename should define an anonymouse sub that takes a schema but it didn't!";