groot/perl/PurgeVias.pl

0001 #! /usr/bin/perl -w

0002 #

0003 #  This script is used to identify any layer 1-13 vias inside the

0004 #  connector blocks and change them to have an extent of only 1-8.

0005 #

0006 use strict;
0007 use CGI qw(:standard);
0008
0009 open (OLD, "<", "StonyBrookUniversity-R2pad-Rev_B-extraVia.brd") or die "Can't open original file $!/n";
0010 open (NEW, ">", "StonyBrookUniversity-R2pad-Rev_B-cleanVia.brd") or die "Can't open original file $!/n";
0011
0012 my %PadMap;
0013
0014 my $CurrentSignal="NOSIGNAL";
0015 my @X=();
0016 my @Y=();
0017 my @ViaBuffer=();
0018
0019 while (<OLD>)
0020 {
0021     my $line = $_;
0022
0023     if ($line =~ /<signal name/)
0024     {
0025     my @lineValues = split(/"/,$line);

0026     $CurrentSignal = $lineValues[1];

0027     @X=();

0028     @Y=();

0029     @ViaBuffer=();

0030     }

0031

0032     my $WriteCurrentLine = "true";

0033     if ($CurrentSignal =~ /ZZ/ && $line =~ /<via/ && $line =~ /extent=\"2-15\"/)

0034     {

0035     push @ViaBuffer, $line;

0036     $WriteCurrentLine = "false";

0037     }

0038

0039     if ($CurrentSignal =~ /ZZ/ && $line =~ /<wire/ && $line =~ /layer=\"2\"/)

0040     {

0041     my @WireDetails = split(/"/,$line);
0042     push @X, $WireDetails[1], $WireDetails[5];
0043     push @Y, $WireDetails[3], $WireDetails[7];
0044     }
0045
0046     if ($CurrentSignal =~ /ZZ/ && $line =~ /<\/signal/)
0047     {
0048     #print "$CurrentSignal\n";

0049     foreach my $via (@ViaBuffer)
0050     {
0051         my @ViaDetails = split(/"/,$via);

0052         my $viax = $ViaDetails[1];

0053         my $viay = $ViaDetails[3];

0054         my $Layer2Matches = 0;

0055         #print "$viax  $viay\n";

0056         for (my $i=0; $i <= $#X; $i++)

0057         {

0058         #print "    $X[$i]  $Y[$i]\n";

0059         if (($X[$i] == $viax) && ($Y[$i] == $viay))

0060         {

0061             $Layer2Matches++;

0062         }

0063         }

0064         #print "Matches = $Layer2Matches\n";

0065         if ($Layer2Matches < 2)

0066         {

0067         print NEW $via;

0068         }

0069         else

0070         {

0071         print "Killed an Extraneous Via!!\n";

0072         }

0073     }

0074     }

0075

0076     if ($WriteCurrentLine =~ /true/)

0077     {

0078     print NEW $line;

0079     }

0080 }

0081 close (OLD);

0082 close (NEW);