Data-Debug

 view release on metacpan or  search on metacpan

lib/Data/Debug.pm  view on Meta::CPAN

        }
        $html .= "</pre>\n";
        return $html if $called eq 'debug_html';
        my $typed = content_typed();
        print_content_type();
        print $typed ? $html : "<!DOCTYPE html>$html";
    } else {
        my $txt = "$called: $file line $line_n\n";
        for (0 .. $#dump) {
            $dump[$_] =~ s|\$VAR1|$var[$_]|g;
            $txt .= $dump[$_];
        }
        $txt =~ s/\s*$/\n/;
        return $txt if $called eq 'debug_text';

        if ($called eq 'debug_warn') {
            warn $txt;
        }
        else {
            print $txt;
        }
    }
    return @_[0..$#_];
}

sub debug      { &_what_is_this }
sub debug_warn { &_what_is_this }
sub debug_text { &_what_is_this }
sub debug_html { &_what_is_this }

sub debug_plain {
    require Data::Dumper;
    local $Data::Dumper::Indent = 1;
    local $Data::Dumper::Terse = 1;
    my $dump = join "\n", map {_dump($_)} @_;
    print $dump if !defined wantarray;
    return $dump;
}


sub content_typed {
    if (my $r = apache_request_sub()->()) {
        return $r->bytes_sent;
    } else {
        return $ENV{'CONTENT_TYPED'} ? 1 : undef;
    }
}

sub print_content_type {
    my $type = "text/html";

    if (my $r = apache_request_sub()->()) {
        return if $r->bytes_sent;
        $r->content_type($type);
        $r->send_http_header if _is_mod_perl_1;
    } else {
        if (! $ENV{'CONTENT_TYPED'}) {
            print "Content-Type: $type\r\n\r\n";
            $ENV{'CONTENT_TYPED'} = '';
        }
        $ENV{'CONTENT_TYPED'} .= sprintf("%s, %d\n", (caller)[1,2]);
    }
}

sub _html_quote {
    my $value = shift;
    return '' if ! defined $value;
    $value =~ s/&/&amp;/g;
    $value =~ s/</&lt;/g;
    $value =~ s/>/&gt;/g;
    return $value;
}

sub caller_trace {
    eval { require 5.8.0 } || return ['Caller trace requires perl 5.8'];
    require Carp::Heavy;
    local $Carp::MaxArgNums = 5;
    local $Carp::MaxArgLen  = 20;
    my $i    = shift || 0;
    my $skip = shift || {};
    my @i = ();
    my $max1 = 0;
    my $max2 = 0;
    my $max3 = 0;
    while (my %i = Carp::caller_info(++$i)) {
        next if $skip->{$i{file}};
        $i{sub_name} =~ s/\((.*)\)$//;
        $i{args} = $i{has_args} ? $1 : "";
        $i{sub_name} =~ s/^.*?([^:]+)$/$1/;
        $i{file} =~ s/$QR_TRACE1/$1/ || $i{file} =~ s/$QR_TRACE2/$1/;
        $max1 = length($i{sub_name}) if length($i{sub_name}) > $max1;
        $max2 = length($i{file})     if length($i{file})     > $max2;
        $max3 = length($i{line})     if length($i{line})     > $max3;
        push @i, \%i;
    }
    foreach my $ref (@i) {
        $ref = sprintf("%-${max1}s at %-${max2}s line %${max3}s", $ref->{sub_name}, $ref->{file}, $ref->{line})
            . ($ref->{args} ? " ($ref->{args})" : "");
    }
    return \@i;
}

###----------------------------------------------------------------###

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Data::Debug - allows for basic data dumping and introspection.

=head1 VERSION

version 0.04

=head1 SYNOPSIS



( run in 2.094 seconds using v1.01-cache-2.11-cpan-63c85eba8c4 )