frioux / DBIx-Class-DeploymentHandler

https://metacpan.org/pod/DBIx::Class::DeploymentHandler
21 stars 26 forks source link

"Identifier too long" for deployment scripts with long paths. #55

Closed andrewgregory closed 7 years ago

andrewgregory commented 7 years ago

_load_sandbox dynamically creates a package to run a perl script, naming it after the full path of the script. Paths can easily exceed perl's limitation on identifier names, resulting in the Identifier too long error.

frioux commented 7 years ago

Interesting bug! I guess we could hash the path and and append an incrementing number or something if the generated package already exists.

andrewgregory commented 7 years ago

It looks like the constructed package is intended to only require the script once even if it's run multiple times. Checking for an existing package would break that. What exactly is the intent behind loading the script into a dynamic package?

frioux commented 7 years ago

Well if someone were to write:

my $foo = 0;
sub {
   $foo++;
    warn "This script has run $foo times\n";
    ...
};

That variable needs to be installed somewhere. FWIW the code was originally cargo culted from Plack, so I'm a little surprised that there is such a systemic problem. Honestly though I suspect it'll be pretty easy to fix.

frioux commented 7 years ago

Idea for solution: https://metacpan.org/source/RIBASUSHI/DBIx-Class-0.082840/lib/DBIx/Class/SQLMaker/Oracle.pm#L123-196, https://metacpan.org/source/RIBASUSHI/DBIx-Class-0.082840/t/sqlmaker/oracle.t#L78-112

andrewgregory commented 7 years ago

I haven't tested it, but is something like this what you're thinking?

.../DeployMethod/SQL/Translator.pm                 | 29 +++++++++++++++++++---
 1 file changed, 26 insertions(+), 3 deletions(-)

diff --git a/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
index 8fd9708..c74dceb 100644
--- a/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
+++ b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
@@ -8,6 +8,7 @@ use autodie;
 use Carp qw( carp croak );
 use DBIx::Class::DeploymentHandler::LogImporter qw(:log :dlog);
 use Context::Preserve;
+use Digest::MD5;

 use Try::Tiny;

@@ -281,15 +282,37 @@ sub _run_sql {
   };
 }

+sub _generate_script_package_name {
+    my $file = shift;
+
+    state $f2p = {};
+    state $p2f = {};
+
+    my $maxlen = 200;    # actual limit is "about 250" according to perldiag
+    my $pkgbase = 'DBICDH::Sandbox::';
+
+    return $f2p->{"$file"} if $f2p->{"$file"};
+
+    my $package = md5_hex("$file");
+    $package++ while exists $p2f->{$package}; # increment until unique
+
+    $f2p->{"$file"} = $package;
+    $p2f->{$package} = "$file";
+
+    die "unable to generate a unique short name for '$file'"
+      if length($pkgbase) + length($package) > $maxlen;
+
+    return $pkgbase . $package;
+}
+
 sub _load_sandbox {
   my $_file = shift;
   $_file = "$_file";

-  my $_package = $_file;
-  $_package =~ s/([^A-Za-z0-9_])/sprintf("_%2x", ord($1))/eg;
+  my $_package = _generate_script_package_name($_file);

   my $fn = eval sprintf <<'END_EVAL', $_package;
-package DBICDH::Sandbox::%s;
+package %s;
 {
   our $app;
   $app ||= require $_file;
frioux commented 7 years ago

Yeah; that's the idea for sure. The state variables make me a little nervous, since querying the globs directly would be more bulletproof, but if this passes test and fixes your problem I am willing to let it slide.

andrewgregory commented 7 years ago

I'm not sure what you mean. If you want the example you posted earlier to work, we have to cache the resulting package name somewhere so that we can reuse it for subsequent runs don't we? Otherwise if the same file gets run again it would be put into a different package, because when we go to run it a second time, the first package name used would obviously already exist. We could potentially use something other than the $p2f cache to check if newly generated package names are unique, but I'm not sure what the right way to do that would be.

frioux commented 7 years ago

Check out https://metacpan.org/pod/Package::Stash. It lets you ask Perl directly if a given package exists. You could store inside the package itself a symbol (like, our $FROM or something) of the full script name. But honestly, if that sounds like too much work to you I am happy to go forward with your existing proposal.