ikegami has asked for the wisdom of the Perl Monks concerning the following question:
People who have read the Apache's mod_rewrite documentation may remember this comment:
To disable the logging of rewriting actions it is not recommended to set Filename to /dev/null, because although the rewriting engine does not then output to a logfile it still creates the logfile output internally. This will slow down the server with no advantage to the administrator! To disable logging either remove or comment out the RewriteLog directive or use RewriteLogLevel 0!For fun, I decided the write a Perl script whose parse tree is devoid of all logging code, unless logging is enabled by a command line argument.
script.pl
use strict; use warnings; use do_compile_time_arg_check; # Checks if the first arg is --log or --log="file name". # Imports LOGGING as a constant sub. # Imports strict-safe $LOG_FILE_NAME. if (LOGGING) { if (defined($LOG_FILE_NAME)) { open(LOG_FH, '>>', $LOG_FILE_NAME) or die("Can't open log file: $!\n"); } else { open(LOG_FH, '>&STDERR') or die("Can't dup STDERR: $!\n"); } } print LOG_FH ('Opening log file at '.localtime().".$/") if LOGGING;
do_compile_time_arg_check.pm
# The first time [[ use do_compile_time_arg_check; ]] # or [[ use do_compile_time_arg_check (); ]] is used, # the first command line arg is removed from @ARGV if # it's [[ --log ]] or [[ --log="file name" ]]. # Whenever [[ use do_compile_time_arg_check; ]] is used # (including the first time), # # - [[ LOGGING ]] is exported as a constant sub. It returns # true if [[ --log ]] or [[ --log="file name" ]] was found # at the head of the argument list the first time this # module was used. # # - [[ $LOG_FILE_NAME ]] is exported as a strict-safe global. # It contains the file name from [[ --log="file name" ]] if # that argument was found at the head of the argument list # the first time this module was used. use strict; use warnings; package do_compile_time_arg_check; use vars qw( $log $log_file ); BEGIN { if (@ARGV && $ARGV[0] =~ /^-?-log(?:=(.*))?$/) { shift(@ARGV); $log = 1; $log_file = $1; } } sub import { my $caller_pkg = caller(); my $lexical_log = $log; { no strict 'refs'; *{"${caller_pkg}::LOGGING" } = sub () { $lexical_log }; *{"${caller_pkg}::LOG_FILE_NAME"} = \$log_file; } } 1;
How well does it work?
Parse tree without logging:
>perl -MO=Terse script.pl Useless use of a constant in void context at script.pl line 10. Useless use of a constant in void context at script.pl line 20. LISTOP (0x1df2e3c) leave [1] OP (0x1dfb290) enter COP (0x1df2e88) nextstate OP (0x1ba34e4) null [5] COP (0x1dfb2d4) nextstate OP (0x1dfb174) null [5] script.pl syntax OK
Parse tree with logging:
>perl -MO=Terse script.pl --log LISTOP (0x1df2644) leave [1] OP (0x1df23b0) enter COP (0x1df266c) nextstate LISTOP (0x1df26c8) leave OP (0x1df26a8) enter COP (0x1df26f0) nextstate UNOP (0x1df272c) null LOGOP (0x1df2750) cond_expr UNOP (0x1df3e78) defined UNOP (0x1dfb770) null [15] PADOP (0x1ba2fd4) gvsv 1 LISTOP (0x1dfb1e4) leave OP (0x1df2778) enter COP (0x1dfb20c) nextstate UNOP (0x1dfb248) null LOGOP (0x1dfb26c) or LISTOP (0x1dfb6f0) open [4] OP (0x1dfb6d0) null [3] PADOP (0x1dfb534) gv 3 SVOP (0x1dfb718) const SPECIAL #0 Nul +lsv UNOP (0x1dfb670) null [15] PADOP (0x1dfb694) gvsv 2 LISTOP (0x1dfb424) die [9] OP (0x1dfb294) pushmark UNOP (0x1dfb478) null [67] OP (0x1dfb458) null [3] BINOP (0x1dfb4a0) concat [7] BINOP (0x1dfb2b4) concat [6] SVOP (0x1dfb400) const SP +ECIAL #0 Nullsv UNOP (0x1dfb300) null [15] PADOP (0x1dfb3dc) gvsv + 5 SVOP (0x1dfb2dc) const SPECIA +L #0 Nullsv LISTOP (0x1df27b8) leave OP (0x1df2798) enter COP (0x1df27e0) nextstate UNOP (0x1df281c) null LOGOP (0x1df2840) or LISTOP (0x1df2a6c) open [11] OP (0x1dfb164) null [3] PADOP (0x1df2a48) gv 10 SVOP (0x1dfb188) const SPECIAL #0 Nul +lsv LISTOP (0x1df2970) die [16] OP (0x1df2868) pushmark UNOP (0x1df29c0) null [67] OP (0x1df29a0) null [3] BINOP (0x1df29e8) concat [14] BINOP (0x1df2888) concat [13] SVOP (0x1dfb1c0) const SP +ECIAL #0 Nullsv UNOP (0x1df2928) null [15] PADOP (0x1df294c) gvsv + 12 SVOP (0x1dfb4fc) const SPECIA +L #0 Nullsv COP (0x1df23d0) nextstate LISTOP (0x1df2570) print OP (0x1df2550) pushmark UNOP (0x1df240c) rv2gv PADOP (0x1df2620) gv 21 SVOP (0x1df25dc) const SPECIAL #0 Nullsv UNOP (0x1df2598) scalar OP (0x1df25bc) localtime [17] UNOP (0x1df24b8) null [67] OP (0x1df2498) null [3] BINOP (0x1df24e0) concat [19] SVOP (0x1df2508) const SPECIAL #0 Nullsv UNOP (0x1df2430) null [15] PADOP (0x1df2454) gvsv 18 script.pl syntax OK
Not bad!
Is there any way to simply avoid the "Useless use of a constant in void context"? I don't get them if I type in sub LOGGING () { 0 } instead of importing LOGGING. Update: Replacing sub LOGGING () { undef } with sub LOGGING () { 0 } removes the warnings.
Is there a module that already does something similiar?
Back to
Seekers of Perl Wisdom