1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
#!/usr/bin/env perl
# $Id: lib_form.pl,v 1.3 2002/09/14 21:07:03 euske Exp $
#
# lib_form.pl - form handling (form_*.pl)
#
# 2002/2, by 1@2ch
# * public domain *
#
# define_form($): construct a form a given text.
# disp_form(@args): display the form (used in disp_* tools)
# make_form($file, @args): dump the form (used in make_* tools)
require 'lib_util.pl';
sub define_form($) {
foreach $_ (split("\n", $_[0])) {
my $c;
$c = $1 if (s/(\#.*)$//);
@split_data = split(/\s+/);
if (2 <= @split_data) {
push(@form_fields, $split_data[1]);
push(@form_comments, $c);
@split_data[1] =~ tr/A-Z/a-z/;
$form_types{$split_data[1]} = $split_data[0];
}
}
1;
}
sub disp_form(@) {
my $ff = shift(@_);
ropen($ff);
%form_val = ();
for(my $i = 0; $i < @form_fields; $i++) {
my $f = $form_fields[$i];
$f =~ tr/A-Z/a-z/;
my $t = $form_types{$f};
my $v;
if ($t eq 'uint8') {
$v = ruint8();
} elsif ($t eq 'uint16' || $t eq 'ufword') {
$v = ruint16();
} elsif ($t eq 'sint16' || $t eq 'fword') {
$v = rsint16();
} elsif ($t eq 'bits16') {
$v = sprintf("0x%04lx", ruint16());
} elsif ($t eq 'uint32' || $t eq 'fixed') {
$v = sprintf("0x%08lx", ruint32());
} elsif ($t eq 'str32') {
$v = rstr32();
} elsif ($t eq 'uint64') {
$v = sprintf("0x%08lx 0x%08lx", ruint32(), ruint32());
} else {
print STDERR "disp_form: unknown type: $f ($t)\n";
}
$form_val{$f} = $v;
}
if (0 == @_) {
for(my $i = 0; $i < @form_fields; $i++) {
my $f = $form_fields[$i];
$f =~ tr/A-Z/a-z/;
print "$form_fields[$i]\t$form_val{$f}\t$form_comments[$i]\n";
}
} else {
foreach my $f (@_) {
$f =~ tr/A-Z/a-z/;
print $form_val{$f},"\n";
}
}
rclose();
}
sub make_field1(@) {
my ($f, $arg1, $arg2) = @_;
$f =~ tr/A-Z/a-z/;
my $t = $form_types{$f};
#print "$f, $t, $arg1\n";
if ($t eq 'uint8') {
$form_val{$f} = pack('C', eval($arg1));
} elsif ($t eq 'uint16' || $t eq 'ufword') {
$form_val{$f} = substr(pack('n', eval($arg1)), 0, 2);
} elsif ($t eq 'sint16' || $t eq 'fword' || $t eq 'bits16') {
$arg1 += 65536 if ($arg1 < 0);
$form_val{$f} = substr(pack('n', eval($arg1)), 0, 2);
} elsif ($t eq 'uint32' || $t eq 'fixed') {
$form_val{$f} = pack('N', eval($arg1));
} elsif ($t eq 'str32') {
$form_val{$f} = substr($arg1, 0, 4);
} elsif ($t eq 'uint64') {
$form_val{$f} = pack('N', eval($arg1)) . pack('N', eval($arg2));
} else {
print STDERR "make_form: warining: unknown type: $f ($t)\n";
}
}
sub make_form($@) {
my $ff = shift(@_);
@extra = @_;
open(IN, $ff) || die("open: $ff: $!");
%form_val = ();
while($_ = getline(IN)) {
@split_data = split(/\s+/);
next if (@split_data < 2);
make_field1(@split_data);
}
close(IN);
foreach my $x (@extra) {
$x =~ /^(\w+)=(.+)$/;
@args = split(/\s+/, $2);
make_field1($1, @args);
}
foreach my $f (@form_fields) {
$f =~ tr/A-Z/a-z/;
die "make_form: $ff: '$f' lacks" if ($form_val{$f} eq '');
}
wopen('&STDOUT');
foreach my $f (@form_fields) {
wstrn($form_val{$f});
}
wclose();
}
1;
|
