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