Perl script to automaticaly create api tests
[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 my $sci_modules_dir = $SCI.'/modules';
39
40
41 # Managed languages
42 # ------------------------------------------------
43 my %languages;
44 $languages{'en_US'} = 1;
45
46
47 # Module list
48 # ------------------------------------------------
49 my %modules;
50 if( $ARGV[0] ne '' )
51 {
52         $modules{$ARGV[0]} = 1;
53 }
54 else
55 {
56         %modules = get_module_list();
57 }
58
59 # modules dir path
60 # ------------------------------------------------
61
62 my %valid_tags;
63 $valid_tags{'File_gateway'} = 1;
64 $valid_tags{'File_scilab'}  = 1;
65 $valid_tags{'Lib_name'}     = 1;
66 $valid_tags{'Func_list'}    = 1;
67
68 # # XML list
69 # ------------------------------------------------
70 my %xmllist;
71
72
73
74 # ==============================================================================
75 # First step : get the XML list
76 # ==============================================================================
77
78 foreach my $module (sort keys %modules)
79 {
80         foreach my $language (sort keys %languages)
81         {
82                 my $this_directory = $sci_modules_dir.'/'.$module.'/help/'.$language;
83                 
84                 if( -d $this_directory )
85                 {
86                         get_xml_list($this_directory,$module);
87                 }
88         }
89 }
90
91 # ==============================================================================
92 # Second step : parse each XML file
93 # ==============================================================================
94
95 my $xmllist_size = 0;
96
97 foreach my $xmlfile (sort keys %xmllist)
98 {
99         $xmllist_size++;
100 }
101
102 my $count = 0;
103
104 foreach my $xmlfile (sort keys %xmllist)
105 {
106         $count++;
107         my $module = $xmllist{$xmlfile};
108         
109         my $xmlfile_print = 'SCI/modules'.substr($xmlfile,length($sci_modules_dir));
110         printf('%04d/%04d - %s'."\n",$count,$xmllist_size,$xmlfile_print);
111         my %tags = get_tag_values($xmlfile);
112         
113         # Check found tags
114         # ==========================================================================
115         
116         foreach my $tag (sort keys %valid_tags)
117         {
118                 if( (! exists($tags{$tag}) ) || ($tags{$tag} eq '') )
119                 {
120                         print "\t".'ERROR : Tag "'.$tag.'" has not been found in the file "'.$xmlfile.'"'."\n";
121                         exit(0);
122                 }
123                 
124                 if( $tag eq 'File_gateway' )
125                 {
126                         unless( $tags{$tag} =~ m/^SCI(.)*\.(c|cpp)$/ )
127                         {
128                                 print "\t".'ERROR : Value of the tag "'.$tag.'" found in the file "'.$xmlfile.'" is not valid'."\n";
129                                 exit(0);
130                         }
131                 }
132                 
133                 if( $tag eq 'File_scilab' )
134                 {
135                         unless( $tags{$tag} =~ m/^SCI(.)*\.(tst)$/ )
136                         {
137                                 print "\t".'ERROR : Value of the tag "'.$tag.'" found in the file "'.$xmlfile.'" is not valid'."\n";
138                                 exit(0);
139                         }
140                 }
141         }
142         
143         # Get the test content
144         # ==========================================================================
145         
146         $tags{'scilab_code'} = get_scilab_code($xmlfile);
147         
148         if( $tags{'scilab_code'} eq '' )
149         {
150                 print "\t".'ERROR : The scilab code has not been found in the file "'.$xmlfile.'"'."\n";
151                 exit(0);
152         }
153         
154         # Get the gateway content
155         # ==========================================================================
156         
157         $tags{'gateway_code'} = get_gateway_code($xmlfile);
158         
159         if( $tags{'gateway_code'} eq '' )
160         {
161                 print "\t".'ERROR : The gateway code has not been found in the file "'.$xmlfile.'"'."\n";
162                 exit(0);
163         }
164         
165         # write the gateway code
166         # ==========================================================================
167         
168         my $gateway_file = $tags{'File_gateway'};
169         $gateway_file = $SCI . substr($gateway_file,3);
170         write_gateway_code($gateway_file,\%tags);
171         print "\t".'The file "'.$gateway_file.'" code has been created'."\n";
172         
173         
174         # write the scilab code
175         # ==========================================================================
176         
177         my $scilab_file = $tags{'File_scilab'};
178         $scilab_file = $SCI . substr($scilab_file,3);
179         write_scilab_code($scilab_file,\%tags);
180         print "\t".'The file "'.$scilab_file.'" code has been created'."\n";
181         
182 }
183
184
185
186 # ==============================================================================
187 # get_module_list
188 # ==============================================================================
189
190 sub get_module_list
191 {
192         my %list;
193         
194         unless( chdir($sci_modules_dir) )
195         {
196                 print 'The directory '.$sci_modules_dir.' doesn\'t exist or read access denied'."\n";
197                 del_tmp_file();
198                 exit(0);
199         }
200         
201         my @candidates = <*>;
202         
203         foreach my $candidate (@candidates)
204         {
205                 if( -e $sci_modules_dir.'/'.$candidate.'/help' )
206                 {
207                         $list{$candidate} = 1;
208                 }
209         }
210         
211         return %list;
212 }
213
214 # ==============================================================================
215 # get_xml_list
216 # ==============================================================================
217
218 sub get_xml_list
219 {
220         my $dir      = $_[0];
221         my $module   = $_[1];
222         
223         my @list_dir;
224         
225         my $current_directory;
226         
227         # On enregistre le répertoire dans lequel on se situe à l'entrée de la fonction
228         my $previous_directory = getcwd();
229         
230         chdir($dir);
231         
232         @list_dir = <*>;
233         
234         foreach my $list_dir (@list_dir)
235         {
236                 $current_directory = getcwd();
237                 
238                 if( (-d $list_dir) && ( ! ($list_dir =~ m/^scilab_[a-z][a-z]_[A-Z][A-Z]_help$/ )) )
239                 {
240                         get_xml_list($current_directory.'/'.$list_dir,$module);
241                 }
242                 
243                 if( (-f $list_dir)
244                    && ($list_dir =~ m/\.xml$/)
245                    && ($list_dir ne 'master.xml')
246                    && ($list_dir ne 'master_help.xml') )
247                 {
248                         unless( open(XMLFILE,$list_dir) )
249                         {
250                                 print 'Le fichier "'.$current_directory.'/'.$list_dir.'" n\'a pu être ouvert en lecture'."\n";
251                                 exit(0);
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                 print 'Le fichier "'.$xmlfile.'" n\'a pu être ouvert en lecture'."\n";
285                 exit(0);
286         }
287         
288         while(<XMLFILE>)
289         {
290                 $_ =~ s/^\s+//;
291                 $_ =~ s/\s+$//;
292                 
293                 if( $_ =~ /^<!--[A-Z][a-z_]*:\s(.)+-->$/ )
294                 {
295                         $_ =~ s/<!--//;
296                         $_ =~ s/-->//;
297                         $_ =~ s/^\s+//;
298                         $_ =~ s/\s+$//;
299                         
300                         my $start = index($_,':');
301                         my $tag   = substr($_,0,$start);
302                         
303                         if( ! exists($valid_tags{$tag}) )
304                         {
305                                 next;
306                         }
307                         
308                         my $value = substr($_,$start+1);
309                         $value =~ s/^\s+//;
310                         $value =~ s/\s+$//;
311                         
312                         $tags{$tag} = $value;
313                 }
314         }
315         
316         close(XMLFILE);
317         
318         return %tags;
319 }
320
321 # ==============================================================================
322 # get_gateway_code
323 # ==============================================================================
324
325 sub get_gateway_code
326 {
327         my $xmltree = XMLin($_[0]);  # $_[0] : path absolu du fichier XML
328         
329         my $refsections  = $xmltree->{'refsection'};
330         my @fields       = @$refsections;
331         
332         foreach my $field (@fields)
333         {
334                 if(  (exists($field->{'programlisting'}->{'role'}) ) &&
335                    ($field->{'programlisting'}->{'role'} eq 'code_gateway') )
336                 {
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/then(\s)+error\((\s)*\"failed\"(\s)*\)(\s)*[;,](\s)*end/then pause;end/g;
362                         return $scilab_code;
363                 }
364         }
365         
366         return '';
367 }
368
369 # ==============================================================================
370 # write_gateway_code
371 # ==============================================================================
372
373 sub write_gateway_code
374 {
375         my $fileout = $_[0];
376         my $tagsref = $_[1];
377         my %tags    = %$tagsref;
378         
379         unless( open(FILEOUT,'> '.$fileout) )
380         {
381                 print "\t".'Le fichier "'.$fileout.'" n\'a pu être ouvert en écriture'."\n";
382                 exit(0);
383         }
384         
385         # Ecriture de l'entête
386         # ==========================================================================
387         
388         unless( open(LICENSE,$directory.'/gateway_code_license.txt') )
389         {
390                 print "\t".'Le fichier "'.$directory.'/gateway_code_license.txt" n\'a pu être ouvert en lecture'."\n";
391                 exit(0);
392         }
393         
394         while(<LICENSE>)
395         {
396                 print FILEOUT $_;
397         }
398         
399         close(LICENSE);
400         
401         # Ecriture des includes
402         # ==========================================================================
403         
404         unless( open(INCLUDES,$directory.'/includes.txt') )
405         {
406                 print "\t".'Le fichier "'.$directory.'/includes.txt" n\'a pu être ouvert en lecture'."\n";
407                 exit(0);
408         }
409         
410         while(<INCLUDES>)
411         {
412                 print FILEOUT $_;
413         }
414         
415         close(INCLUDES);
416         
417         # Ecriture du code
418         # ==========================================================================
419         print FILEOUT $tags{'gateway_code'};
420         
421         # Fermeture du fichier de sortie
422         # ==========================================================================
423         close(FILEOUT);
424 }
425
426 # ==============================================================================
427 # write_scilab_code
428 # ==============================================================================
429
430 sub write_scilab_code
431 {
432         my $fileout = $_[0];
433         my $tagsref = $_[1];
434         my %tags    = %$tagsref;
435         
436         
437         # table management (ilib_build 2nd input argument)
438         # ==========================================================================
439         
440         my @functions = split(/,/,$tags{'Func_list'});
441         
442         my $table_str = '[';
443         
444         for( my $i=0 ; $i<length(@functions) ; $i++ )
445         {
446                 if( $i > 0)
447                 {
448                         $table_str .= ';';
449                 }
450                 
451                 $table_str .= '"'.$functions[$i].'","'.$functions[$i].'"';
452         }
453         
454         $table_str .= ']';
455         
456         
457         # C file management
458         # ==========================================================================
459         
460         my $cfile = 'SCI+"'.substr($tags{'File_gateway'},3).'"';
461         
462         # Open the fileout file
463         # ==========================================================================
464         
465         unless( open(FILEOUT,'> '.$fileout) )
466         {
467                 print "\t".'Le fichier "'.$fileout.'" n\'a pu être ouvert en écriture'."\n";
468                 exit(0);
469         }
470         
471         # Ecriture de l'entête
472         # ==========================================================================
473         
474         unless( open(LICENSE,$directory.'/scilab_code_license.txt') )
475         {
476                 print "\t".'Le fichier "'.$directory.'/scilab_code_license.txt" n\'a pu être ouvert en lecture'."\n";
477                 exit(0);
478         }
479         
480         while(<LICENSE>)
481         {
482                 print FILEOUT $_;
483         }
484         
485         close(LICENSE);
486         
487         # Ecriture de la ligne ilib_build
488         # ==========================================================================
489         
490         print FILEOUT 'ilib_verbose(0);'."\n";
491         print FILEOUT 'cd TMPDIR;'."\n";
492         print FILEOUT 'cflags = "-I"+SCI+"/modules/localization/includes";'."\n";
493         
494         print FILEOUT 'ilib_build(';
495         print FILEOUT '"'.$tags{'Lib_name'}.'",'; # lib_name
496         print FILEOUT $table_str.',';             # table
497         print FILEOUT $cfile.',';                 # files
498         print FILEOUT '[],';                      # libs
499         print FILEOUT '[],';                      # makename
500         print FILEOUT '"",';                      # ldflags
501         print FILEOUT 'cflags);'."\n";            # cflags
502         
503         
504         # Ecriture du code
505         # ==========================================================================
506         print FILEOUT $tags{'scilab_code'};
507         
508         # Fermeture du fichier de sortie
509         # ==========================================================================
510         close(FILEOUT);
511 }