gtkdoc-rebase.in

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