From 4d2a03a6c984fa49b3502fa13b8131efb60eec89 Mon Sep 17 00:00:00 2001 From: nwf Date: Mon, 3 Aug 2009 00:13:04 -0400 Subject: [PATCH] Dramatic improvements to Protoutils's dump_message Ignore-this: 61529e8a3304328253211a4ca700d83f darcs-hash:20090803041304-4d648-2ccd2d0287c793433e100561079a5b765165825a.gz --- Protoutils.pm | 32 +++++++++++++++++++++++++++++--- 1 file changed, 29 insertions(+), 3 deletions(-) diff --git a/Protoutils.pm b/Protoutils.pm index ac74de3..fb95bd1 100644 --- 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; } ################################################################# -- 2.50.1