[Author Prev][Author Next][Thread Prev][Thread Next][Author Index][Thread Index]
Re: gEDA-user: Component sourcing script
I've attached my make-bom and update-digikey scripts for your
entertainment. The output "board.digikey.bom" can be uploaded
directly to Digikey's master order module.
#!/usr/bin/perl
# -*- perl -*-
$boards = 1;
$output = 'board.bom';
while ($ARGV[0] =~ /^-/) {
$opt = shift;
if ($opt eq "-q") {
$boards = shift;
} elsif ($opt eq "-o") {
$output = shift;
}
}
$sch = join(' ', @ARGV);
$me = $0;
$me =~ s@[^/]+$@@;
open(A, ">attribs");
print A "value\n";
print A "manufacturer\n";
print A "manufacturer_part_number\n";
print A "vendor\n";
print A "vendor_part_number\n";
#print A "price\n";
close A;
system "gnetlist -g bom2 -o $output $sch";
sub load_vendors {
for $vendorfile ("$me/digikey.csv", "$me/mouser.csv") {
open(DK, $vendorfile);
$cols = scalar <DK>;
while (<DK>) {
chomp;
($mfg, $mfgpn, $value, $vend, $vendpn, $price, $minqty) = split(':');
$mfg{$mfgpn} = $mfg;
if ($price{$mfgpn} == 0
|| $price{$mfgpn} > $price) {
$vendor{$mfgpn} = $vend;
$vendpn{$mfgpn} = $vendpn;
$price{$mfgpn} = $price;
$minqty{$mfgpn} = $minqty;
}
}
close DK;
}
}
&load_vendors ();
open(B, $output);
$junk = <B>;
while (<B>) {
chop;
($refs, $value, $mfg, $partno, $vendor, $vpartno) = split(':');
$vp = "$partno\0$value";
if ($remvalue{$partno}
&& $remvalue{$partno} ne $value
&& $partno ne "unknown") {
print STDERR "Warning: value for part $partno changed\n";
print STDERR " old: $remvalue{$partno}\n";
print STDERR " new: $value\n";
}
$remvalue{$partno} = $value;
$value{$vp} = $value;
$mfg{$vp} = $mfg;
@refs = split(',', $refs);
$count{$vp} += scalar @refs;
$vl = length($vendpn{$partno}) if $vl < length($vendpn{$partno});
if (!$vendpn{$partno} && $vpartno ne "unknown") {
print "Adding part $vpartno to vendor $vendor\n";
$vendpn{$partno} = $vpartno;
open(V, ">>$me/$vendor.csv");
print V "${mfg}:${partno}:${value}:${vendor}:${vpartno}::\n";
close V;
$reload_vendors = 1;
}
}
close B;
if ($reload_vendors) {
system "cd $me; ./update-digikey";
&load_vendors ();
}
if (0) {
open(I, "$me/inventory.csv");
$junk = <I>;
while (<I>) {
chop;
($qty, $mfg, $part) = split(/\t+/);
$inventory{"$mfg\0$part"} = $qty;
}
close I;
}
print "\n";
open(DIGIKEY, ">board.digikey.bom");
$ci = 0;
for $vp (sort keys %count) {
($partno,$value) = split(/\0/, $vp);
$count = $count{$vp} * $boards;
$i = $inventory{$mfg{$vp} . "\0" . $partno};
if ($i > $count) {
$i = $count;
}
if ($i > 0) {
print STDERR " - using $i $mfg{$vp} $partno ($value) from inventory\n";
$count -= $i;
}
$m = $minqty{$partno};
if ($m == 0) {
#print "$partno: m is zero\n";
$m = 1;
}
$count = $m * int(($count + $m - 1) / $m);
$cost = $count * $price{$partno};
$total_cost += $cost;
$scost = sprintf("%010d", $cost*100);
if ($cost == 0) {
$cost = "";
} else {
$cost = sprintf "\$%.2f", $cost + 0.0049;
}
push(@lines, sprintf("%s\0%3d %3d %6s %-4.4s %-${vl}s %-10.10s %s (%s) \n",
"$scost $mfg{$vp} $partno",
$count{$vp} * $boards, $count, $cost,
$vendor{$partno}, $vendpn{$partno},
$mfg{$vp}, $partno, $value{$vp}));
if ($vendor{$partno} =~ /digikey/i && $count > 0) {
push(@digikey, sprintf ("%s\0%s\t%s\t%s\r\n",
"$scost $mfg{$vp} $partno",
$count,
$vendpn{$partno},
"$mfg{$vp} $partno ($value{$vp})"));
}
}
for $l (sort @lines) {
$l =~ s/.*\0//;
&color(($ci++) % 8 < 4 ? 33 : 0);
print $l;
}
for $l (sort @digikey) {
$l =~ s/.*\0//;
print DIGIKEY $l;
}
&color(0);
sub color {
my($c) = @_;
if ($c ne $old_c) {
print "\033[${c}m";
$old_c = $c;
}
}
$c = sprintf("\$%.2f", $total_cost + 0.0049);
printf "\n %9s Total Cost\n", $c;
----------------------------------------------------------------------
#!/usr/bin/perl
# -*- perl -*-
open(DK, "digikey.csv");
open(NEW, ">digikey.csv.new");
open(QTY, ">digikey.qty");
print NEW scalar <DK>;
while (<DK>) {
chomp;
($mfg, $mfgpn, $desc, $vend, $vendpn, $price, $minqty) = split(':');
next unless $vendpn;
next unless $vend =~ /digikey/i;
print STDERR "\n\033[32mpart $vendpn\033[0m\n";
$first = 1;
@search = &search_digikey ($vendpn);
$hc = 0;
$in_table = 0;
for $l (@search) {
chomp $l;
if (0) {
if ($l =~ /Price( | )Break/) {
$l =~ s/.*Price( | )Break//;
if (/Unit[^<]*Price/) {
s/>Price<.*//g;
}
($qtytd, $pricetd) = split(/<TD[^>]*>/i, $l);
$qtytd = &cleantab($qtytd);
$pricetd =~ s/.*Price//;
$pricetd = &cleantab($pricetd);
print STDERR "qty [$qtytd] price [$pricetd]\n";
($minqty) = split(' ', $qtytd);
($price) = split(' ', $pricetd);
if ($qtytd =~ /\d/) {
@qtys = split(' ', $qtytd);
@prices = split(' ', $pricetd);
$any = 0;
for ($i=0; $i<3; $i++) {
$any = 1;
$p = $qtys[$i] * $prices[$i];
$p = sprintf("%.2f", $p);
printf QTY "%4d: %s\t", $qtys[$i], $p;
}
$m = substr($mfg,0,7);
print QTY "$m\t$mfgpn\t$vendpn\t$desc\n" if $any;
}
}
}
if (1) { # "new" search
if ($l =~ /Price Break/) {
$in_table = 1;
$minqty = 0;
}
if ($l =~ m@</table>@) {
$in_table = 0;
}
if ($in_table
&& $l =~ m@<td align=center>@) {
$l =~ s/<[^>]*>/ /g;
print STDERR $l;
($qty, $each) = split(' ', $l);
$qty =~ s/,//g;
$each =~ s/,//g;
print STDERR "qty <$qty> each <$each>\n";
if ($qty < $minqty || $minqty == 0) {
$minqty = $qty;
$price = $each;
}
}
}
}
print NEW "$mfg:$mfgpn:$desc:$vend:$vendpn:$price:$minqty\n";
}
close NEW;
sub cleantab {
my ($q) = @_;
$q =~ s/<[^>]*>/ /g;
$q =~ s/ +/ /g;
$q =~ s/^ //;
$q =~ s/ $//;
return $q;
}
sub search_digikey {
my ($str) = join('+', @_);
my (@rv, $sn);
$str =~ s@\#@\%23@g;
$str =~ s@\+@\%2b@g;
$sn = $str;
$sn =~ s@/@_@;;
$cache = "digikey/$sn.html";
if ( -s $cache < 1500) {
unlink $cache;
}
printf("cache = <$cache>\n");
if ( ! -f $cache ) {
sleep 2;
system "wget -q -O $cache 'http://www.digikey.com/scripts/DkSearch/dksus.dll?Detail?name=$str'";
#system "wget -q -O $cache 'http://www.digikey.com/scripts/dksearch/dksus.dll?KeywordSearch&Site=US&KeyWords=$str&MfcISAPICommand=KeywordSearch'";
}
open(W, $cache);
@rv = <W>;
close W;
return @rv;
}
system "mv digikey.csv digikey.csv.old";
system "mv digikey.csv.new digikey.csv";
_______________________________________________
geda-user mailing list
geda-user@xxxxxxxxxxxxxx
http://www.seul.org/cgi-bin/mailman/listinfo/geda-user