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