Author: dylan
Date: 2004-06-17 18:03:33 -0400 (Thu, 17 Jun 2004)
New Revision: 239
Modified:
trunk/main/common/lib/Haver/Preprocessor.pm
Log:
Added syntax for "DEBUG:" preprocessor token.
Usage of "use Haver::Preprocessor" is now also sligtly different.
use Haver::Preprocessor qw( :debug );
enables "DEBUG:", without it the preprocessor will just remove "DEBUG:"s from
source files.
you can supply a debug level like so:
use Haver::Preprocessor qw( :debug=6 );
DEBUG(n): "Message"; may now be used, where n is a number.
n must be a number, and is not evaluated as perl code.
if :debug=2, then:
DEBUG: "foo";
DEBUG(1): "foo";
DEBUG(2): "foo";
will all print "foo", but:
DEBUG(3): "foo"; will not.
when :debug is not given, of course, all of these are removed and provide no
run-time overhead. So add lots and lots of DEBUG(n)'s! :)
Modified: trunk/main/common/lib/Haver/Preprocessor.pm
===================================================================
--- trunk/main/common/lib/Haver/Preprocessor.pm 2004-06-15 19:32:26 UTC (rev
238)
+++ trunk/main/common/lib/Haver/Preprocessor.pm 2004-06-17 22:03:33 UTC (rev
239)
@@ -21,63 +21,83 @@
use Carp;
use Filter::Simple;
-our ($ASSERT, $DUMP, $DEBUG, $IF, $VERBOSE, $Did);
+our $Did;
+our %Opt = (
+ ASSERT => 0,
+ DUMP => 0,
+ DEBUG => undef,
+ IFDEF => 0,
+);
FILTER {
- if ($ASSERT) {
+ if ($Opt{ASSERT}) {
s/^\s*ASSERT:\s*(.+?);$/assert($1)/meg;
} else {
s/^\s*ASSERT:/# ASSERT:/mg;
}
- if ($DUMP) {
+ if ($Opt{DUMP}) {
s/^\s*DUMP:\s*(.+?);$/dumper($1)/meg;
} else {
s/^\s*DUMP:/# DUMP:/mg;
}
- if ($DEBUG) {
- s/^\s*DEBUG:\s*(.+?);\s*$/print STDERR $1, "\n";/mg;
+ if (defined $Opt{DEBUG}) {
+ s/^\s*DEBUG(?:\((\d+)\))?:\s*(.+?);\s*$/debug($1, $2)/meg;
} else {
- s/^\s*DEBUG:/# DEBUG:/mg;
+ s/^\s*DEBUG(?:\((\d+)\))?:/# DEBUG:/mg;
}
- if ($IF) {
- s/^\s*IF\s*\((.+?)\)\s*\{/doif($1)/meg;
+ if ($Opt{IFDEF}) {
+ s/^\s*IFDEF\s*(.+?)\s*\{/ifdef($1)/meg;
} else {
- s/^\s*IF\s*\((.+?)\)\s*\{/if (0) {/mg;
+ s/^\s*IFDEF\s*(.+?)\s*\{/if (0) {/mg;
}
+
};
sub import {
my ($class, @args) = @_;
-
+ my @keys;
+
no strict 'refs';
foreach my $arg (@args) {
if ($arg =~ s/^://) {
- ${uc($arg)}++;
+ if ($arg =~ s/=(.+)$//) {
+ $Opt{uc($arg)} = $1;
+ } else {
+ $Opt{uc($arg)}++;
+ }
+ push(@keys, uc($arg));
+ } elsif ($arg =~ s/^!//) {
+ delete $Opt{uc($arg)};
}
}
- if ($VERBOSE and not $Did++) {
- show("ASSERT = %s, DUMP = %s, DEBUG = %s, IF = %s\n",
- what($ASSERT), what($DUMP), what($DEBUG), what($IF));
+ if ($Opt{VERBOSE} and @keys) {
+ print STDERR __PACKAGE__, ":\n",
+ map { sprintf " %-8s = %s\n", $_, what($Opt{$_}) }
sort keys %Opt;
}
}
-sub doif {
- my $cond = shift;
- no strict;
- my $v = eval "package main; $cond";
-
- if ($@) {
- my $s = "$@";
- $s =~ s/\}/\\}/g;
- return "die q{$s}; if (0) {";
+sub debug {
+ my ($level, $rest) = @_;
+ if (not defined $level) {
+ $level = 1;
}
+ if ($level <= $Opt{DEBUG}) {
+ return qq{print STDERR $rest, "\n";};
+ } else {
+ return qq{#DEBUG:};
+ }
+}
- if ($v) {
- return '{';
+sub ifdef {
+ my $var = shift;
+
+ no strict 'refs';
+ if (defined ${$var}) {
+ return 'if (1) {';
} else {
return 'if (0) {';
}
@@ -86,12 +106,11 @@
sub show {
- my $fmt = shift;
- print STDERR __PACKAGE__, ": ", sprintf($fmt, @_);
+ print STDERR __PACKAGE__, ": ", join(', ', @_), "\n";;
}
sub what {
- $_[0] ? 'enabled' : 'disabled'
+ $_[0] ? 'ON' . " ($_[0])" : 'OFF'
}
sub assert {
