commandref_join.pl 5.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199
  1. #!/usr/bin/perl
  2. # Usage:
  3. # if called with FHEM/XX.pm, than only this file will be checked
  4. # MAXWI
  5. # With pre: 1320, without 1020 (content only)
  6. # pre { white-space: pre-wrap; } : 900
  7. use strict;
  8. use warnings;
  9. # $Id: commandref_join.pl 15182 2017-10-03 10:45:29Z rudolfkoenig $
  10. my $noWarnings = grep $_ eq '-noWarnings', @ARGV;
  11. my ($verify) = grep $_ =~ /\.pm$/ , @ARGV;
  12. use constant TAGS => qw{ul li code b i u table tr td div};
  13. sub generateModuleCommandref($$;$$);
  14. my %mods;
  15. my %modIdx;
  16. my @modDir = ("FHEM");
  17. my @lang = ("EN", "DE");
  18. if(!$verify) {
  19. foreach my $modDir (@modDir) {
  20. opendir(DH, $modDir) || die "Cant open $modDir: $!\n";
  21. while(my $l = readdir DH) {
  22. next if($l !~ m/^\d\d_.*\.pm$/);
  23. my $of = $l;
  24. $l =~ s/.pm$//;
  25. $l =~ s/^[0-9][0-9]_//;
  26. $mods{$l} = "$modDir/$of";
  27. $modIdx{$l} = "device";
  28. my $modFh;
  29. open($modFh, "$modDir/$of") || die("Cant open $modDir/$l");
  30. while(my $cl = <$modFh>) {
  31. if($cl =~ m/^=item\s+(helper|command|device)/) {
  32. $modIdx{$l} = $1;
  33. last;
  34. }
  35. }
  36. close($modFh);
  37. }
  38. }
  39. if(-f "configDB.pm") {
  40. $mods{configDB} = "configDB.pm";
  41. $modIdx{configDB} = "helper";
  42. }
  43. } else { # check for syntax only
  44. my $modname = $verify;
  45. $modname =~ s/^.*[\/\\](?:\d\d_)?(.+).pm$/$1/;
  46. $mods{$modname} = $verify;
  47. foreach my $lang (@lang) {
  48. generateModuleCommandref($modname, $lang);
  49. }
  50. exit;
  51. }
  52. sub
  53. printList($)
  54. {
  55. for my $i (sort { "\L$a" cmp "\L$b" } keys %modIdx) {
  56. print OUT " <a href=\"#$i\">$i</a> &nbsp;\n"
  57. if($modIdx{$i} eq $_[0]);
  58. }
  59. while(my $l = <IN>) {
  60. next if($l =~ m/href=/);
  61. print OUT $l;
  62. last;
  63. }
  64. }
  65. foreach my $lang (@lang) {
  66. my $suffix = ($lang eq "EN" ? "" : "_$lang");
  67. my $docIn = "docs/commandref_frame$suffix.html";
  68. my $docOut = "docs/commandref$suffix.html";
  69. open(IN, "$docIn") || die "Cant open $docIn: $!\n";
  70. open(OUT, ">$docOut") || die "Cant open $docOut: $!\n";
  71. if(!$suffix) { # First run: remember commands/helper module
  72. my $modType;
  73. while(my $l = <IN>) {
  74. $modType = "command" if($l =~ m/>FHEM commands</);
  75. $modType = "device" if($l =~ m/>Devices</);
  76. $modType = "helper" if($l =~ m/>Helper modules</);
  77. $modIdx{$1} = $modType
  78. if($modType && $l =~ m/href="#(.*?)">/ && $1 ne "global");
  79. last if($l =~ m/<!-- header end -->/);
  80. }
  81. seek(IN,0,0);
  82. }
  83. # Second run: create the file
  84. while(my $l = <IN>) { # Header
  85. last if($l =~ m/name="perl"/);
  86. print OUT $l;
  87. printList($1) if($l =~ m/<!-- header:(.*) -->/);
  88. }
  89. # Copy the doc part from the module
  90. foreach my $mod (sort keys %mods) {
  91. generateModuleCommandref($mod,$lang, \*OUT);
  92. }
  93. # Copy the tail
  94. print OUT '<a name="perl"></a>',"\n";
  95. while(my $l = <IN>) {
  96. print OUT $l;
  97. }
  98. close(OUT);
  99. }
  100. #############################
  101. # read a module file and check/print the commandref
  102. sub
  103. generateModuleCommandref($$;$$)
  104. {
  105. my ($mod, $lang, $fh, $jsFile) = @_;
  106. my $fPath = $mods{$mod} ? $mods{$mod} : $mod;
  107. my $tag;
  108. my $suffix = ($lang eq "EN" ? "" : "_$lang");
  109. my %tagcount= ();
  110. map { $tagcount{$_} = 0 } TAGS;
  111. my %llwct = (); # Last line with closed tag
  112. my $modFh;
  113. open($modFh, $fPath) || die("Cant open $fPath:$!\n");
  114. my $skip = 1;
  115. my $line = 0;
  116. my $docCount = 0;
  117. my $hasLink = 0;
  118. my $dosMode = 0;
  119. while(my $l = <$modFh>) {
  120. $line++;
  121. $dosMode = 1 if($l =~ m/^=begin html$suffix.*\r/);
  122. if($l =~ m/^=begin html$suffix$/) {
  123. $l = <$modFh>; # skip one line, to be able to repeat join+split
  124. print "*** $lang $mod: nonempty line after =begin html ignored\n"
  125. if($l =~ m/^...*$/);
  126. $skip = 0; $line++;
  127. } elsif($l =~ m/^=end html$suffix$/) {
  128. $skip = 1;
  129. } elsif(!$skip) {
  130. print $fh $l if($fh);
  131. $docCount++;
  132. $hasLink = ($l =~ m/<a name="$mod"/) if(!$hasLink);
  133. foreach $tag (TAGS) {
  134. $tagcount{$tag} +=()= ($l =~ /<$tag>/gi);
  135. $tagcount{$tag} -=()= ($l =~ /<\/$tag>/gi) if($tagcount{$tag} > 0);
  136. $llwct{$tag} = $line if(!$tagcount{$tag});
  137. }
  138. if($l =~ m,INSERT_DOC_FROM: ([^ ]+)/([^ /]+) ,) {
  139. my ($dir, $re) = ($1, $2);
  140. if(opendir(DH, $dir)) {
  141. foreach my $file (grep { m/^$2$/ } readdir(DH)) {
  142. generateModuleCommandref("$dir/$file", $lang, $fh, 1);
  143. }
  144. closedir(DH);
  145. }
  146. }
  147. }
  148. }
  149. close($modFh);
  150. print "*** $lang $fPath: ignoring text due to DOS encoding\n"
  151. if($dosMode);
  152. # TODO: add doc to each $jsfile
  153. print "*** $lang $fPath: No document text found\n"
  154. if(!$jsFile && !$suffix && !$docCount && !$dosMode && $fPath !~ m,/99_,);
  155. if(!$jsFile && $suffix && !$docCount && !$dosMode) {
  156. if($lang eq "DE" && $fh) {
  157. print $fh <<EOF;
  158. <a name="$mod"></a>
  159. <h3>$mod</h3>
  160. <ul>
  161. Leider keine deutsche Dokumentation vorhanden. Die englische Version gibt es
  162. hier: <a href='commandref.html#$mod'>$mod</a><br/>
  163. </ul>
  164. EOF
  165. }
  166. }
  167. print "*** $lang $fPath: No a-tag with name=\"$mod\" \n"
  168. if(!$jsFile && !$suffix && $docCount && !$hasLink && !$noWarnings);
  169. foreach $tag (TAGS) {
  170. print("*** $lang $fPath: Unbalanced $tag ".
  171. "($tagcount{$tag}, last line ok: $llwct{$tag})\n")
  172. if($tagcount{$tag} && !$noWarnings);
  173. }
  174. }