#!/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
                 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() ) { 
 #       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 = ();

    @hide{ @{$opts->{ 'hide' }||[]} } = @{$opts->{ 'hide' }||[]};
    @skip{ @{$opts->{ 'skip' }||[]} } = @{$opts->{ 'skip' }||[]};
    print "<p><span style='background-color:#DDFFDD'>";
    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 {
            dprintarrayshort($h->{$k});
            next;
        };

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

        print defined( $h->{$k} ) ? "$h->{$k}\n" : "(undef)\n";
    }
    print "</span>\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 "$h->{$k}";
        $t = ",";
    }
    print "}\n";
}

sub dprintarrayshort
{
    my $a = shift;
    my $t = '';
    print '[';
    foreach my $k ( @{$a} ) {
        print "$t$k";
        $t = '|';
    }
    print "]\n";
}

1;
