为什么我在mod_perl下使用“use constant”获得“重新定义”警告？(Why do I get “redefine” warnings with “use constant” under mod_perl?)
我用apache2运行CGI脚本，我在error.log中有这个警告行（ 我从输出中删除了所有类似的行 ）：
为什么这条线路存在并且有办法阻止它们？
发出此警告的代码（取自“使用Perl进行CGI编程”一书，修复了一些错误）：
#!/usr/bin/perl use strict; use warnings; use CGI; use CGI::Carp; #use diagnostics qw/-verbose/; use Fcntl qw( :DEFAULT :flock ); use constant UPLOAD_DIR => "/tmp/test_upload/"; use constant BUFFER_SIZE => 16_384; use constant MAX_FILE_SIZE => 1_048_576; # Limit each upload to 1 MB use constant MAX_DIR_SIZE => 100 * 1_048_576; # Limit total uploads to 100 MB use constant MAX_OPEN_TRIES => 100; $CGI::DISABLE_UPLOADS = 0; $CGI::POST_MAX = MAX_FILE_SIZE; my $q = new CGI; $q->cgi_error and error( $q, "Error transferring file: " . $q->cgi_error ); my $file = $q->param( "file" ) || error( $q, "No file received." ); my $filename = $q->param( "filename" ) || error( $q, "No filename entered." ); my $fh = $q->upload( "file" ) || error( $q, "Something is wrong with file handle." ); #my $fh = $q->upload( $file ); my $buffer = ""; if ( dir_size( UPLOAD_DIR ) + $ENV{CONTENT_LENGTH} > MAX_DIR_SIZE ) { error( $q, "Upload directory is full." ); } # Allow letters, digits, periods, underscores, dashes # Convert anything else to an underscore $filename =~ s/[^\w.-]/_/g; if ( $filename =~ /^(\w[\w.-]*)/ ) { $filename = $1; } else { error( $q, "Invalid file name; files must start with a letter or number." ); } # Open output file, making sure the name is unique until ( sysopen OUTPUT, UPLOAD_DIR . $filename, O_CREAT | O_EXCL ) { $filename =~ s/(\d*)(\.\w+)$/($1||0) + 1 . $2/e; $1 >= MAX_OPEN_TRIES and error( $q, "Unable to save your file." ); } # This is necessary for non-Unix systems; does nothing on Unix binmode $fh; binmode OUTPUT; # Write contents to output file while ( read( $fh, $buffer, BUFFER_SIZE ) ) { print OUTPUT $buffer; } close OUTPUT; if ( -T $fh ) { print $q->header("text/plain"); seek $fh, 0, 0; map { print } ; } sub dir_size { my $dir = shift; my $dir_size = 0; # Loop through files and sum the sizes; doesn't descend down subdirs opendir DIR, $dir or die "Unable to open $dir: $!"; while ( $_ = readdir DIR ) { $dir_size += -s "$dir/$_"; } return $dir_size; } sub error { my( $q, $reason ) = @_; print $q->header( "text/html" ), $q->start_html( "Error" ), $q->h1( "Error" ), $q->p( "Your upload was not procesed because the following error ", "occured: " ), $q->p( $q->i( $reason ) ), $q->end_html; exit; }此代码具有类似的输出： $ perl -e 'sub FOO () { 1 } BEGIN{ *FOO = sub () { 2 }; } print FOO;' $ perl -e 'sub FOO () { 1 } BEGIN{ *FOO = sub () { 2 }; } print FOO;'
Constant subroutine main::FOO redefined at -e line 1.我确实没有发出任何警告qw / redefine /但它没有帮助。
I run CGI script with apache2 and I have this warning lines in error.log (I removed all similar lines from the output):
Why this lines are there and is there a way to stop them?
Code that makes this warnings (taken from book "CGI Programming with Perl", with some bugs fixed):
#!/usr/bin/perl use strict; use warnings; use CGI; use CGI::Carp; #use diagnostics qw/-verbose/; use Fcntl qw( :DEFAULT :flock ); use constant UPLOAD_DIR => "/tmp/test_upload/"; use constant BUFFER_SIZE => 16_384; use constant MAX_FILE_SIZE => 1_048_576; # Limit each upload to 1 MB use constant MAX_DIR_SIZE => 100 * 1_048_576; # Limit total uploads to 100 MB use constant MAX_OPEN_TRIES => 100; $CGI::DISABLE_UPLOADS = 0; $CGI::POST_MAX = MAX_FILE_SIZE; my $q = new CGI; $q->cgi_error and error( $q, "Error transferring file: " . $q->cgi_error ); my $file = $q->param( "file" ) || error( $q, "No file received." ); my $filename = $q->param( "filename" ) || error( $q, "No filename entered." ); my $fh = $q->upload( "file" ) || error( $q, "Something is wrong with file handle." ); #my $fh = $q->upload( $file ); my $buffer = ""; if ( dir_size( UPLOAD_DIR ) + $ENV{CONTENT_LENGTH} > MAX_DIR_SIZE ) { error( $q, "Upload directory is full." ); } # Allow letters, digits, periods, underscores, dashes # Convert anything else to an underscore $filename =~ s/[^\w.-]/_/g; if ( $filename =~ /^(\w[\w.-]*)/ ) { $filename = $1; } else { error( $q, "Invalid file name; files must start with a letter or number." ); } # Open output file, making sure the name is unique until ( sysopen OUTPUT, UPLOAD_DIR . $filename, O_CREAT | O_EXCL ) { $filename =~ s/(\d*)(\.\w+)$/($1||0) + 1 . $2/e; $1 >= MAX_OPEN_TRIES and error( $q, "Unable to save your file." ); } # This is necessary for non-Unix systems; does nothing on Unix binmode $fh; binmode OUTPUT; # Write contents to output file while ( read( $fh, $buffer, BUFFER_SIZE ) ) { print OUTPUT $buffer; } close OUTPUT; if ( -T $fh ) { print $q->header("text/plain"); seek $fh, 0, 0; map { print } ; } sub dir_size { my $dir = shift; my $dir_size = 0; # Loop through files and sum the sizes; doesn't descend down subdirs opendir DIR, $dir or die "Unable to open $dir: $!"; while ( $_ = readdir DIR ) { $dir_size += -s "$dir/$_"; } return $dir_size; } sub error { my( $q, $reason ) = @_; print $q->header( "text/html" ), $q->start_html( "Error" ), $q->h1( "Error" ), $q->p( "Your upload was not procesed because the following error ", "occured: " ), $q->p( $q->i( $reason ) ), $q->end_html; exit; }This code have similar output: $ perl -e 'sub FOO () { 1 } BEGIN{ *FOO = sub () { 2 }; } print FOO;'
Constant subroutine main::FOO redefined at -e line 1.I did put no warnings qw/redefine/ but it didn't help.
最满意答案
AFAIK，只有在修改脚本时才会收到这些警告，然后mod_perl为有资格进行内联的子程序重新编译脚本。 重新编译子例程时，如果返回的值发生更改，则该新值将不会反映在以前内联的位置。
如果更改BUFFER_SIZE的值，则应重新启动apache 。
我还认为mod_perl / Apache :: Registry意外关闭与您的脚本相关。
AFAIK, you only get these warnings when you modify your script and then the script is re-compiled by mod_perl for subroutines that are eligible for inlining. When the subroutine is recompiled, if the the value it returns changed, that new value would not be reflected in the places where it was previously inlined.
If you change the value of, say, BUFFER_SIZE, you should re-start apache.
I also think mod_perl / Apache::Registry accidental closures is relevant to your script.
更多推荐
发布评论