scilab/modules/development_tools/src/perl/xml2test/xml2test.pl

   1 #!/usr/bin/perl
   2
   3 # Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
   4 # Copyright (C) 2009-2010 - DIGITEO - Pierre MARECHAL <pierre.marechal@scilab.org>
   5 #
   6 # This file must be used under the terms of the CeCILL.
   7 # This source file is licensed as described in the file COPYING, which
   8 # you should have received as part of this distribution.  The terms
   9 # are also available at
  10 # http://www.cecill.info/licences/Licence_CeCILL_V2.1-en.txt
  11
  12 use strict;
  13 use Cwd;
  14 use File::Basename;
  15 use XML::Simple;
  16
  17 # perl script directory
  18 # ------------------------------------------------
  19
  20 my $directory = getcwd();
  21
  22 if( dirname($0) ne '.' )
  23 {
  24         $directory .= '/'.dirname($0);
  25         $directory =~ s/\/\.\//\//g;
  26 }
  27
  28 if( dirname($0) =~ m/^\// )
  29 {
  30         $directory = dirname($0);
  31 }
  32
  33 # SCI & modules paths
  34 # ------------------------------------------------
  35
  36 my $SCI =  $directory;
  37 $SCI    =~ s/\/modules\/development_tools\/src\/perl\/xml2test//g;
  38
  39 my $sci_modules_dir = $SCI.'/modules';
  40
  41
  42 # Managed languages
  43 # ------------------------------------------------
  44 my %languages;
  45 $languages{'en_US'} = 1;
  46
  47
  48 # Module list
  49 # ------------------------------------------------
  50 my %modules;
  51 if( $ARGV[0] ne '' )
  52 {
  53         $modules{$ARGV[0]} = 1;
  54 }
  55 else
  56 {
  57         %modules = get_module_list();
  58 }
  59
  60 # modules dir path
  61 # ------------------------------------------------
  62
  63 my %valid_tags;
  64 $valid_tags{'File_gateway'} = 1;
  65 $valid_tags{'File_scilab'}  = 1;
  66 $valid_tags{'Lib_name'}     = 1;
  67 $valid_tags{'Func_list'}    = 1;
  68
  69 # # XML list
  70 # ------------------------------------------------
  71 my %xmllist;
  72
  73
  74
  75 # ==============================================================================
  76 # First step : get the XML list
  77 # ==============================================================================
  78
  79 foreach my $module (sort keys %modules)
  80 {
  81         foreach my $language (sort keys %languages)
  82         {
  83                 my $this_directory = $sci_modules_dir.'/'.$module.'/help/'.$language;
  84
  85                 if( -d $this_directory )
  86                 {
  87                         get_xml_list($this_directory,$module);
  88                 }
  89         }
  90 }
  91
  92 # ==============================================================================
  93 # Second step : parse each XML file
  94 # ==============================================================================
  95
  96 my $xmllist_size = 0;
  97
  98 foreach my $xmlfile (sort keys %xmllist)
  99 {
 100         $xmllist_size++;
 101 }
 102
 103 my $count = 0;
 104
 105 foreach my $xmlfile (sort keys %xmllist)
 106 {
 107         $count++;
 108         my $module = $xmllist{$xmlfile};
 109
 110         my $xmlfile_print = 'SCI/modules'.substr($xmlfile,length($sci_modules_dir));
 111         printf('%04d/%04d - %s'."\n",$count,$xmllist_size,$xmlfile_print);
 112         my %tags = get_tag_values($xmlfile);
 113
 114         # Check found tags
 115         # ==========================================================================
 116
 117         foreach my $tag (sort keys %valid_tags)
 118         {
 119                 if( (! exists($tags{$tag}) ) || ($tags{$tag} eq '') )
 120                 {
 121                         print "\t".'ERROR : Tag "'.$tag.'" has not been found in the file "'.$xmlfile.'"'."\n";
 122                         exit(0);
 123                 }
 124
 125                 if( $tag eq 'File_gateway' )
 126                 {
 127                         unless( $tags{$tag} =~ m/^SCI(.)*\.(c|cpp)$/ )
 128                         {
 129                                 print "\t".'ERROR : Value of the tag "'.$tag.'" found in the file "'.$xmlfile.'" is not valid'."\n";
 130                                 exit(0);
 131                         }
 132                 }
 133
 134                 if( $tag eq 'File_scilab' )
 135                 {
 136                         unless( $tags{$tag} =~ m/^SCI(.)*\.(tst)$/ )
 137                         {
 138                                 print "\t".'ERROR : Value of the tag "'.$tag.'" found in the file "'.$xmlfile.'" is not valid'."\n";
 139                                 exit(0);
 140                         }
 141                 }
 142         }
 143
 144         # Get the test content
 145         # ==========================================================================
 146
 147         $tags{'scilab_code'} = get_scilab_code($xmlfile);
 148
 149         if( $tags{'scilab_code'} eq '' )
 150         {
 151                 print "\t".'ERROR : The scilab code has not been found in the file "'.$xmlfile.'"'."\n";
 152                 exit(0);
 153         }
 154
 155         # Get the gateway content
 156         # ==========================================================================
 157
 158         $tags{'gateway_code'} = get_gateway_code($xmlfile);
 159
 160         if( $tags{'gateway_code'} eq '' )
 161         {
 162                 print "\t".'ERROR : The gateway code has not been found in the file "'.$xmlfile.'"'."\n";
 163                 exit(0);
 164         }
 165
 166         # write the gateway code
 167         # ==========================================================================
 168
 169         my $gateway_file = $tags{'File_gateway'};
 170         $gateway_file = $SCI . substr($gateway_file,3);
 171         write_gateway_code($gateway_file,\%tags);
 172         print "\t".'The file "'.$gateway_file.'" code has been created'."\n";
 173
 174
 175         # write the scilab code
 176         # ==========================================================================
 177
 178         my $scilab_file = $tags{'File_scilab'};
 179         $scilab_file = $SCI . substr($scilab_file,3);
 180         write_scilab_code($scilab_file,\%tags);
 181         print "\t".'The file "'.$scilab_file.'" code has been created'."\n";
 182
 183 }
 184
 185
 186
 187 # ==============================================================================
 188 # get_module_list
 189 # ==============================================================================
 190
 191 sub get_module_list
 192 {
 193         my %list;
 194
 195         unless( chdir($sci_modules_dir) )
 196         {
 197                 print 'The directory '.$sci_modules_dir.' doesn\'t exist or read access denied'."\n";
 198                 del_tmp_file();
 199                 exit(0);
 200         }
 201
 202         my @candidates = <*>;
 203
 204         foreach my $candidate (@candidates)
 205         {
 206                 if( -e $sci_modules_dir.'/'.$candidate.'/help' )
 207                 {
 208                         $list{$candidate} = 1;
 209                 }
 210         }
 211
 212         return %list;
 213 }
 214
 215 # ==============================================================================
 216 # get_xml_list
 217 # ==============================================================================
 218
 219 sub get_xml_list
 220 {
 221         my $dir      = $_[0];
 222         my $module   = $_[1];
 223
 224         my @list_dir;
 225
 226         my $current_directory;
 227
 228         # On enregistre le répertoire dans lequel on se situe à l'entrée de la fonction
 229         my $previous_directory = getcwd();
 230
 231         chdir($dir);
 232
 233         @list_dir = <*>;
 234
 235         foreach my $list_dir (@list_dir)
 236         {
 237                 $current_directory = getcwd();
 238
 239                 if( (-d $list_dir) && ( ! ($list_dir =~ m/^scilab_[a-z][a-z]_[A-Z][A-Z]_help$/ )) )
 240                 {
 241                         get_xml_list($current_directory.'/'.$list_dir,$module);
 242                 }
 243
 244                 if( (-f $list_dir)
 245                    && ($list_dir =~ m/\.xml$/)
 246                    && ($list_dir ne 'master.xml')
 247                    && ($list_dir ne 'master_help.xml') )
 248                 {
 249                         unless( open(XMLFILE,$list_dir) )
 250                         {
 251                                 die 'get_xml_list: The file "'.$current_directory.'/'.$list_dir.'" cannot be opened'."\n";
 252                         }
 253
 254                         while(<XMLFILE>)
 255                         {
 256                                 $_ =~ s/^\s+//;
 257                                 $_ =~ s/\s+$//;
 258
 259                                 if( $_ =~ /^<!--File_gateway:\s(.)+-->$/ )
 260                                 {
 261                                         $xmllist{$current_directory.'/'.$list_dir} = $module;
 262                                         last;
 263                                 }
 264                         }
 265
 266                         close(XMLFILE);
 267                 }
 268         }
 269
 270         chdir($previous_directory);
 271 }
 272
 273 # ==============================================================================
 274 # get_tag_values
 275 # ==============================================================================
 276
 277 sub get_tag_values
 278 {
 279         my $xmlfile = $_[0];
 280         my %tags;
 281
 282         unless( open(XMLFILE,$xmlfile) )
 283         {
 284                 die 'get_tag_values: The file "'.$xmlfile.'" cannot be opened'."\n";
 285         }
 286
 287         while(<XMLFILE>)
 288         {
 289                 $_ =~ s/^\s+//;
 290                 $_ =~ s/\s+$//;
 291
 292                 if( $_ =~ /^<!--[A-Z][a-z_]*:\s(.)+-->$/ )
 293                 {
 294                         $_ =~ s/<!--//;
 295                         $_ =~ s/-->//;
 296                         $_ =~ s/^\s+//;
 297                         $_ =~ s/\s+$//;
 298
 299                         my $start = index($_,':');
 300                         my $tag   = substr($_,0,$start);
 301
 302                         if( ! exists($valid_tags{$tag}) )
 303                         {
 304                                 next;
 305                         }
 306
 307                         my $value = substr($_,$start+1);
 308                         $value =~ s/^\s+//;
 309                         $value =~ s/\s+$//;
 310
 311                         $tags{$tag} = $value;
 312                 }
 313         }
 314
 315         close(XMLFILE);
 316
 317         return %tags;
 318 }
 319
 320 # ==============================================================================
 321 # get_gateway_code
 322 # ==============================================================================
 323
 324 sub get_gateway_code
 325 {
 326         my $xmltree = XMLin($_[0]);  # $_[0] : path absolu du fichier XML
 327
 328         my $refsections  = $xmltree->{'refsection'};
 329         my @fields       = @$refsections;
 330
 331         foreach my $field (@fields)
 332         {
 333                 if(  (exists($field->{'programlisting'}->{'role'}) ) &&
 334                    ($field->{'programlisting'}->{'role'} eq 'code_gateway') )
 335                 {
 336                         $field->{'programlisting'}->{'content'} =~ s/\s+\n/\n/g;
 337                         return $field->{'programlisting'}->{'content'}."\n";
 338                 }
 339         }
 340
 341         return '';
 342 }
 343
 344 # ==============================================================================
 345 # get_scilab_code
 346 # ==============================================================================
 347
 348 sub get_scilab_code
 349 {
 350         my $xmltree = XMLin($_[0]);  # $_[0] : path absolu du fichier XML
 351
 352         my $refsections  = $xmltree->{'refsection'};
 353         my @fields       = @$refsections;
 354
 355         foreach my $field (@fields)
 356         {
 357                 if((exists($field->{'programlisting'}->{'role'}) )
 358                    && ($field->{'programlisting'}->{'role'} eq 'code_scilab'))
 359                 {
 360                         my $scilab_code = $field->{'programlisting'}->{'content'}."\n";
 361                         $scilab_code =~ s/\s+\n/\n/g;
 362                         $scilab_code =~ s/then(\s)+error\((\s)*\"failed\"(\s)*\)(\s)*[;,](\s)*end/then pause;end/g;
 363                         return $scilab_code;
 364                 }
 365         }
 366
 367         return '';
 368 }
 369
 370 # ==============================================================================
 371 # write_gateway_code
 372 # ==============================================================================
 373
 374 sub write_gateway_code
 375 {
 376         my $fileout = $_[0];
 377         my $tagsref = $_[1];
 378         my %tags    = %$tagsref;
 379
 380         unless( open(FILEOUT,'> '.$fileout) )
 381         {
 382                 print "\t".'Le fichier "'.$fileout.'" n\'a pu être ouvert en écriture'."\n";
 383                 exit(0);
 384         }
 385
 386         # Ecriture de l'entête
 387         # ==========================================================================
 388
 389         unless( open(LICENSE,$directory.'/gateway_code_license.txt') )
 390         {
 391                 print "\t".'Le fichier "'.$directory.'/gateway_code_license.txt" n\'a pu être ouvert en lecture'."\n";
 392                 exit(0);
 393         }
 394
 395         while(<LICENSE>)
 396         {
 397                 print FILEOUT $_;
 398         }
 399
 400         close(LICENSE);
 401
 402         # Ecriture des includes
 403         # ==========================================================================
 404
 405         unless( open(INCLUDES,$directory.'/includes.txt') )
 406         {
 407                 print "\t".'Le fichier "'.$directory.'/includes.txt" n\'a pu être ouvert en lecture'."\n";
 408                 exit(0);
 409         }
 410
 411         while(<INCLUDES>)
 412         {
 413                 print FILEOUT $_;
 414         }
 415
 416         close(INCLUDES);
 417
 418         # Ecriture du code
 419         # ==========================================================================
 420         $tags{'gateway_code'} =~ s/\s+\n/\n/g;
 421         print FILEOUT $tags{'gateway_code'};
 422
 423         # Fermeture du fichier de sortie
 424         # ==========================================================================
 425         close(FILEOUT);
 426 }
 427
 428 # ==============================================================================
 429 # write_scilab_code
 430 # ==============================================================================
 431
 432 sub write_scilab_code
 433 {
 434         my $fileout = $_[0];
 435         my $tagsref = $_[1];
 436         my %tags    = %$tagsref;
 437
 438         # TMPDIR management
 439         # ==========================================================================
 440
 441         my $TMPDIR = basename($fileout);
 442         $TMPDIR  =~ s/\.tst$//g;
 443         $TMPDIR  = 'pathconvert(TMPDIR+"/'.$TMPDIR.'")';
 444
 445         # table management (ilib_build 2nd input argument)
 446         # ==========================================================================
 447
 448         my @functions = split(/,/,$tags{'Func_list'});
 449
 450         my $table_str = '[';
 451
 452         for( my $i=0 ; $i<length(@functions) ; $i++ )
 453         {
 454                 if( $i > 0)
 455                 {
 456                         $table_str .= ';';
 457                 }
 458
 459                 $table_str .= '"'.$functions[$i].'","'.$functions[$i].'"';
 460         }
 461
 462         $table_str .= ']';
 463
 464
 465         # C file management
 466         # ==========================================================================
 467
 468         my $cfile         = 'SCI+"'.substr($tags{'File_gateway'},3).'"';
 469
 470         my $cfiletmpdir   = basename($fileout);
 471         $cfiletmpdir      =~ s/\.tst$//g;
 472         $cfiletmpdir      =  'pathconvert(TMPDIR+"/'.$cfiletmpdir.'/'.basename(substr($tags{'File_gateway'},3)).'",%F)';
 473
 474         # Open the fileout file
 475         # ==========================================================================
 476
 477         unless( open(FILEOUT,'> '.$fileout) )
 478         {
 479                 print "\t".'Le fichier "'.$fileout.'" n\'a pu être ouvert en écriture'."\n";
 480                 exit(0);
 481         }
 482
 483         # Ecriture de l'entête
 484         # ==========================================================================
 485
 486         unless( open(LICENSE,$directory.'/scilab_code_license.txt') )
 487         {
 488                 print "\t".'Le fichier "'.$directory.'/scilab_code_license.txt" n\'a pu être ouvert en lecture'."\n";
 489                 exit(0);
 490         }
 491
 492         while(<LICENSE>)
 493         {
 494                 print FILEOUT $_;
 495         }
 496
 497         close(LICENSE);
 498
 499         # Ecriture de la ligne ilib_build
 500         # ==========================================================================
 501
 502         print FILEOUT 'ilib_verbose(0);'."\n";
 503         print FILEOUT 'mkdir('.$TMPDIR.');'."\n";
 504         print FILEOUT 'cd('.$TMPDIR.');'."\n";
 505         print FILEOUT 'copyfile('.$cfile.','.$cfiletmpdir.');'."\n";
 506         print FILEOUT 'cflags = "-I"+SCI+"/modules/localization/includes";'."\n";
 507
 508         print FILEOUT 'ilib_build(';
 509         print FILEOUT '"'.$tags{'Lib_name'}.'",';                          # lib_name
 510         print FILEOUT $table_str.',';                                      # table
 511         print FILEOUT '"'.basename(substr($tags{'File_gateway'},3)).'",';  # files
 512         print FILEOUT '[],';                                               # libs
 513         print FILEOUT '"",';                                               # makename
 514         print FILEOUT '"",';                                               # ldflags
 515         print FILEOUT 'cflags);'."\n";                                     # cflags
 516
 517         print FILEOUT 'exec("loader.sce");'."\n";
 518
 519         # Ecriture du code
 520         # ==========================================================================
 521         print FILEOUT $tags{'scilab_code'};
 522
 523         # Fermeture du fichier de sortie
 524         # ==========================================================================
 525         close(FILEOUT);
 526 }