Dramatic improvements to Protoutils's dump_message

Ignore-this: 61529e8a3304328253211a4ca700d83f

darcs-hash:20090803041304-4d648-2ccd2d0287c793433e100561079a5b765165825a.gz

diff --git a/Protoutils.pm b/Protoutils.pm
index ac74de3300284475f0016499b2d775d6f31fbbca..fb95bd1c7d6cf7379156270e07cfd9d241151b11 100644 (file)
--- a/Protoutils.pm
+++ b/Protoutils.pm
@@ -3,6 +3,13 @@ use strict;
 
 package Instance::Protoutils;
 
+use Instance::Definitions qw( %known_types
+                    @debug_code_chars
+                    $instance_huffman_table1
+                    $MESSAGE_START $MESSAGE_END );
+require Instance::MasterCoder;
+require Instance::HuffmanCoder;
+
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
 require Exporter;
 @ISA = qw(Exporter);
@@ -14,13 +21,32 @@ require Exporter;
 #################################################################
 
 sub dump_message($$) {
-    my ($coder, $msg) = @_;
-    $coder->tlv_run_callbacks(
+    my ($mc, $msg) = @_;
+    my $hc = Instance::HuffmanCoder->new($mc, $instance_huffman_table1);
+    my ($succ, $rem) = $mc->tlv_run_callbacks(
                   {'default' => sub {
                                   my ($t,$v) = @_;
-                                  print "T=$t, V=$v\n";
+                                  print "T=$t" ;
+                                  while(my ($k,$v) = each %known_types) {
+                                    print " ($k)" if $v == $t;
+                                  }
+                                  print ", V=$v";
+                                  { 
+                                    my $hdv = $hc->decode($v);
+                                    print " (H1:$hdv)" if defined $hdv;
+
+                                    my $tdv = $mc->tdecode($v);
+                                    print " (T:$tdv)" if defined $tdv;
+
+                                    my @ldv = $mc->ldecode($v);
+                                    my $ldv = join ",", @ldv if defined $ldv[0];
+                                    print " (L:$ldv)" if $#ldv >= 0 and defined $ldv[0];
+                                  }
+                                  print "\n";
                                 }},
                   $msg);
+    print "Parser failure!\n" if not defined $succ or not $succ;
+    print "Remainder: $rem\n" if defined $rem and length $rem > 0;
 }
 
 #################################################################