#!/usr/bin/perl

# gEDA - GPL Electronic Design Automation
# gsymupdate - gEDA Symbol Update 
# Copyright (C) 2002 Ales V. Hvezda
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111 USA
#

#
# This program takes a schematic filename on the command line and outputs an 
# update schematic to stdout.  
#
# This program only changes the label= attribute on nets to netname=
#
# Right now this program should only be run against schematics which are 
# either version 20020527 or earlier.
#

print "gEDA/gschupdate version 0.2\n";
print "gEDA/gschupdate comes with ABSOLUTELY NO WARRANTY; see COPYING for more details\n";
print "This is free software, and you are welcome to redistribute it under certain\n";
print "conditions; please see the COPYING file for more details.\n\n";

$numArgs = $#ARGV + 1;
if ($numArgs < 1) {
    print "Usage: gschupdate filename1 filename2 ... filenameN\n";
    exit;
}


foreach $filename (@ARGV) {

    if (-r "$filename.old") { 
      print "Found backup file: $filename.old.  Not gschUpdating $filename\n";
    } else {
        rename ($filename, "$filename.old");
        print "gschUpdating: $filename (backup: $filename.old)\n";


        open (FILE, "$filename.old") || die "Cannot open input file: $filename.old  Exiting.\n";
    open (NEWFILE, ">$filename") || die "Cannot open output file: $filename Exiting.\n";


        while (<FILE>) {

            # handle text objects
            if (/^T/) { 

                $textcmd = $_;

                $textline = <FILE>;

                # are we dealing with an attribute?
                if ($textline =~ /=/) {  

                    # Break the attribute up into name=value
                    @attrib = split(/=/,$textline,2);
                    $name=@attrib[0];
                    $value=@attrib[1];

                    if ($name =~ /^label/) {

                        # It is a label attribute
                        print NEWFILE $textcmd;
                        print NEWFILE "netname=$value";

                    } elsif ($name =~ /^uref/) {

                        # It is a uref= attribute, convert to refdes=
                        print NEWFILE $textcmd;
                        print NEWFILE "refdes=$value";

                    } else {
                        # none of the above, just pass it through
                        print NEWFILE $textcmd;
                        print NEWFILE $textline;
                    }

                } else {
                    # not an attribute
                    print NEWFILE $textcmd;
                    print NEWFILE $textline;
                }

            } else {
                # It is not a text, so pass it through
                print NEWFILE;
            }

        }
        close $FILE;
        close $NEWFILE;

        # Load and Save the file using gschlas
        # This updates the file to be absolutely current
        system("gschlas $filename");
        @args = ("gschlas", "$filename");
        system(@args) == 0 || die "system @args failed: $?"
    }
}


