gtkdoc-rebase.in

   1 #!@PERL@ -w
   2 # -*- cperl -*-
   3 #
   4 # gtk-doc - GTK DocBook documentation generator.
   5 # Copyright (C) 1998  Damon Chaplin
   6 # Copyright (C) 2007  David Necas (Yeti)
   7 #
   8 # This program is free software; you can redistribute it and/or modify
   9 # it under the terms of the GNU General Public License as published by
  10 # the Free Software Foundation; either version 2 of the License, or
  11 # (at your option) any later version.
  12 #
  13 # This program is distributed in the hope that it will be useful,
  14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 # GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with this program; if not, write to the Free Software
  20 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  21 #
  22
  23 #############################################################################
  24 # Script      : gtkdoc-rebase
  25 # Description : Rebases URI references in installed HTML documentation.
  26 #############################################################################
  27
  28 use strict;
  29 use bytes;
  30 use Getopt::Long qw(:config gnu_getopt);
  31 use Cwd qw(realpath);
  32
  33 # Options
  34
  35 my $HTML_DIR;
  36 my @OTHER_DIRS;
  37 my $DEST_DIR;
  38 my $PRINT_VERSION;
  39 my $PRINT_HELP;
  40 my $AGGRESSIVE;
  41 my $ONLINE;
  42 my $RELATIVE;
  43 my $VERBOSE;
  44
  45 my %optctl = ('html-dir' => \$HTML_DIR,
  46               'other-dir' => \@OTHER_DIRS,
  47               'dest-dir' => \$DEST_DIR,
  48               'online' => \$ONLINE,
  49               'relative' => \$RELATIVE,
  50               'aggressive' => \$AGGRESSIVE,
  51               'verbose' => \$VERBOSE,
  52               'version' => \$PRINT_VERSION,
  53               'help' => \$PRINT_HELP);
  54 GetOptions(\%optctl, 'html-dir=s', 'other-dir=s@', 'dest-dir:s',
  55                      'online', 'relative', 'aggressive', 'verbose',
  56                      'version', 'help');
  57
  58 if ($PRINT_VERSION) {
  59     print "@VERSION@\n";
  60     exit 0;
  61 }
  62
  63 if ($PRINT_HELP) {
  64     print "gtkdoc-rebase version @VERSION@\n";
  65     print "\n--html-dir=HTML_DIR     The directory which contains the installed HTML";
  66     print "\n--other-dir=OTHER_DIR   Directories to recursively scan for indices (index.sgml)";
  67     print "\n                        May be used more than once for multiple directories";
  68     print "\n--online                Prefer cross-references to online documents";
  69     print "\n--relative              Prefer relative cross-references";
  70     print "\n--aggressive            Rebase links to all files that are under a directory";
  71     print "\n                        matching a package name.";
  72     print "\n--dest-dir=ROOT_DIR     Staging area virtual root, this prefix will be removed";
  73     print "\n                        from HTML_DIR fore relative link calculation.";
  74     print "\n--verbose               Be verbose";
  75     print "\n--version               Print the version of this program";
  76     print "\n--help                  Print this help\n";
  77     exit 0;
  78 }
  79
  80 if (!$HTML_DIR) {
  81     die "No HTML directory (--html-dir) given.\n";
  82 }
  83
  84 # Maps.
  85 # These two point to the last seen URI of given type for a package:
  86 # OnlineMap: package => on-line URI
  87 # LocalMap: package => local URI
  88 # This maps all seen URIs of a package to fix broken links in the process:
  89 # RevMap: URI => package
  90 my (%OnlineMap, %LocalMap, %RevMap);
  91 # Remember what mangling we did.
  92 my %Mapped;
  93
  94 my $dir;
  95
  96 # We scan the directory containing GLib and any directories in GNOME2_PATH
  97 # first, but these will be overriden by any later scans.
  98 if (defined ($ENV{"GNOME2_PATH"})) {
  99     foreach $dir (split(/:/, $ENV{"GNOME2_PATH"})) {
 100         $dir = $dir . "/share/gtk-doc/html";
 101         if ($dir && -d $dir) {
 102             print "Prepending GNOME2_PATH directory: $dir\n" if $VERBOSE;
 103             unshift @OTHER_DIRS, $dir;
 104         }
 105     }
 106 }
 107
 108 $dir = `pkg-config --variable=prefix glib-2.0`;
 109 $dir =~ s/^\s*(\S*)\s*$/$1/;
 110 $dir = $dir . "/share/gtk-doc/html";
 111 print "Prepending GLib directory $dir\n" if $VERBOSE;
 112 unshift @OTHER_DIRS, $dir;
 113
 114 # Check all other dirs, but skip already scanned dirs ord subdirs of those
 115 if ($DEST_DIR) {
 116     $DEST_DIR =~ s#/?$#/#;
 117 }
 118 $HTML_DIR =~ s#/?$#/#;
 119
 120 foreach $dir (@OTHER_DIRS) {
 121     &ScanDirectory($dir, $HTML_DIR);
 122 }
 123
 124 if ($RELATIVE) {
 125     &RelativizeLocalMap($HTML_DIR);
 126 }
 127
 128 &RebaseReferences($HTML_DIR);
 129 &PrintWhatWeHaveDone();
 130
 131
 132 sub ScanDirectory {
 133     my ($dir, $self) = @_;
 134     # This array holds any subdirectories found.
 135     my (@subdirs) = ();
 136
 137     print "Scanning documentation directory $dir\n" if $VERBOSE;
 138
 139     if ("$dir/" eq $self) {
 140         print "Excluding self\n" if $VERBOSE;
 141         return;
 142     }
 143     if (not opendir(HTMLDIR, $dir)) {
 144         print "Cannot open $dir: $!\n";
 145         return;
 146     }
 147
 148     my $file;
 149     foreach $file (readdir(HTMLDIR)) {
 150         if ($file eq '.' or $file eq '..') {
 151             next;
 152         }
 153         elsif (-d "$dir/$file") {
 154             push @subdirs, $file;
 155         }
 156         elsif ($file eq "index.sgml") {
 157             &AddMap($dir);
 158         }
 159         elsif ($file eq "index.sgml.gz") {
 160             print "Please fix https://bugs.launchpad.net/ubuntu/+source/gtk-doc/+bug/77138\n";
 161         }
 162     }
 163     closedir (HTMLDIR);
 164
 165     # Now recursively scan the subdirectories.
 166     my $d;
 167     foreach my $subdir (@subdirs) {
 168         &ScanDirectory("$dir/$subdir", $self);
 169     }
 170 }
 171
 172
 173 sub AddMap {
 174     my ($dir) = @_;
 175     my $file = "$dir/index.sgml";
 176     my ($onlinedir, $package);
 177
 178     open(INDEXFILE, $file) || die "Can't open $file: $!";
 179     while (<INDEXFILE>) {
 180         # ONLINE must come before any ANCHORs
 181         last if m/^<ANCHOR/;
 182         if (m/^<ONLINE\s+href\s*=\s*"([^"]+)"\s*>/) {
 183             $onlinedir = $1;
 184             # Remove trailing non-directory component.
 185             $onlinedir =~ s#(.*/).*#$1#;
 186         }
 187     }
 188     close (INDEXFILE);
 189
 190     $dir =~ s#/?$#/#;
 191     ($package = $dir) =~ s#.*/([^/]+)/#$1#;
 192     if ($DEST_DIR and substr($dir, 0, length $DEST_DIR) eq $DEST_DIR) {
 193         $dir = substr($dir, -1 + length $DEST_DIR);
 194     }
 195     if ($onlinedir) {
 196         print "On-line location of $package: $onlinedir\n" if $VERBOSE;
 197         $OnlineMap{ $package } = $onlinedir;
 198         $RevMap{ $onlinedir } = $package;
 199     }
 200     print "Local location of $package: $dir\n" if $VERBOSE;
 201     $LocalMap{ $package } = $dir;
 202     $RevMap{ $dir } = $package;
 203 }
 204
 205
 206 sub RelativizeLocalMap {
 207     my ($self) = @_;
 208     my $prefix;
 209
 210     $self = realpath $self;
 211     $self =~ s#/?$#/#;
 212     ($prefix = $self) =~ s#[^/]+/$##;
 213     foreach my $package (keys %LocalMap) {
 214         $dir = $LocalMap{ $package };
 215         if (substr($dir, 0, length $prefix) eq $prefix) {
 216             $dir = "../" . substr($dir, length $prefix);
 217             $LocalMap{ $package } = $dir;
 218             print "Relativizing local location of $package to $dir\n" if $VERBOSE;
 219         }
 220     }
 221 }
 222
 223
 224 sub RebaseReferences {
 225     my ($dir) = @_;
 226
 227     opendir(HTMLDIR, $dir) || die "Can't open HTML directory $dir: $!";
 228     foreach my $file (readdir(HTMLDIR)) {
 229         if ($file =~ m/\.html?$/) {
 230             &RebaseFile("$dir$file");
 231         }
 232     }
 233     closedir (HTMLDIR);
 234 }
 235
 236
 237 sub RebaseFile {
 238     my ($file) = @_;
 239     print "Fixing file: $file\n" if $VERBOSE;
 240
 241     open(HTMLFILE, $file) || die "Can't open $file: $!";
 242     local $/;
 243     undef $/;
 244     my $text = <HTMLFILE>;
 245     close(HTMLFILE);
 246
 247     $text =~ s#(<a(?:\s+\w+=(?:"[^"]*"|'[^']*'))*\s+href=")([^"]*)(")#$1 . &RebaseLink($2) .$3#gse;
 248
 249     open(NEWFILE, ">$file.new") || die "Can't open $file: $!";
 250     print NEWFILE $text;
 251     close(NEWFILE);
 252
 253     unlink($file) || die "Can't delete $file: $!";
 254     rename("$file.new", $file) || die "Can't rename $file.new: $!";
 255 }
 256
 257
 258 sub RebaseLink {
 259     my ($href) = @_;
 260     my ($dir, $origdir, $file, $package);
 261
 262     if ($href =~ m#^(.*/)([^/]*)$#) {
 263         $dir = $origdir = $1;
 264         $file = $2;
 265         if ($RevMap{ $dir }) {
 266             $package = $RevMap{ $dir };
 267         }
 268         elsif ($dir =~ m#^\.\./([^/]+)/#) {
 269             $package = $1
 270         }
 271         elsif ($AGGRESSIVE) {
 272             $dir =~ m#([^/]+)/$#;
 273             $package = $1;
 274         }
 275
 276         if ($package) {
 277             if ($ONLINE && $OnlineMap{ $package }) {
 278                 $dir = $OnlineMap{ $package };
 279             }
 280             elsif ($LocalMap{ $package }) {
 281                 $dir = $LocalMap{ $package };
 282             }
 283             $href = $dir . $file;
 284         }
 285         if ($dir ne $origdir) {
 286             if ($Mapped{ $origdir }) {
 287                 $Mapped{ $origdir }->[1]++;
 288             }
 289             else {
 290                 $Mapped{ $origdir } = [ $dir, 1 ];
 291             }
 292         }
 293     }
 294     return $href;
 295 }
 296
 297
 298 sub PrintWhatWeHaveDone {
 299     my ($origdir, $info);
 300     foreach $origdir (sort keys %Mapped) {
 301         $info = $Mapped{$origdir};
 302         print "$origdir -> ", $info->[0], " (", $info->[1], ")\n";
 303     }
 304 }