Taking a Dump

The Situation

• A generic routine, within a library, is called from within everywhere in a multi-program application.

The Situation

• A generic routine, within a library, is called from within everywhere in a multi-program application.

• One of the programs has a bug!

The Situation

• A generic routine, within a library, is called from within everywhere in a multi-program application.

• One of the programs has a bug!

• Who caused it?

The Library Routine

sub send_query {
    my ($dbh, $query, $retry_flag) = @_;
    my ($sth, $rows, $row, $err);

    unless ($sth = $dbh->prepare($query)) {
        print "<P>Failed doing prepare: ", $dbh->errstr, "<BR>\n$query<BR>\n";
        return(0);
    }
    unless ($rows = $sth->execute) {
        print "<P>Failed executing query: ", $dbh->errstr, "<BR>\n$query<BR>\n";
        return(0);
    }
    if ($sth->{NUM_OF_FIELDS} > 0) {
        unless ($row = $sth->fetchall_arrayref) {
            print "<P>Failed doing results fetch: ", $dbh->errstr, "<BR>\n$query<BR>\n";
            return(0);
        }
    }
    $sth->finish;
    return($rows, $row);
}

The Invocation

$q = "alter table traptype add parm$p1" . "StatID BIGINT";
unless (($rc, $rd) = &send_query($dbh, $q)) { print "<P>FAILED ($rc): $q<BR>\n"; exit; }

The NEW Library Routine

sub send_query {
    my ($dbh, $query, $retry_flag) = @_;
    my ($sth, $rows, $row, $err);

    unless ($sth = $dbh->prepare($query)) {
        print "<P>Failed doing prepare: ", $dbh->errstr, "<BR>\n$query<BR>\n";
        dump_perl_stack('in_html');
        return(0);
    }
    unless ($rows = $sth->execute) {
        print "<P>Failed executing query: ", $dbh->errstr, "<BR>\n$query<BR>\n";
        dump_perl_stack('in_html');
        return(0);
    }
    if ($sth->{NUM_OF_FIELDS} > 0) {
        unless ($row = $sth->fetchall_arrayref) {
            print "<P>Failed doing results fetch: ", $dbh->errstr, "<BR>\n$query<BR>\n";
            dump_perl_stack('in_html');
            return(0);
        }
    }
    $sth->finish;
    return($rows, $row);
}

The Example

#!/usr/bin/perl

sub test1 { dump_perl_stack(); }

sub test { test1("b"); }

test("a");

Sample Result #1

[root@localhost root]# ./s

== Stack Backtrace ==
./s:21>main::dump_perl_stack()
./s:21>main::test1()
./s:23>main::test()
== End of Stack Backtrace ==

Sample Result #2

== Stack Backtrace ==
system_admin.ph:64>main::dump_perl_stack()
system_admin.ph:58>main::send_query()
system_admin.ph:1709>main::use_database()
/var/www/html/nia/scripts/add_remove_client_p2.pl:178>main::add_unit()
/var/www/html/nia/scripts/add_remove_client_p2.pl:127>main::addClient()
== End of Stack Backtrace ==

The Magic

sub dump_perl_stack {
    my $terminator = defined(@_[0]) ? "<BR>\n" : "\n";

    my $level;
    print $::dumpvar if ($::dumpvar);
    print "$terminator== Stack Backtrace ==$terminator";
    while (1) {
        my ($file, $line, $subr) = (caller($level))[1,2,3];
        last unless $line;
        print "$file:$line>$subr()$terminator";
        $level++;
    }
    print "== End of Stack Backtrace ==$terminator";
}

The Alternative

• My Version

  [root@localhost root]# ./s
  
  == Stack Backtrace ==
  ./s:21>main::dump_perl_stack()
  ./s:24>main::test1()
  ./s:26>main::test()
  == End of Stack Backtrace ==
  

The Alternative

• My Version

  [root@localhost root]# ./s
  
  == Stack Backtrace ==
  ./s:21>main::dump_perl_stack()
  ./s:24>main::test1()
  ./s:26>main::test()
  == End of Stack Backtrace ==
  

• Their Version

  This is how we got here! at ./s line 21
          main::test1("b") called at ./s line 24
          main::test("a") called at ./s line 26
  

How 'They' Did It

use Carp qw(cluck);

...

cluck "This is how we got here!";

Thank You