Repository List / RFID / portmon-3m-810-decode.pl @ HEAD

#!/usr/bin/perl -w

# portmon-3m-810-decode.pl
#
# 09/22/08 23:53:24 CEST Dobrica Pavlinusic <dpavlin@rot13.org>

use Data::Dump qw/dump/;

my $dump_chars = 0;
my $debug = 1;

my $p;

sub as_chars {
	my $c = join('', map { chr(hex($_)) } @_ );
	$c =~ s/[^a-zA-Z0-9]/./g;
	return $c;
}

while(<>) {
	chomp;
	next unless m/IRP_MJ_(READ|WRITE)/;

	my ( $op, $data ) = (split(/\t/, $_))[3,6];

#	$op = $op =~ m/READ/ ? '<<' : '>>';
	$op =~ s/IRP_MJ_//;

	warn "?? $op $data\n" if $debug;

	if ( $data =~ m/Length\s+(\d+):\s+(.+)/ ) {
		my ( $this_len, $hex ) = ( $1, $2 );
		$hex = $p->{$op} . " $hex";
		$hex =~ s/^\s+//;
		$p->{$op} = $hex;

		warn "#### p->{op}: $hex"  if $debug;

		my @h = split(/\s+/, $hex);

		my $h = join(' ', @h);
		$h =~ s/(D[56])/ $1/g;	# indent known commands

		warn sprintf "## RAW %-5s %2d %-30s '%s'\n",$op,$this_len,$h,as_chars( @h );

		if ( $h[0] =~ m/D[56]/ ) {
			# do we have length?
			if ( ! defined $h[2] ) {
				warn "## no length yet: $h\n";
			} else {
				my $len = hex($h[2]) + 0x100 * hex($h[1]);
				my $curr_len = $#h - 2;	# strip length
				if ( $curr_len < $len ) {
					warn "## packet not full $curr_len < $len : $h\n";
				} else {
					warn sprintf("FULL %5s %2d | %s\n", $op, $len, $h);
					my @msg = splice( @h, 0, $len + 3 );
					printf("%-5s 0x%02x %-80s %s\n", $op, $#msg, join(' ', @msg), $dump_chars ? as_chars( @msg ) : '');
					$p->{$op} = join(' ', @h);
					warn "LEFT: ", $p->{$op} if $p->{$op};
				}
			}
		} else {
			warn "## not valid command: $h\n";
			$p->{$op} = '';
		}
	} else {
		warn "SKIPPED $op\t$data\n";
	}
}