Root/
| 1 | #!/usr/bin/perl |
| 2 | |
| 3 | require "parser.pl"; |
| 4 | require "match.pl"; |
| 5 | require "misc.pl"; |
| 6 | |
| 7 | |
| 8 | sub issue |
| 9 | { |
| 10 | print shift(@_), " ", join(" ", @_, &eq(@_)), "\n"; |
| 11 | } |
| 12 | |
| 13 | |
| 14 | sub scale |
| 15 | { |
| 16 | local ($v, $m) = @_; |
| 17 | |
| 18 | return $v*1e-12 if $m eq "p"; |
| 19 | return $v*1e-9 if $m eq "n"; |
| 20 | return $v*1e-6 if $m eq "u"; |
| 21 | return $v*1e-3 if $m eq "m"; |
| 22 | return $v*1e3 if $m eq "k"; |
| 23 | return $v*1e6 if $m eq "M"; |
| 24 | return $v*1e9 if $m eq "G"; |
| 25 | return $v if $m eq ""; |
| 26 | die "unknown multiplier \"$m\""; |
| 27 | } |
| 28 | |
| 29 | |
| 30 | sub compat |
| 31 | { |
| 32 | local ($a, $b) = @_; # $a = part char., $b = component spec. |
| 33 | |
| 34 | return 1 if $a eq $b; |
| 35 | return 0 unless $a =~ /^([0-9.]+)([GMkmunp]?)/; |
| 36 | my ($av, $am, $au) = ($1, $2, $'); |
| 37 | return 0 unless $b =~ /^(>|>=|<|<=)([0-9.]+)([GMkmunp]?)/; |
| 38 | my ($rel, $bv, $bm, $bu) = ($1, $2, $3, $'); |
| 39 | return 0 if $au ne $bu; |
| 40 | $av = &scale($av, $am); |
| 41 | $bv = &scale($bv, $bm); |
| 42 | return $av > $bv if $rel eq ">"; |
| 43 | return $av >= $bv if $rel eq ">="; |
| 44 | return $av < $bv if $rel eq "<"; |
| 45 | return $av <= $bv if $rel eq "<="; |
| 46 | die; |
| 47 | } |
| 48 | |
| 49 | |
| 50 | if ($ARGV[0] eq "-d") { |
| 51 | $debug = 1; |
| 52 | shift @ARGV; |
| 53 | } |
| 54 | &parse; |
| 55 | |
| 56 | $total = 0; |
| 57 | $bad = 0; |
| 58 | |
| 59 | print "#PAR\n"; |
| 60 | for $ref (keys %cmp) { |
| 61 | @f = @{ $cmp{$ref} }; |
| 62 | $total++; |
| 63 | |
| 64 | print STDERR "REF $ref\n" if $debug; |
| 65 | |
| 66 | # if we're lucky, we get a direct ID match |
| 67 | |
| 68 | if (defined $id{$f[0]}) { |
| 69 | print STDERR "FIRST ID\n" if $debug; |
| 70 | &issue($ref, $id{$f[0]}); |
| 71 | next; |
| 72 | } |
| 73 | |
| 74 | # no such luck. Let's roll up our sleeves and to the substitutions. |
| 75 | |
| 76 | undef %field; |
| 77 | $field{"REF"} = $ref; |
| 78 | $field{"VAL"} = $f[0]; |
| 79 | if ($f[1] eq "") { |
| 80 | print STDERR "warning: $ref ($f[0]) has no footprint\n"; |
| 81 | } else { |
| 82 | $field{"FP"} = $f[1]; |
| 83 | } |
| 84 | for (my $i = 1; $i != 10; $i++) { |
| 85 | $field{"F$i"} = $f[$i+1]; |
| 86 | } |
| 87 | &apply_rules(); |
| 88 | |
| 89 | # try our luck again |
| 90 | |
| 91 | if (defined $id{$field{"VAL"}}) { |
| 92 | print STDERR "SECOND ID\n" if $debug; |
| 93 | &issue($ref, $id{$field{"VAL"}}); |
| 94 | next; |
| 95 | } |
| 96 | |
| 97 | # still nothing. Let's match characteristics then. |
| 98 | |
| 99 | my @p = (); |
| 100 | COMP: for my $c (keys %chr) { |
| 101 | print STDERR "PART $c\n" if $debug; |
| 102 | for (keys %field) { |
| 103 | next if $_ eq "REF" || $_ eq "VAL" || $_ =~ /^F\d$/; |
| 104 | next if $field{$_} eq ""; |
| 105 | print STDERR " $_=",$field{$_}," " if $debug; |
| 106 | if (!defined $chr{$c}{$_}) { |
| 107 | print STDERR "NO FIELD\n" if $debug; |
| 108 | next COMP; |
| 109 | next; |
| 110 | } |
| 111 | if (&compat($chr{$c}{$_}, $field{$_})) { |
| 112 | print STDERR "== $chr{$c}{$_}\n" if $debug; |
| 113 | } else { |
| 114 | print STDERR "!= $chr{$c}{$_}\n" if $debug; |
| 115 | next COMP; |
| 116 | } |
| 117 | } |
| 118 | push(@p, $c); |
| 119 | } |
| 120 | if (@p) { |
| 121 | &issue($ref, @p); |
| 122 | next; |
| 123 | } |
| 124 | |
| 125 | print STDERR "unmatched: $ref (", join(", ", @f), ")\n"; |
| 126 | $bad++; |
| 127 | # print join("#", ($ref, @f)), " -> $id{$f[0]}\n"; |
| 128 | } |
| 129 | print STDERR "$bad/$total unmatched\n" if $bad; |
| 130 |
Branches:
master
