#!/usr/bin/perl -w

package mmDebug;
use strict;
use warnings;

BEGIN {
    use Exporter ();
    our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
    $VERSION = 1.00;                    # version for version checking
    @ISA = qw(Exporter);
    @EXPORT = qw(dprintsql dsql dprint dprinthash dprinthashshort
                 dprintarray dprintarrayshort dprintstr);
    @EXPORT_OK = qw();                  # optionally exported functions
}

sub debug_level
{
    my $key = shift;

    if( defined( &main::DEBUG ) and ref( main::DEBUG() ) eq 'HASH' ) {
        return ( main::DEBUG()->{$key} || 0 );
    }
    return 0;
}

sub dprintstr {
    my $v = shift;
    $v and do { print "<span style='background-color:#DDFFDD'>$v (";
                foreach my $c (unpack("C*",$v)) { print $c ." "; }
                print ")</span>";
            };
}

sub dprintsql
{
    my $req_level = ( $_[2] or 0 );
    $req_level <= debug_level( 'sql' ) and 
     print
        "<pre style='background-color:#DDFFDD'><b>$_[0]</b>($req_level)" . 
        "\n$_[1]\n</pre>"; 
}

sub dsql
{
    if( main::DEBUG() ) { 
        my $req_level = ( $_[1] or 0 );
        $req_level <= debug_level( 'sql' ) and 
            print "<pre style='background-color:#DDFFDD'>$_[0]\n</pre>"; 
    }
    $_[0];
}

sub dprint
{
    print "<pre style='background-color:#DDFFDD'>", @_, "\n</pre>"; 
}


sub dprinthash
{
    my $h = shift;
    my $opts = shift || {};
    my %hide = ();
    my %skip = ();
    my $name = undef;
    
    ref( $opts ) or do {
        $name = $opts;
        $opts = {};
    };

    $opts->{'name'} and $name = $opts->{'name'};
    $opts->{'name'} = undef;

    @hide{ @{$opts->{ 'hide' }||[]} } = @{$opts->{ 'hide' }||[]};
    @skip{ @{$opts->{ 'skip' }||[]} } = @{$opts->{ 'skip' }||[]};

    $opts->{'nopara'} or print "\n<p>";

    $opts->{'nopara'} = 1;

    print "<span style='background-color:#DDFFDD'>";
    $name and print "<b>$name</b>&nbsp;&nbsp;";
    foreach my $k ( keys( %{$h} ) ) {
        defined( $skip{$k} ) and  next;
        print "$k: ";
        defined( $hide{$k} ) and print "***\n" and next;
            
        ref( $h->{$k} ) =~ /ARRAY/ and do {
            if( $opts->{'deep'} ) {
                dprintarray($h->{$k}, $opts);
            } else {
                dprintarrayshort($h->{$k});
            }
            next;
        };

        ref( $h->{$k} ) =~ /HASH/ and do {
            if( $opts->{'deep'} ) {
                dprinthash($h->{$k}, $opts);
            } else {
                dprinthashshort($h->{$k});
            }
            next;
        };

        print defined( $h->{$k} ) ? "$h->{$k}\n" : "(undef)\n";
    }
    print "</span>\n";
}

sub dprintarray
{
    my $a = shift;
    my $opts = shift || {};
    my $name = undef;
    
    ref( $opts ) or do {
        $name = $opts;
        $opts = {};
    };

    $opts->{'name'} and $name = $opts->{'name'};
    $opts->{'name'} = undef;

    $opts->{'nopara'} or print "\n<p>";

    $opts->{'nopara'} = 1;

    print "<span style='background-color:#DDFFDD'>";
    $name and print "<b>$name</b>&nbsp;&nbsp;";
    print "[<br>";
    my $t = '';
    foreach my $k ( @{$a} ) {
        print $t;
        $t = '|<br>';
        ref( $k ) =~ /ARRAY/ and do {
            if( $opts->{'deep'} ) {
                dprintarray($k, $opts);
            } else {
                dprintarrayshort($k);
            }
            next;
        };

        ref( $k ) =~ /HASH/ and do {
            if( $opts->{'deep'} ) {
                dprinthash($k, $opts);
            } else {
                dprinthashshort($k);
            }
            next;
        };

        print defined( $k)  ? "$k\n" : "(undef)\n";
    }
    print "]</span><br>\n";
}


sub dprinthashshort
{
    my $h = shift;
    my $t = '';

    print '{';
    foreach my $k ( keys( %{$h} ) ) {
        print "$t$k=>";
            
        ref( $h->{$k} ) =~ /ARRAY/ and do {
            dprintarrayshort($h->{$k});
            next;
        };

        ref( $h->{$k} ) =~ /HASH/ and do {
            dprinthashshort($h->{$k});
            next;
        };

        print defined( $h->{$k} )  ? "$h->{$k}\n" : "(undef)\n";
        $t = ", ";
    }
    print "}\n";
}

sub dprintarrayshort
{
    my $a = shift;
    my $t = '';
    print '[';
    foreach my $k ( @{$a} ) {
        print $t;
        $t = '|';
        ref( $k ) =~ /ARRAY/ and do {
            dprintarrayshort($k);
            next;
        };

        ref( $k ) =~ /HASH/ and do {
            dprinthashshort($k);
            next;
        };

        print defined( $k ) ? $k : "<b style='color:red'>undef</b>";
    }
    print "]\n";
}

1;
