viewvc.cgi/RFID/portmon-3m-810-decode.pl

#!/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 $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), 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";
        }
}


1	dpavlin	11	#!/usr/bin/perl -w
2
3			# portmon-3m-810-decode.pl
4			#
5			# 09/22/08 23:53:24 CEST Dobrica Pavlinusic <dpavlin@rot13.org>
6
7			use Data::Dump qw/dump/;
8
9			my $debug = 1;
10			my $p;
11
12			sub as_chars {
13			my $c = join('', map { chr(hex($_)) } @_ );
14			$c =~ s/[^a-zA-Z0-9]/./g;
15			return $c;
16			}
17
18			while(<>) {
19			chomp;
20			next unless m/IRP_MJ_(READ\|WRITE)/;
21
22			my ( $op, $data ) = (split(/\t/, $_))[3,6];
23
24			# $op = $op =~ m/READ/ ? '<<' : '>>';
25			$op =~ s/IRP_MJ_//;
26
27			warn "?? $op $data\n" if $debug;
28
29			if ( $data =~ m/Length\s+(\d+):\s+(.+)/ ) {
30			my ( $this_len, $hex ) = ( $1, $2 );
31			$hex = $p->{$op} . " $hex";
32			$hex =~ s/^\s+//;
33			$p->{$op} = $hex;
34
35			warn "#### p->{op}: $hex" if $debug;
36
37			my @h = split(/\s+/, $hex);
38
39			my $h = join(' ', @h);
40			$h =~ s/(D[56])/ $1/g; # indent known commands
41
42			warn sprintf "## RAW %-5s %2d %-30s '%s'\n",$op,$this_len,$h,as_chars( @h );
43
44			if ( $h[0] =~ m/D[56]/ ) {
45			# do we have length?
46			if ( ! defined $h[2] ) {
47			warn "## no length yet: $h\n";
48			} else {
49			my $len = hex($h[2]) + 0x100 * hex($h[1]);
50			my $curr_len = $#h - 2; # strip length
51			if ( $curr_len < $len ) {
52			warn "## packet not full $curr_len < $len : $h\n";
53			} else {
54			warn sprintf("FULL %5s %2d \| %s\n", $op, $len, $h);
55			my @msg = splice( @h, 0, $len + 3 );
56			printf("%-5s 0x%02x %-80s %s\n", $op, $#msg, join(' ', @msg), as_chars( @msg ));
57			$p->{$op} = join(' ', @h);
58			warn "LEFT: ", $p->{$op} if $p->{$op};
59			}
60			}
61			} else {
62			warn "## not valid command: $h\n";
63			$p->{$op} = '';
64			}
65			} else {
66			warn "SKIPPED $op\t$data\n";
67			}
68			}
69
70