ONO::ToolBox::Debug
package ONO::ToolBox::Debug;
################################################################################
# COPYRIGHT / LICENSE #
################################################################################
#
# This file is part of the ONO Software Project.
#
# Copyright (C) 2000-2025 Jos KIRPS [ www.kirps.com | jos_AT_kirps_DOT_com ]
# and The Joopita Project [ www.joopita.org | contact_AT_joopita_DOT_com ]
#
# This file, as well as other parts of the ONO Software Project or related
# elements, are FREE SOFTWARE available under the ARTISTIC LICENSE 2.0.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#
# For the full license, see /ono/osr/license/LICENSE.txt, or write to
# jos_AT_kirps_DOT_com or contact_AT_joopita_DOT_com.
#
################################################################################
# END OF COPYRIGHT / LICENSE, HERE COMES THE CODE ... #
################################################################################
use strict;
use ONO::IO;
use ONO::Lib::DateTime::ToolBox;
use ONO::ToolBox::Input;
###############################################################################
# DEBUGGER VIEWER
###############################################################################
sub view {
#: Display the main debugging info, which is useful on development stations.
my $DEBUG = ONO::IO->load("var/tmp/debug/ono_db.txt");
$DEBUG =~ s~\n~<br>~g;
$DEBUG .= qq~<table class="default_table bl br mt10 mb10"><tr class="bg_title bt bb"><td class="pad10_2 br">Input VARS</td><td class="pad10_2"></td></tr>\n~;
my ($vars_ref,%vars) = ONO::ToolBox::Input->get;
foreach my $key (sort keys %vars) {
$DEBUG .= qq~ <tr class="bt bb"><td class="pad10_2 br">$key</td><td class="pad10_2">$vars{$key}</td></tr>\n~;
}
foreach my $cookie (sort split(/;/,$ENV{'HTTP_COOKIE'})) {
my @cp = split(/=/,$cookie);
$DEBUG .= qq~ <tr class="bt bb"><td class="pad10_2 br">$cp[0]</td><td class="pad10_2">$cp[1]</td></tr>\n~;
}
$DEBUG .= qq~ <tr class="bg_title bt bb"><td class="pad10_2 br">Perl ENV</td><td class="pad10_2"></td></tr>\n~;
foreach my $key (sort keys %ENV) {
$DEBUG .= qq~ <tr class="bt bb"><td class="pad10_2 br">$key</td><td class="pad10_2">$ENV{$key}</td></tr>\n~;
}
my ($INFO,$community,@SCRIPTS,$script_count,$this_script_num,@USE,$USE_LIST,$USE_CLEAN,%use_used,$use_last_group,@CALLED);
$ENV{'SCRIPT_NAME'} =~ m~/cgi-bin/local/perl/(.*?)/~;
$community = $1;
$INFO .= qq~Community:<br>$community<br>This script:<br><a href="$ENV{'SCRIPT_NAME'}">$ENV{'SCRIPT_NAME'}</a><br>~;
foreach my $script (sort ONO::IO->ls("cgi-bin/local/perl/$community")) {
if ($script =~ /\.pl/) {
$script_count++;
@SCRIPTS = (@SCRIPTS,$script);
if ($ENV{'SCRIPT_NAME'} =~ /$script/) {
$this_script_num = $script_count;
}
}
}
if ($SCRIPTS[$this_script_num-2]) {
$INFO .= qq~Prev script:<br><a href="/cgi-bin/local/perl/$community/$SCRIPTS[$this_script_num-2]">/cgi-bin/local/perl/$community/$SCRIPTS[$this_script_num-2]</a><br>~;
}
if ($SCRIPTS[$this_script_num]) {
$INFO .= qq~Next script:<br><a href="/cgi-bin/local/perl/$community/$SCRIPTS[$this_script_num]">/cgi-bin/local/perl/$community/$SCRIPTS[$this_script_num]</a><br>~;
}
foreach my $line (ONO::IO->list($ENV{'SCRIPT_NAME'})) {
if ($line =~ m~^use ONO::(.*?);~) { # disable_mksys_warnings
@USE = (@USE,"use ONO::$1;"); # disable_mksys_warnings
} # disable_mksys_warnings
if ($line =~ m~ONO::(.*?)( |-)~) { # disable_mksys_warnings
@CALLED = (@CALLED,"ONO::$1"); # disable_mksys_warnings
} # disable_mksys_warnings
}
foreach my $use (sort @USE) {
if (!$use_used{$use}) {
if (!$use_last_group) {
$use_last_group = substr($use,0,10);
}
my $not_used = qq~ <span class="bold lightred">[not used]</span>~;
foreach my $call (@CALLED) {
if ($use eq "use $call;") {
$not_used = "";
}
}
if ($use =~ /ONO::(IO|DB);/) {
$USE_LIST = qq~$use$not_used<br>$USE_LIST~;
} else {
$USE_LIST .= qq~$use$not_used<br>~;
}
if (!$not_used) {
if ($use =~ /ONO::(IO|DB);/) {
$USE_CLEAN = qq~$use$not_used<br>$USE_CLEAN~;
} else {
if ($use !~ /$use_last_group/) {
$USE_CLEAN .= qq~<br>~;
$use_last_group = substr($use,0,10);
}
$USE_CLEAN .= qq~$use$not_used<br>~;
}
}
$use_used{$use}++;
}
}
$DEBUG .= qq~ <tr class="bg_title bt bb"><td class="pad10_2 br">Script Analysis:</td><td class="pad10_2">Basic Info</td></tr>\n
<tr class="bt bb"><td class="pad10_2 br"></td><td class="pad10_2">$INFO</td></tr>\n
<tr class="bg_title bt bb"><td class="pad10_2 br">Script Analysis:</td><td class="pad10_2">Loaded ONO Modules</td></tr>\n
<tr class="bt bb"><td class="pad10_2 br"></td><td class="pad10_2">$USE_LIST</td></tr>\n
<tr class="bg_title bt bb"><td class="pad10_2 br">Script Analysis:</td><td class="pad10_2">Loaded ONO Modules (cleaned up)</td></tr>\n
<tr class="bt bb"><td class="pad10_2 br"></td><td class="pad10_2">$USE_CLEAN</td></tr>\n
~;
$DEBUG .= qq~</table>\n~;
my $base;
if ($ENV{'SCRIPT_NAME'} =~ m~/cgi-bin/local/perl/(.*?)/~) {
$base = "&base=$1";
}
return qq~<div class="p10 hide800 tal">
<div class="box_paper">
<div class="bb">
<div class="fr"><a href="/ono/admin/?/db/$base">ONO DBMS</a></div>
<span class="bold">Debugger</span>
</div>
$DEBUG
</div>
</div>
~;
}
###############################################################################
# WEB LOGGER
###############################################################################
sub weblog {
# DEPRECATED
}
###############################################################################
# META INFO
###############################################################################
sub meta {
# DEPRECATED
}
###############################################################################
# TRON
###############################################################################
sub tron {
# DEPRECATED
}
###############################################################################
# TROFF
###############################################################################
sub troff {
# DEPRECATED
}
###############################################################################
# end of script
###############################################################################
1;
__END__
################################################################################
# COPYRIGHT / LICENSE #
################################################################################
#
# This file is part of the ONO Software Project.
#
# Copyright (C) 2000-2025 Jos KIRPS [ www.kirps.com | jos_AT_kirps_DOT_com ]
# and The Joopita Project [ www.joopita.org | contact_AT_joopita_DOT_com ]
#
# This file, as well as other parts of the ONO Software Project or related
# elements, are FREE SOFTWARE available under the ARTISTIC LICENSE 2.0.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#
# For the full license, see /ono/osr/license/LICENSE.txt, or write to
# jos_AT_kirps_DOT_com or contact_AT_joopita_DOT_com.
#
################################################################################
# END OF COPYRIGHT / LICENSE, HERE COMES THE CODE ... #
################################################################################
use strict;
use ONO::IO;
use ONO::Lib::DateTime::ToolBox;
use ONO::ToolBox::Input;
###############################################################################
# DEBUGGER VIEWER
###############################################################################
sub view {
#: Display the main debugging info, which is useful on development stations.
my $DEBUG = ONO::IO->load("var/tmp/debug/ono_db.txt");
$DEBUG =~ s~\n~<br>~g;
$DEBUG .= qq~<table class="default_table bl br mt10 mb10"><tr class="bg_title bt bb"><td class="pad10_2 br">Input VARS</td><td class="pad10_2"></td></tr>\n~;
my ($vars_ref,%vars) = ONO::ToolBox::Input->get;
foreach my $key (sort keys %vars) {
$DEBUG .= qq~ <tr class="bt bb"><td class="pad10_2 br">$key</td><td class="pad10_2">$vars{$key}</td></tr>\n~;
}
foreach my $cookie (sort split(/;/,$ENV{'HTTP_COOKIE'})) {
my @cp = split(/=/,$cookie);
$DEBUG .= qq~ <tr class="bt bb"><td class="pad10_2 br">$cp[0]</td><td class="pad10_2">$cp[1]</td></tr>\n~;
}
$DEBUG .= qq~ <tr class="bg_title bt bb"><td class="pad10_2 br">Perl ENV</td><td class="pad10_2"></td></tr>\n~;
foreach my $key (sort keys %ENV) {
$DEBUG .= qq~ <tr class="bt bb"><td class="pad10_2 br">$key</td><td class="pad10_2">$ENV{$key}</td></tr>\n~;
}
my ($INFO,$community,@SCRIPTS,$script_count,$this_script_num,@USE,$USE_LIST,$USE_CLEAN,%use_used,$use_last_group,@CALLED);
$ENV{'SCRIPT_NAME'} =~ m~/cgi-bin/local/perl/(.*?)/~;
$community = $1;
$INFO .= qq~Community:<br>$community<br>This script:<br><a href="$ENV{'SCRIPT_NAME'}">$ENV{'SCRIPT_NAME'}</a><br>~;
foreach my $script (sort ONO::IO->ls("cgi-bin/local/perl/$community")) {
if ($script =~ /\.pl/) {
$script_count++;
@SCRIPTS = (@SCRIPTS,$script);
if ($ENV{'SCRIPT_NAME'} =~ /$script/) {
$this_script_num = $script_count;
}
}
}
if ($SCRIPTS[$this_script_num-2]) {
$INFO .= qq~Prev script:<br><a href="/cgi-bin/local/perl/$community/$SCRIPTS[$this_script_num-2]">/cgi-bin/local/perl/$community/$SCRIPTS[$this_script_num-2]</a><br>~;
}
if ($SCRIPTS[$this_script_num]) {
$INFO .= qq~Next script:<br><a href="/cgi-bin/local/perl/$community/$SCRIPTS[$this_script_num]">/cgi-bin/local/perl/$community/$SCRIPTS[$this_script_num]</a><br>~;
}
foreach my $line (ONO::IO->list($ENV{'SCRIPT_NAME'})) {
if ($line =~ m~^use ONO::(.*?);~) { # disable_mksys_warnings
@USE = (@USE,"use ONO::$1;"); # disable_mksys_warnings
} # disable_mksys_warnings
if ($line =~ m~ONO::(.*?)( |-)~) { # disable_mksys_warnings
@CALLED = (@CALLED,"ONO::$1"); # disable_mksys_warnings
} # disable_mksys_warnings
}
foreach my $use (sort @USE) {
if (!$use_used{$use}) {
if (!$use_last_group) {
$use_last_group = substr($use,0,10);
}
my $not_used = qq~ <span class="bold lightred">[not used]</span>~;
foreach my $call (@CALLED) {
if ($use eq "use $call;") {
$not_used = "";
}
}
if ($use =~ /ONO::(IO|DB);/) {
$USE_LIST = qq~$use$not_used<br>$USE_LIST~;
} else {
$USE_LIST .= qq~$use$not_used<br>~;
}
if (!$not_used) {
if ($use =~ /ONO::(IO|DB);/) {
$USE_CLEAN = qq~$use$not_used<br>$USE_CLEAN~;
} else {
if ($use !~ /$use_last_group/) {
$USE_CLEAN .= qq~<br>~;
$use_last_group = substr($use,0,10);
}
$USE_CLEAN .= qq~$use$not_used<br>~;
}
}
$use_used{$use}++;
}
}
$DEBUG .= qq~ <tr class="bg_title bt bb"><td class="pad10_2 br">Script Analysis:</td><td class="pad10_2">Basic Info</td></tr>\n
<tr class="bt bb"><td class="pad10_2 br"></td><td class="pad10_2">$INFO</td></tr>\n
<tr class="bg_title bt bb"><td class="pad10_2 br">Script Analysis:</td><td class="pad10_2">Loaded ONO Modules</td></tr>\n
<tr class="bt bb"><td class="pad10_2 br"></td><td class="pad10_2">$USE_LIST</td></tr>\n
<tr class="bg_title bt bb"><td class="pad10_2 br">Script Analysis:</td><td class="pad10_2">Loaded ONO Modules (cleaned up)</td></tr>\n
<tr class="bt bb"><td class="pad10_2 br"></td><td class="pad10_2">$USE_CLEAN</td></tr>\n
~;
$DEBUG .= qq~</table>\n~;
my $base;
if ($ENV{'SCRIPT_NAME'} =~ m~/cgi-bin/local/perl/(.*?)/~) {
$base = "&base=$1";
}
return qq~<div class="p10 hide800 tal">
<div class="box_paper">
<div class="bb">
<div class="fr"><a href="/ono/admin/?/db/$base">ONO DBMS</a></div>
<span class="bold">Debugger</span>
</div>
$DEBUG
</div>
</div>
~;
}
###############################################################################
# WEB LOGGER
###############################################################################
sub weblog {
# DEPRECATED
}
###############################################################################
# META INFO
###############################################################################
sub meta {
# DEPRECATED
}
###############################################################################
# TRON
###############################################################################
sub tron {
# DEPRECATED
}
###############################################################################
# TROFF
###############################################################################
sub troff {
# DEPRECATED
}
###############################################################################
# end of script
###############################################################################
1;
__END__