Updated Spanish translation
[gtk-doc.git] / gtkdoc-rebase.in
blob68504b529c76f1089143023e053e50168fb644d5
1 #!@PERL@ -w
2 # -*- cperl -*-
4 # gtk-doc - GTK DocBook documentation generator.
5 # Copyright (C) 1998  Damon Chaplin
6 # Copyright (C) 2007  David Necas (Yeti)
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.
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.
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.
23 #############################################################################
24 # Script      : gtkdoc-rebase
25 # Description : Rebases URI references in installed HTML documentation.
26 #############################################################################
28 use strict;
29 use bytes;
30 use Getopt::Long qw(:config gnu_getopt);
31 use Cwd qw(realpath);
33 # Options
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;
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');
58 if ($PRINT_VERSION) {
59     print "@VERSION@\n";
60     exit 0;
63 if ($PRINT_HELP) {
64     print <<EOF;
65 gtkdoc-rebase version @VERSION@ - rewrite the base url of html files
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;
83 if (!$HTML_DIR) {
84     die "No HTML directory (--html-dir) given.\n";
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;
97 my $dir;
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     }
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;
117 # Check all other dirs, but skip already scanned dirs ord subdirs of those
118 if ($DEST_DIR) {
119     $DEST_DIR =~ s#/?$#/#;
121 $HTML_DIR =~ s#/?$#/#;
123 foreach $dir (@OTHER_DIRS) {
124     &ScanDirectory($dir, $HTML_DIR);
127 if ($RELATIVE) {
128     &RelativizeLocalMap($HTML_DIR);
131 &RebaseReferences($HTML_DIR);
132 &PrintWhatWeHaveDone();
135 sub ScanDirectory {
136     my ($dir, $self) = @_;
137     # This array holds any subdirectories found.
138     my (@subdirs) = ();
140     print "Scanning documentation directory $dir\n" if $VERBOSE;
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     }
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);
168     # Now recursively scan the subdirectories.
169     my $d;
170     foreach my $subdir (@subdirs) {
171         &ScanDirectory("$dir/$subdir", $self);
172     }
176 sub AddMap {
177     my ($dir) = @_;
178     my $file = "$dir/index.sgml";
179     my ($onlinedir, $package);
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);
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;
209 sub RelativizeLocalMap {
210     my ($self) = @_;
211     my $prefix;
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     }
227 sub RebaseReferences {
228     my ($dir) = @_;
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);
240 sub RebaseFile {
241     my ($file) = @_;
242     print "Fixing file: $file\n" if $VERBOSE;
244     open(HTMLFILE, $file) || die "Can't open $file: $!";
245     local $/;
246     undef $/;
247     my $text = <HTMLFILE>;
248     close(HTMLFILE);
250     $text =~ s#(<a(?:\s+\w+=(?:"[^"]*"|'[^']*'))*\s+href=")([^"]*)(")#$1 . &RebaseLink($2) .$3#gse;
252     open(NEWFILE, ">$file.new") || die "Can't open $file: $!";
253     print NEWFILE $text;
254     close(NEWFILE);
256     unlink($file) || die "Can't delete $file: $!";
257     rename("$file.new", $file) || die "Can't rename $file.new: $!";
261 sub RebaseLink {
262     my ($href) = @_;
263     my ($dir, $origdir, $file, $package);
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         }
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;
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     }