Doc/tools/node2label.pl

   1 #! /usr/bin/env perl
   2
   3 use English;
   4 $INPLACE_EDIT = '';
   5
   6 # read the labels, then reverse the mappings
   7 require "labels.pl";
   8
   9 %nodes = ();
  10 my $key;
  11 # sort so that we get a consistent assignment for nodes with multiple labels
  12 foreach $label (sort keys %external_labels) {
  13   #
  14   # If the label can't be used as a filename on non-Unix platforms,
  15   # skip it.  Such labels may be used internally within the documentation,
  16   # but will never be used for filename generation.
  17   #
  18   if ($label =~ /^([-.a-zA-Z0-9]+)$/) {
  19     $key = $external_labels{$label};
  20     $key =~ s|^/||;
  21     $nodes{$key} = $label;
  22   }
  23 }
  24
  25 # This adds the "internal" labels added for indexing.  These labels will not
  26 # be used for file names.
  27 require "intlabels.pl";
  28 foreach $label (keys %internal_labels) {
  29   $key = $internal_labels{$label};
  30   $key =~ s|^/||;
  31   if (defined($nodes{$key})) {
  32     $nodes{$label} = $nodes{$key};
  33   }
  34 }
  35
  36 # collect labels that have been used
  37 %newnames = ();
  38
  39 while (<>) {
  40   # don't want to do one s/// per line per node
  41   # so look for lines with hrefs, then do s/// on nodes present
  42   if (/(HREF|href)=[\"\']node\d+\.html[\#\"\']/) {
  43     @parts = split(/(HREF|href)\=[\"\']/);
  44     shift @parts;
  45     for $node (@parts) {
  46       $node =~ s/[\#\"\'].*$//g;
  47       chop($node);
  48       if (defined($nodes{$node})) {
  49         $label = $nodes{$node};
  50         if (s/(HREF|href)=([\"\'])$node([\#\"\'])/href=$2$label.html$3/g) {
  51           s/(HREF|href)=([\"\'])$label.html/href=$2$label.html/g;
  52           $newnames{$node} = "$label.html";
  53         }
  54       }
  55     }
  56   }
  57   print;
  58 }
  59
  60 foreach $oldname (keys %newnames) {
  61   rename($oldname, $newnames{$oldname});
  62 }