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