eda-tools/old-boom/bom2part

#!/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;