d961266ec73242c455ed6e7ec3582cdefb76c7d8
[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 - 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-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 }
26
27 if( dirname($0) =~ m/^\// )
28 {
29         $directory = dirname($0);
30 }
31
32 # SCI & modules paths
33 # ------------------------------------------------
34
35 my $SCI =  $directory;
36 $SCI    =~ s/\/modules\/development_tools\/src\/perl\/xml2test//g;
37
38 #print "\t".'ERROR : Tag "'.$tag.'" has not been found in the file "'.$xmlfile.'"'."\n";
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                                 print 'Le fichier "'.$current_directory.'/'.$list_dir.'" n\'a pu être ouvert en lecture'."\n";
252                                 exit(0);
253                         }
254                         
255                         while(<XMLFILE>)
256                         {
257                                 $_ =~ s/^\s+//;
258                                 $_ =~ s/\s+$//;
259                                 
260                                 if( $_ =~ /^<!--File_gateway:\s(.)+-->$/ )
261                                 {
262                                         $xmllist{$current_directory.'/'.$list_dir} = $module;
263                                         last;
264                                 }
265                         }
266                         
267                         close(XMLFILE);
268                 }
269         }
270         
271         chdir($previous_directory);
272 }
273
274 # ==============================================================================
275 # get_tag_values
276 # ==============================================================================
277
278 sub get_tag_values
279 {
280         my $xmlfile = $_[0];
281         my %tags;
282         
283         unless( open(XMLFILE,$xmlfile) )
284         {
285                 print 'Le fichier "'.$xmlfile.'" n\'a pu être ouvert en lecture'."\n";
286                 exit(0);
287         }
288         
289         while(<XMLFILE>)
290         {
291                 $_ =~ s/^\s+//;
292                 $_ =~ s/\s+$//;
293                 
294                 if( $_ =~ /^<!--[A-Z][a-z_]*:\s(.)+-->$/ )
295                 {
296                         $_ =~ s/<!--//;
297                         $_ =~ s/-->//;
298                         $_ =~ s/^\s+//;
299                         $_ =~ s/\s+$//;
300                         
301                         my $start = index($_,':');
302                         my $tag   = substr($_,0,$start);
303                         
304                         if( ! exists($valid_tags{$tag}) )
305                         {
306                                 next;
307                         }
308                         
309                         my $value = substr($_,$start+1);
310                         $value =~ s/^\s+//;
311                         $value =~ s/\s+$//;
312                         
313                         $tags{$tag} = $value;
314                 }
315         }
316         
317         close(XMLFILE);
318         
319         return %tags;
320 }
321
322 # ==============================================================================
323 # get_gateway_code
324 # ==============================================================================
325
326 sub get_gateway_code
327 {
328         my $xmltree = XMLin($_[0]);  # $_[0] : path absolu du fichier XML
329         
330         my $refsections  = $xmltree->{'refsection'};
331         my @fields       = @$refsections;
332         
333         foreach my $field (@fields)
334         {
335                 if(  (exists($field->{'programlisting'}->{'role'}) ) &&
336                    ($field->{'programlisting'}->{'role'} eq 'code_gateway') )
337                 {
338                         return $field->{'programlisting'}->{'content'}."\n";
339                 }
340         }
341         
342         return '';
343 }
344
345 # ==============================================================================
346 # get_scilab_code
347 # ==============================================================================
348
349 sub get_scilab_code
350 {
351         my $xmltree = XMLin($_[0]);  # $_[0] : path absolu du fichier XML
352         
353         my $refsections  = $xmltree->{'refsection'};
354         my @fields       = @$refsections;
355         
356         foreach my $field (@fields)
357         {
358                 if((exists($field->{'programlisting'}->{'role'}) )
359                    && ($field->{'programlisting'}->{'role'} eq 'code_scilab'))
360                 {
361                         my $scilab_code = $field->{'programlisting'}->{'content'}."\n";
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         print FILEOUT $tags{'gateway_code'};
421         
422         # Fermeture du fichier de sortie
423         # ==========================================================================
424         close(FILEOUT);
425 }
426
427 # ==============================================================================
428 # write_scilab_code
429 # ==============================================================================
430
431 sub write_scilab_code
432 {
433         my $fileout = $_[0];
434         my $tagsref = $_[1];
435         my %tags    = %$tagsref;
436         
437         # TMPDIR management
438         # ==========================================================================
439         
440         my $TMPDIR = basename($fileout);
441         $TMPDIR =~ s/\.tst$//g;
442         $TMPDIR = 'pathconvert(TMPDIR+"/'.$TMPDIR.'")';
443         
444         # table management (ilib_build 2nd input argument)
445         # ==========================================================================
446         
447         my @functions = split(/,/,$tags{'Func_list'});
448         
449         my $table_str = '[';
450         
451         for( my $i=0 ; $i<length(@functions) ; $i++ )
452         {
453                 if( $i > 0)
454                 {
455                         $table_str .= ';';
456                 }
457                 
458                 $table_str .= '"'.$functions[$i].'","'.$functions[$i].'"';
459         }
460         
461         $table_str .= ']';
462         
463         
464         # C file management
465         # ==========================================================================
466         
467         my $cfile = 'SCI+"'.substr($tags{'File_gateway'},3).'"';
468         
469         # Open the fileout file
470         # ==========================================================================
471         
472         unless( open(FILEOUT,'> '.$fileout) )
473         {
474                 print "\t".'Le fichier "'.$fileout.'" n\'a pu être ouvert en écriture'."\n";
475                 exit(0);
476         }
477         
478         # Ecriture de l'entête
479         # ==========================================================================
480         
481         unless( open(LICENSE,$directory.'/scilab_code_license.txt') )
482         {
483                 print "\t".'Le fichier "'.$directory.'/scilab_code_license.txt" n\'a pu être ouvert en lecture'."\n";
484                 exit(0);
485         }
486         
487         while(<LICENSE>)
488         {
489                 print FILEOUT $_;
490         }
491         
492         close(LICENSE);
493         
494         # Ecriture de la ligne ilib_build
495         # ==========================================================================
496         
497         print FILEOUT 'ilib_verbose(0);'."\n";
498         print FILEOUT 'mkdir('.$TMPDIR.');'."\n";
499         print FILEOUT 'cd('.$TMPDIR.');'."\n";
500         print FILEOUT 'cflags = "-I"+SCI+"/modules/localization/includes";'."\n";
501         
502         print FILEOUT 'ilib_build(';
503         print FILEOUT '"'.$tags{'Lib_name'}.'",'; # lib_name
504         print FILEOUT $table_str.',';             # table
505         print FILEOUT $cfile.',';                 # files
506         print FILEOUT '[],';                      # libs
507         print FILEOUT '[],';                      # makename
508         print FILEOUT '"",';                      # ldflags
509         print FILEOUT 'cflags);'."\n";            # cflags
510         
511         print FILEOUT 'exec("loader.sce");'."\n";
512         
513         # Ecriture du code
514         # ==========================================================================
515         print FILEOUT $tags{'scilab_code'};
516         
517         # Fermeture du fichier de sortie
518         # ==========================================================================
519         close(FILEOUT);
520 }