Generated: Sun Aug 21 11:11:25 2011 from setdbgflag.pl 2010/08/26 2.5 KB.
#!/usr/bin/perl -w # setdbgflag.pl # attempt to set flags by generating the variable #use strict; use warnings; my $dbg01 = 0; my $dbg02 = 0; my $dbg03 = 0; # debug sub get_dbg_var($) { my $val = shift; my $var = 'dbg'; my $res = -1; if ($val < 10) { $var .= "0$val"; } else { $var .= "$val"; } # from : http://perldoc.perl.org/functions/eval.html if (eval "defined \$$var") { $res = eval "\$$var"; } return $res; } sub get_dbg_stg() { my $s = ''; my ($i,$res,$i2); for ($i = 1; ;$i++) { $res = get_dbg_var($i); last if ($res == -1); if ($i < 10) { $i2 = "0$i"; } else { $i2 = "$i"; } if ($res) { $s .= "$i2 "; } } return $s; } sub get_dbg_range() { my ($i,$res); for ($i = 1; ;$i++) { $res = get_dbg_var($i); last if ($res == -1); } return $i - 1; } sub set_dbg_var($) { my $val = shift; my $var = 'dbg'; if ($val < 10) { $var .= "0$val"; } else { $var .= "$val"; } # from : http://perldoc.perl.org/functions/eval.html # NOT $$var++; # does not work! if (eval "defined \$$var") { eval "\$$var++"; } else { #print "ERROR: \$$var does NOT exist\n"; return 0; } return 1; } sub clear_dbg_var($) { my $val = shift; my $var = 'dbg'; if ($val < 10) { $var .= "0$val"; } else { $var .= "$val"; } # from : http://perldoc.perl.org/functions/eval.html # NOT $$var++; # does not work! if (eval "defined \$$var") { eval "\$$var = 0"; } else { #print "ERROR: \$$var does NOT exist\n"; return 0; } return 1; } sub set_all_dbg_on() { my ($i,$res); for ($i = 1; ;$i++) { $res = set_dbg_var($i); last if (!$res); } } sub set_all_dbg_off() { my ($i,$res); for ($i = 1; ;$i++) { $res = clear_dbg_var($i); last if (!$res); } } print "Debug range is 1 to ".get_dbg_range()."\n"; set_dbg_var(2); if ($dbg02) { print "[dbg02] Set to ON - ok\n"; } else { print "[dbg02] Still OFF = FAILED!\n"; } set_dbg_var(3); if ($dbg03) { print "[dbg03] Set to ON - ok\n"; } else { print "[dbg03] Still OFF = FAILED!\n"; } set_dbg_var(5); print "Debug: ".get_dbg_stg()."\n"; # eof