contrib/verify_index.pl

   1 #!/usr/bin/perl -w
   2
   3 #
   4 # Script to verify that the index.html is in good shape.
   5 # This will verify that the entries:
   6 #   1) Are in order per section
   7 #   2) Exist on disk if in the index.html
   8 #   3) Are in the index.html if they exist on disk
   9 #
  10 # Run it from the contrib directory.
  11 #
  12 # tyranix [ tyranix at gmail]
  13 #
  14 #
  15 # verify_index.pl is free software; you can redistribute it and/or modify
  16 # it under the terms of the GNU Lesser General Public License as published by
  17 # the Free Software Foundation; either version 2.1 of the License, or
  18 # (at your option) any later version.
  19 #
  20
  21 use strict;
  22 use warnings "all";
  23 use diagnostics;
  24
  25 sub report_error($);
  26
  27 my $return_code = 0;   # Darcs needs a return code for a test suite.
  28 my $line_count = 1;    # Line count inside index.html
  29
  30 {
  31     open(INDEX, "index.html") || die qq[Could not open "index.html": $!];
  32
  33     my %index_files = ();        # Files found in "index.html"
  34     my %script_files = ();       # Files found in the directory
  35     my %old_ignored_files = ();  # Files marked for ion2 only
  36     my $section_counter = 1;     # Section number (not same as line number)
  37
  38     for (my $line = <INDEX>; $line; $line = <INDEX>, $line_count++) {
  39         chomp($line);
  40
  41         if ($line =~ m/^\s*<dt>\s*<a\s*href="([^\"]+)">([^<]+)<\/a>/) {
  42             my ($url, $name) = ($1, $2);
  43             my ($directory, $filename) = $url =~ m,(.+)/([^/]+),;
  44
  45             if (!defined($directory) || !defined($filename)) {
  46                 report_error("Malformed entry on line $line_count\n");
  47             }
  48
  49             if ($filename ne $name) {
  50                 report_error(qq["$name" should be named "$filename"]);
  51             }
  52
  53             # Reset the section_counter and setup the hashes.
  54             if (!exists($index_files{$directory})) {
  55                 $section_counter = 1;
  56                 $index_files{$directory} = {};
  57                 $script_files{$directory} = {};
  58
  59                 # Add all of the actual files so we can compare the two hashes.
  60                 opendir(FILES, $directory)
  61                     || die qq[Could not open "$directory": $!];
  62
  63                 while (my $entry = readdir(FILES)) {
  64                     if ($entry !~ /^\./ && -f "$directory/$entry") {
  65                         ${$script_files{$directory}}{$entry} = 1;
  66                     }
  67                 }
  68                 closedir(FILES) || die qq[Could not close "$directory": $!];
  69             }
  70
  71             if (exists(${$index_files{$directory}}{$filename})) {
  72                 report_error("Duplicate entry $directory/$filename");
  73             }
  74
  75             # Add this file to the hash of this directory for later use.
  76             ${$index_files{$directory}}{$filename} = $section_counter++;
  77         } elsif ($line =~ m/^\s*<dt>\s*<strike>\s*<a\s*href="([^\"]+)">([^<]+)<\/a>/) {
  78             my ($url, $name) = ($1, $2);
  79             my ($directory, $filename) = $url =~ m,(.+)/([^/]+),;
  80
  81             if (!defined($directory) || !defined($filename)) {
  82                 report_error("Malformed entry on line $line_count\n");
  83             }
  84
  85             if ($filename ne $name) {
  86                 report_error(qq["$name" should be named "$filename"]);
  87             }
  88
  89             if (!exists($old_ignored_files{$directory})) {
  90                 $old_ignored_files{$directory} = {};
  91             }
  92
  93             if (exists(${$old_ignored_files{$directory}}{$filename})) {
  94                 report_error("Duplicate entry $directory/$filename");
  95             }
  96
  97             ${$old_ignored_files{$directory}}{$filename} = 1;
  98         } elsif ($line =~ m/^\s*<dt>/) {
  99             # This is a dt entry but it's invalid.
 100             report_error("Invalid line: $line");
 101         }
 102     }
 103     close(INDEX) || die qq[Could not close "index.html": $!];
 104
 105     my @out_of_order = ();
 106     my @not_on_disk = ();
 107
 108     # Compare the index.html entries to what's on disk.
 109     for my $dir (keys %index_files) {
 110         my $count = 1;
 111         for my $key (sort(keys %{$index_files{$dir}})) {
 112             if (!exists(${$script_files{$dir}}{$key})) {
 113                 push(@not_on_disk, "$dir/$key");
 114             } else {
 115                 if ($count != ${$index_files{$dir}}{$key}) {
 116                     push(@out_of_order, ["$dir/$key", $count, ${$index_files{$dir}}{$key}]);
 117                 }
 118
 119                 # Delete it so we can go through it later and see what wasn't
 120                 # in the html file.
 121                 delete(${$script_files{$dir}}{$key});
 122             }
 123             $count++;
 124         }
 125     }
 126
 127     if ($#not_on_disk != -1) {
 128         $return_code = 1;
 129         print "Files in the index.html but not on disk:\n";
 130         for my $key (@not_on_disk) {
 131             print "\t$key\n";
 132         }
 133     }
 134
 135     if ($#out_of_order != -1) {
 136         $return_code = 1;
 137         print  "Files out of order in index.html:\n";
 138         for my $key (@out_of_order) {
 139             my ($name, $correct_value, $value_saw) = @{$key};
 140             print "\t$name \tshould be in spot $correct_value but found in $value_saw\n";
 141         }
 142     }
 143
 144     my $printed_header = undef;
 145     for my $dir (keys %script_files) {
 146         for my $key (sort { uc($a) cmp uc($b) } keys %{$script_files{$dir}}) {
 147             if (!exists(${$old_ignored_files{$dir}}{$key})) {
 148                 if (!defined($printed_header)) {
 149                     print "Files on the disk but not in index.html:\n";
 150                     $printed_header = 1;
 151                     $return_code = 1;
 152                 }
 153                 print "\t$dir/$key\n";
 154             }
 155         }
 156     }
 157
 158     exit($return_code);
 159 }
 160
 161 sub report_error($)
 162 {
 163     my ($error) = @_;
 164
 165     print STDERR qq[$0: Error in "index.html" on line $line_count\n\t$error\n];
 166     $return_code = 1;
 167 }