utils/scripts/gschupdate

   1 #!/usr/bin/perl
   2
   3 # gEDA - GPL Electronic Design Automation
   4 # gsymupdate - gEDA Symbol Update
   5 # Copyright (C) 2002 Ales V. Hvezda
   6 #
   7 # This program is free software; you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 2 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # This program is distributed in the hope that it will be useful,
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program; if not, write to the Free Software
  19 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  20 #
  21
  22 #
  23 # This program takes a schematic filename on the command line and outputs an
  24 # update schematic to stdout.
  25 #
  26 # This program only changes the label= attribute on nets to netname=
  27 #
  28 # Right now this program should only be run against schematics which are
  29 # either version 20020527 or earlier.
  30 #
  31
  32 print "gEDA/gschupdate version 0.2\n";
  33 print "gEDA/gschupdate comes with ABSOLUTELY NO WARRANTY; see COPYING for more details\n";
  34 print "This is free software, and you are welcome to redistribute it under certain\n";
  35 print "conditions; please see the COPYING file for more details.\n\n";
  36
  37 $numArgs = $#ARGV + 1;
  38 if ($numArgs < 1) {
  39     print "Usage: gschupdate filename1 filename2 ... filenameN\n";
  40     exit;
  41 }
  42
  43
  44 foreach $filename (@ARGV) {
  45
  46     if (-r "$filename.old") {
  47       print "Found backup file: $filename.old.  Not gschUpdating $filename\n";
  48     } else {
  49         rename ($filename, "$filename.old");
  50         print "gschUpdating: $filename (backup: $filename.old)\n";
  51
  52
  53         open (FILE, "$filename.old") || die "Cannot open input file: $filename.old  Exiting.\n";
  54     open (NEWFILE, ">$filename") || die "Cannot open output file: $filename Exiting.\n";
  55
  56
  57         while (<FILE>) {
  58
  59             # handle text objects
  60             if (/^T/) {
  61
  62                 $textcmd = $_;
  63
  64                 $textline = <FILE>;
  65
  66                 # are we dealing with an attribute?
  67                 if ($textline =~ /=/) {
  68
  69                     # Break the attribute up into name=value
  70                     @attrib = split(/=/,$textline,2);
  71                     $name=@attrib[0];
  72                     $value=@attrib[1];
  73
  74                     if ($name =~ /^label/) {
  75
  76                         # It is a label attribute
  77                         print NEWFILE $textcmd;
  78                         print NEWFILE "netname=$value";
  79
  80                     } elsif ($name =~ /^uref/) {
  81
  82                         # It is a uref= attribute, convert to refdes=
  83                         print NEWFILE $textcmd;
  84                         print NEWFILE "refdes=$value";
  85
  86                     } else {
  87                         # none of the above, just pass it through
  88                         print NEWFILE $textcmd;
  89                         print NEWFILE $textline;
  90                     }
  91
  92                 } else {
  93                     # not an attribute
  94                     print NEWFILE $textcmd;
  95                     print NEWFILE $textline;
  96                 }
  97
  98             } else {
  99                 # It is not a text, so pass it through
 100                 print NEWFILE;
 101             }
 102
 103         }
 104         close $FILE;
 105         close $NEWFILE;
 106
 107         # Load and Save the file using gschlas
 108         # This updates the file to be absolutely current
 109         system("gschlas $filename");
 110         @args = ("gschlas", "$filename");
 111         system(@args) == 0 || die "system @args failed: $?"
 112     }
 113 }
 114
 115