package Debug;
use strict;
use warnings;
use Time::HiRes qw(time);
use Class::Inspector;

###########################################################################
#
#
#    Package Debug
#
# Use: my $id = Debug->new();
#
# This class is intended to be a base class for other classes to derive from
# so that easy debug functionality can be included.
#
# Utility class for debugging. It contains the following member functions:
#
# $id->debug()            Sets or gets the debug level: level 0 is no debug, 
#                         level 5 is complete debug including stack backtrace. 
#                         This class only uses level 0 (no debug), level 1-4 
#                         (debug iformation displayed) and 5 , debug 
#                         info displayed with complete stack backtrace. 
#                         The levels 1-4 lets other modules define debug levels 
#                         inbetween the ones used here.
# $id->writedebug($,[$])  Writes the string to standard error if debuglevel
#                         is 1 or higher. If overide is specified 
#                         (second argument which is optional), debug level 
#                         5 is assumed for this debug.
# $id->die($)             Appends stack backtrace to argument string and 
#                         calls CORE::die
# $id->print_setup()      Prints out the complete current setup including all member 
#                         functions and data fields (uses Class::Inspector).
# 
#############################################################################

BEGIN {
    use Exporter ();
    our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
    $VERSION = 1.0;
    %EXPORT_TAGS = (
        'standard'=>[],
                    );
    Exporter::export_ok_tags('standard');
    Exporter::export_tags('standard');
}

sub new
{
    my $class = shift;
    my $self = {
        '_debug' => 0,
    };
    bless $self,$class;
    return $self;
};

return 1;

sub debug()
{
    my $self = shift;
    if (@_)
    {
        $self->{'_debug'} = shift;
    }
    return $self->{'_debug'};
}

sub writedebug()
{
    my $self = shift;
    my $str = shift;
    my $overload = 0;
    $overload = 1 if (@_);
    return unless ($self->debug || $overload);
    my $time = localtime;
    my $tt = time;
    ### Prints the errormessage ####
    my $string = "$time : $tt : $str";
    if (4 < $self->debug || $overload)
    {
        #######################################
        ## Getting complete stack backtrace ###
        ## for debug level 5                ###
        #######################################
        my @trace = ();
        my $i = 0;
        while(my ($package,$filename,$line,$subroutine) = caller($i++))
        {
            unshift @trace,"'$filename' line $line called $subroutine";
        }
        $string .= '  #### Stack backtrace: '.join(' -> ',@trace);
    }
    $string .= "\n";
    warn($string);
}

sub die
{
    my $self = shift;
    my $str = shift;
    my $time = localtime;
    my $tt = time;
    ### Prints the errormessage ####
    my $string = "$time , $tt : $str";
    #######################################
    ## Getting complete stack backtrace ###
    #######################################
    my @trace = ();
    my $i = 0;
    while(my ($package,$filename,$line,$subroutine) = caller($i++))
    {
	unshift @trace,"'$filename' line $line called $subroutine";
    }
    $string .= '  #### Stack backtrace: '.join(' -> ',@trace);
    $string .= "\n";
    CORE::die $string;
}


sub print_setup()
{
    #############################################
    ### print_setup()                         ###
    ### utility function for debugging        ###
    ### purposes, prints the contents of the  ###
    ### device instance data fields $self->{} ###
    #############################################
    my $self = shift;
    my @arr = ('*******************************************');
    $self =~ /\((.*)\)/;
    push @arr,'Setup for instance "'.$1.'" of class '.ref($self);
    push @arr,'Member functions:';
    my $class = $self;
    $class =~ s/=.*//;
    my @methods = Class::Inspector->methods( $class, 'full', 'public' );
    foreach my $m (@methods)
    {
        if (ref($m) =~ /ARRAY/)
        {
            foreach (@{$m})
            {
                push @arr,"\t$_";
            }
            next;
        }
        push @arr,"\t$m";
    }
    push @arr,'';
    push @arr,'Instance data (Field,  Value):';
    foreach my $key (keys %{$self})
    {
        if (defined ($self->{$key}))
        {
            if (ref($self->{$key}) =~ /ARRAY/)
            {
                push @arr,"$key, Array with values:";
                push @arr,"\tIndex\tValue";
                my $x = 0;
                foreach (@{$self->{$key}})
                {
                    push @arr,"\t$x\t'$_'";
                    $x++;
                }
                push @arr,'';
                next;
            }
            if (ref($self->{$key}) =~ /HASH/)
            {
                push @arr,"$key, Asociative array with values:";
                push @arr,"\tKey\tValue";
                foreach my $k (keys %{$self->{$key}})
                {
                    push @arr,"\t'$k'\t'$self->{$key}{$k}'";
                }
                push @arr,'';
                next;
            }
            push @arr,$key.",\t'$self->{$key}'";
        }
        else
        {
            push @arr,$key.",\t\\N";
        }
    }
    push @arr,'';
    return join("\n",@arr);
}
