rescue files from svn.openmoko.org

old-boom/bom2part

@@ -0,0 +1,129 @@
+#!/usr/bin/perl
+
+require "parser.pl";
+require "match.pl";
+require "misc.pl";
+
+
+sub issue
+{
+    print shift(@_), " ", join(" ", @_, &eq(@_)), "\n";
+}
+
+
+sub scale
+{
+    local ($v, $m) = @_;
+
+    return $v*1e-12 if $m eq "p";
+    return $v*1e-9 if $m eq "n";
+    return $v*1e-6 if $m eq "u";
+    return $v*1e-3 if $m eq "m";
+    return $v*1e3 if $m eq "k";
+    return $v*1e6 if $m eq "M";
+    return $v*1e9 if $m eq "G";
+    return $v if $m eq "";
+    die "unknown multiplier \"$m\"";
+}
+
+
+sub compat
+{
+    local ($a, $b) = @_;	# $a = part char., $b = component spec.
+
+    return 1 if $a eq $b;
+    return 0 unless $a =~ /^([0-9.]+)([GMkmunp]?)/;
+    my ($av, $am, $au) = ($1, $2, $');
+    return 0 unless $b =~ /^(>|>=|<|<=)([0-9.]+)([GMkmunp]?)/;
+    my ($rel, $bv, $bm, $bu) = ($1, $2, $3, $');
+    return 0 if $au ne $bu;
+    $av = &scale($av, $am);
+    $bv = &scale($bv, $bm);
+    return $av > $bv if $rel eq ">";
+    return $av >= $bv if $rel eq ">=";
+    return $av < $bv if $rel eq "<";
+    return $av <= $bv if $rel eq "<=";
+    die;
+}
+
+
+if ($ARGV[0] eq "-d") {
+    $debug = 1;
+    shift @ARGV;
+}
+&parse;
+
+$total = 0;
+$bad = 0;
+
+print "#PAR\n";
+for $ref (keys %cmp) {
+    @f = @{ $cmp{$ref} };
+    $total++;
+
+    print STDERR "REF $ref\n" if $debug;
+
+    # if we're lucky, we get a direct ID match
+
+    if (defined $id{$f[0]}) {
+	print STDERR "FIRST ID\n" if $debug;
+	&issue($ref, $id{$f[0]});
+	next;
+    }
+
+    # no such luck. Let's roll up our sleeves and to the substitutions.
+
+    undef %field;
+    $field{"REF"} = $ref;
+    $field{"VAL"} = $f[0];
+    if ($f[1] eq "") {
+	print STDERR "warning: $ref ($f[0]) has no footprint\n";
+    } else {
+	$field{"FP"} = $f[1];
+    }
+    for (my $i = 1; $i != 10; $i++) {
+	$field{"F$i"} = $f[$i+1];
+    }
+    &apply_rules();
+
+    # try our luck again
+
+    if (defined $id{$field{"VAL"}}) {
+	print STDERR "SECOND ID\n" if $debug;
+	&issue($ref, $id{$field{"VAL"}});
+	next;
+    }
+
+    # still nothing. Let's match characteristics then.
+
+    my @p = ();
+    COMP: for my $c (keys %chr) {
+	print STDERR "PART $c\n" if $debug;
+	for (keys %field) {
+	    next if $_ eq "REF" || $_ eq "VAL" || $_ =~ /^F\d$/;
+	    next if $field{$_} eq "";
+	    print STDERR "  $_=",$field{$_}," " if $debug;
+	    if (!defined $chr{$c}{$_}) {
+		print STDERR "NO FIELD\n" if $debug;
+		next COMP;
+		next;
+	    }
+	    if (&compat($chr{$c}{$_}, $field{$_})) {
+		print STDERR "== $chr{$c}{$_}\n" if $debug;
+	    } else {
+		print STDERR "!= $chr{$c}{$_}\n" if $debug;
+		next COMP;
+	    }
+	}
+	push(@p, $c);
+    }
+    if (@p) {
+	&issue($ref, @p);
+	next;
+    }
+
+    print STDERR "unmatched: $ref (", join(", ", @f), ")\n";
+    $bad++;
+#    print join("#", ($ref, @f)), " -> $id{$f[0]}\n";
+}
+print STDERR "$bad/$total unmatched\n" if $bad;