Why can I override warnings with use constant in mod_perl?

I am running a CGI script with apache2 and I have these warning lines in error.log ( I removed all related lines from the output ):

  [Thu Jul 30 09:39:37 2009] upload.pl: Constant subroutine ModPerl :: ROOT :: ModPerl :: Registry :: home_stanislav_cgi_perl_upload_2epl :: UPLOAD_DIR redefined at /usr/share/perl/5.10/constant.pm line 115, line 133.
 Constant subroutine
     ModPerl :: ROOT :: ModPerl :: Registry :: home_stanislav_cgi_perl_upload_2epl :: BUFFER_SIZE redefined at /usr/share/perl/5.10/constant.pm line 115, line 133 (# 1)
 [Thu Jul 30 09:39:37 2009] upload.pl: Constant subroutine ModPerl :: ROOT :: ModPerl :: Registry :: home_stanislav_cgi_perl_upload_2epl :: BUFFER_SIZE redefined at /usr/share/perl/5.10/constant.pm line 115, line 133.
 Constant subroutine
     ModPerl :: ROOT :: ModPerl :: Registry :: home_stanislav_cgi_perl_upload_2epl :: MAX_FILE_SIZE redefined at /usr/share/perl/5.10/constant.pm line 115, line 133 (# 1)
 [Thu Jul 30 09:39:37 2009] upload.pl: Constant subroutine ModPerl :: ROOT :: ModPerl :: Registry :: home_stanislav_cgi_perl_upload_2epl :: MAX_FILE_SIZE redefined at /usr/share/perl/5.10/constant.pm line 115, line 133.
 Constant subroutine
     ModPerl :: ROOT :: ModPerl :: Registry :: home_stanislav_cgi_perl_upload_2epl :: MAX_DIR_SIZE redefined at /usr/share/perl/5.10/constant.pm line 115, line 133 (# 1)
 [Thu Jul 30 09:39:37 2009] upload.pl: Constant subroutine ModPerl :: ROOT :: ModPerl :: Registry :: home_stanislav_cgi_perl_upload_2epl :: MAX_DIR_SIZE redefined at /usr/share/perl/5.10/constant.pm line 115, line 133.
 Constant subroutine
     ModPerl :: ROOT :: ModPerl :: Registry :: home_stanislav_cgi_perl_upload_2epl :: MAX_OPEN_TRIES redefined at /usr/share/perl/5.10/constant.pm line 115, line 133 (# 1)
 [Thu Jul 30 09:39:37 2009] upload.pl: Constant subroutine ModPerl :: ROOT :: ModPerl :: Registry :: home_stanislav_cgi_perl_upload_2epl :: MAX_OPEN_TRIES redefined at /usr/share/perl/5.10/constant.pm line 115, line 133.
 Subroutine dir_size redefined at /home/stanislav/cgi/perl/upload.pl line 79,
      line 133 (# 2)
 [Thu Jul 30 09:39:37 2009] upload.pl: Subroutine dir_size redefined at /home/stanislav/cgi/perl/upload.pl line 79, line 133.
 Subroutine error redefined at /home/stanislav/cgi/perl/upload.pl line 90,
      line 133 (# 2)
 [Thu Jul 30 09:39:37 2009] upload.pl: Subroutine error redefined at /home/stanislav/cgi/perl/upload.pl line 90, line 133.
 Argument "" isn't numeric in numeric ge (> =) at
     /home/stanislav/cgi/perl/upload.pl line 62 (# 4)
 [Thu Jul 30 09:39:37 2009] -e: Argument "" isn't numeric in numeric ge (> =) at /home/stanislav/cgi/perl/upload.pl line 62.
 Filehandle OUTPUT opened only for input at /home/stanislav/cgi/perl/upload.pl
     line 69 (# 5)
 [Thu Jul 30 09:39:37 2009] -e: Filehandle OUTPUT opened only for input at /home/stanislav/cgi/perl/upload.pl line 69.
 Constant subroutine
     ModPerl :: ROOT :: ModPerl :: Registry :: home_stanislav_cgi_perl_upload_2epl :: UPLOAD_DIR redefined at /usr/share/perl/5.10/constant.pm line 115, line 133 (# 1)

Why are these lines there and is there a way to stop them?

The code that makes this warning (taken from the 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 has a similar output: $ 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. 

I did put no warnings qw / redefine /, but that didn't help.

+4
source share
2 answers

AFAIK, you will only get these warnings when you modify your script, and then the script is re-compiled by mod_perl for routines that are allowed to embed. When a subprogram is recompiled, if the value that it returns has changed, this new value will not be reflected in the places where it was previously nested.

If you change the value of, say, BUFFER_SIZE , you must restart apache .

I also think mod_perl / Apache :: Accidentally closing the registry is relevant to your script.

+6
source

Under the assumption that the first definition of FOO is optimized. Define this with a statement in the body, and I think you will find that the error disappears.

$ perl -e 'sub FOO () { print 1; } BEGIN{ *FOO = sub () { 2 }; } print FOO;'

+1
source

All Articles