#!perl
$|=1;
#**************************************************************************************#
#-------------------------------------------------------------------------------------#
# 1_to_16.pl
#-------------------------------------------------------------------------------------#
# This script is modifying the number of the objects in the sgf:
# -objects with sequence $old_numb are changed to $new_numb (e.g. s01_01_arc is replaced by s16_01_arc)
# -objects in the sequences before $new_numb are moved one number before (e.g. s16_00_Backgroundrectange is replaced by s15_00_Backgroundrectange
#
# The script requires 3 arguments:
# 1= the name of the file, 2=$new_numb, 3=$old_numb
# if any is omitted the default value for $old_numb is 1 and the one for $new_numb is 16
#**************************************************************************************#
PROCESS_ARGUMENTS: {
($path,$new_numb,$old_numb) = @ARGV;
defined ($old_numb) or (print("Enter the old number: ") and chomp($old_numb=<STDIN>) and print("\n") );
defined ($new_numb) or (print("Enter the new number: ") and chomp($new_numb=<STDIN>) and print("\n") );
#print "The path is: $path\n"; #for_debug
if ($path =~ m%[\\\/](\w+\.(\w+))$%) {
if ($2 eq "sgf") {$file=$1;print "The file name is: $file\n";} #the file is only assigned for sgf. In other case, we can choose among available sgf
$path =~ s%$1%%; #delete the name of the file from the path
}
if ($path =~ m%^(\w:[\\\/\w]*\w+)([\\\/]?)$%) {
$path = $1; #delete the potential "\" or "/" at the end of the directory
print "The root folder is: $path\n"; #for_debug
chdir "$path"; #the argument is the name of a folder
}
unless (defined $file) { #we choose the name of the file from a list
my @list_sgf=glob "*.sgf";
print "\n** Please, enter the name of the file **\nThe available files are : \n","-"x 20,"\n";
$n_file=0; #the number to identify the file where the user can choose from
foreach (@list_sgf) {++$n_file;print "$n_file.: $_\n";}
print "-"x 20,"\nChoose the file you want as an argument: ";
$file = $list_sgf[<STDIN>-1];
print "The file chosen is $file\n\n";
} #end of unless
} #end of block PROCESS_ARGUMENTS
print "\n****** Beginning of the reprocessing of SGF ($old_numb to $new_numb) ******\n";
$file = $ARGV[0] or die "Missing name of the file as argument";
$new_file = $file; #the name of the file to write the modified file in
$new_file =~ s%\.sgf%_bis\.sgf%;
CHANGE_NUMBERS: {
open SGF, "<$file" or die "Error while opening $file ($!)\n";
@temporary_file=(); #temporary buffer to copy in the file
$line=0;
while (<SGF>) {
++$line;
# print "Line : $_"; #for_debug
if (/<node.*name="(.*)" type="(.*)" visible/) { #node different from synchronous layer
my $object_name=$1;my $type=$2; #define the type and the name
# print "*Hello, object_name: $object_name object_type: $type*\n"; #for_debug
if ($type =~ /container/) { die "Container object found ($!)\n"; #there shouldn't be any container in the model
} elsif ($type eq "synchronous_layer") {
# print "Synchronous Layer found (line $line)\n"; #for_debug
}elsif ($object_name =~ m/^s(\d{2})_(\d{2})_/) {
my $n=$1; #find the number of the group : $n
# print "Object found : $object_name (line $line)\n"; #for_debug
if ($n == $old_numb) {s/s$n/sprintf("s%02d",$new_numb)/e; #replace 1 by 16
}else { unless (($n > $new_numb)or($n<$old_numb)) {s/s$n/sprintf("s%02d",$n - 1)/e;}}
} else {} #we do nothing otherwise
} #end of if
push(@temporary_file,$_);#copy the lines in the temporary file
} #end of while
close SGF;
open SGF_MODIF, ">$new_file" or die "Error while opening $new_file for modificiation ($!)\n";
print SGF_MODIF @temporary_file;print "**Save renumbered sgf in $new_file**\n"; #for_debug
close SGF_MODIF;
}#end of block CHANGE_NUMBERS
ORDER_OBJECTS:{ #last ORDER_OBJECTS; #order by name of objects (lexical order) => to improve
print LOG "*"x 59,"\n","*"x 25," ORDER ","*"x 25,"\n","*"x 59,"\n"; #to print in the log file
open SGF, "<$new_file" or die "Error while opening $file ($!)\n";
print "-Opening of the file with the new sequence\n";
@temporary_file=(); #temporary buffer to copy in the file
%objects=(); #hash table with all the objects in the sgf
$line=0;
while (<SGF>) {
++$line;
# print "Line : $_"; #for_debug
if (/<node.*name="(.*)" type="(.*)" visible/) { #node different from synchronous layer
my $object_name=$1;my $type=$2; #define the type and the name
#print "*Hello, object_name: $object_name object_type: $type*\n"; #for_debug
if ($type =~ /container/) { die "Container object found ($!)\n"; #there shouldn't be any container in the model
} elsif ($type eq "synchronous_layer") {
print LOG "Synchronous Layer found (line $line)\n"; #for_debug
}else {
$spec_obj="$_"; #the specification of the object is reset to the first line read of the object
print LOG "Object found : $object_name (line $line)\n"; #for_debug
while (<SGF>) {
++$line;
$spec_obj=$spec_obj . "$_"; #we add the line in the temporary object
if (m%<\/node>%) { last;}#the end of the node is reached
#print "Line read ($line): $_"; #for_debug
} #end of while
$_=""; #we delete the content of the line
# print LOG "--$object_name--\n","*"x 70,"\n",$spec_obj,"\n"; #for_debug
$objects{$object_name}=$spec_obj;
#print "Temp object:",@temp_obj,"\n"; #for_debug
} #else {die "PROBLEM OF NODE ($!)\n";}#end of elsif
}elsif (m%<\/node>%) { #end of symbology layer => we put the objects in order
$line=$_; #copy the content of the line to copy it later
@objects_list=sort(keys %objects); #sort the objects in order
print LOG "**The sorted objects are:\n";foreach (@objects_list) {print LOG "$_\n";} #for_debug
foreach $obj (@objects_list) {push(@temporary_file,$objects{$obj});} #end of foreach object
$_=$line; #copy back the content of the line into $_
} #end of elsif
push(@temporary_file,$_);#copy the lines in the temporary file
} #end of while
close SGF;
open SGF_MODIF, ">$new_file" or die "Error while opening $new_file for modificiation ($!)\n";
print SGF_MODIF @temporary_file;print "**Save ordered sgf in $new_file\n"; #for_debug
close SGF_MODIF;
print LOG "*"x 59,"\n","*"x 22," END OF ORDER ","*"x 23,"\n","*"x 59,"\n"; #to print in the log file
}#end of block ORDER_OBJECTS
#-----------------------------------------------------------------------------------------------------------------------
{#-----------------------------------------------------subroutines-------------------------------------------------------
sub print_hash { #print Hash Table
my ($tab1,$tab2,%hash)=@_;
my @keys=sort keys %hash;
print "\n","-" x 150,"\n\n";
printf("%-42s %5s\n", $tab1, $tab2);
printf("%-42s %5s\n", "-"x6, "-------");
foreach (@keys) {
printf("%-30s %-s\n", $_, $hash{$_});
} #end of foreach
print "\n","-" x 150, "\n";
} #end of subroutines to print hash tables
}#end of subroutines
#---------------------------------------------------------------------------------------------------------------------------------