[cleanup] stackxxx.h removed
[scilab.git] / 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 }