untracked/docs/doc-install.pl

   1 package main;
   2
   3 # Copyright (c) 2009  Openismus GmbH  <http://www.openismus.com/>
   4 #
   5 # This file is part of mm-common.
   6 #
   7 # mm-common is free software: you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License as published
   9 # by the Free Software Foundation, either version 2 of the License,
  10 # or (at your option) any later version.
  11 #
  12 # mm-common is distributed in the hope that it will be useful,
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with mm-common.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 use strict;
  21 use warnings;
  22 use bytes;
  23 use File::Glob qw(:glob);
  24 use File::Spec;
  25 use Getopt::Long qw(:config no_getopt_compat no_ignore_case require_order bundling);
  26
  27 # Globals
  28 my $message_prefix;
  29 my %tags_hash;
  30 my %subst_hash;
  31 my $book_base;
  32 my $perm_mode;
  33 my $target_dir;
  34 my $target_nodir = '';
  35 my $expand_glob  = '';
  36 my $verbose      = '';
  37
  38 sub path_basename ($)
  39 {
  40   my ($path) = @_;
  41   my $basename = File::Spec->splitpath($path);
  42
  43   return $basename;
  44 }
  45
  46 sub exit_help ()
  47 {
  48   my $script_name = path_basename($0) || 'doc-install.pl';
  49
  50   print <<"EOF";
  51 Usage: perl $script_name [OPTION]... [-T] SOURCE DEST
  52   or:  perl $script_name [OPTION]... SOURCE... DIRECTORY
  53   or:  perl $script_name [OPTION]... -t DIRECTORY SOURCE...
  54
  55 Copy SOURCE to DEST or multiple SOURCE files to the existing DIRECTORY,
  56 while setting permission modes.  For HTML files, translate references to
  57 external documentation.
  58
  59 Mandatory arguments to long options are mandatory for short options, too.
  60       --book-base=BASEPATH          use reference BASEPATH for Devhelp book
  61   -l, --tag-base=TAGFILE\@BASEPATH   use BASEPATH for references from TAGFILE (Doxygen <= 1.8.15)
  62   -l, --tag-base=s\@BASEPUB\@BASEPATH substitute BASEPATH for BASEPUB (Doxygen >= 1.8.16)
  63   -m, --mode=MODE                   override file permission MODE (octal)
  64   -t, --target-directory=DIRECTORY  copy all SOURCE arguments into DIRECTORY
  65   -T, --no-target-directory         treat DEST as normal file
  66       --glob                        expand SOURCE as filename glob pattern
  67   -v, --verbose                     enable informational messages
  68   -?, --help                        display this help and exit
  69 EOF
  70   exit;
  71 }
  72
  73 sub notice (@)
  74 {
  75   print($message_prefix, @_, "\n") if ($verbose);
  76 }
  77
  78 sub warning (@)
  79 {
  80   print STDERR ($message_prefix, @_, "\n");
  81 }
  82
  83 sub error (@)
  84 {
  85   warning(@_);
  86   exit 1;
  87 }
  88
  89 sub substitute_pub($$)
  90 {
  91   my ($pubpath, $ref_count) = @_;
  92   foreach my $key (keys %subst_hash)
  93   {
  94     # Don't use m// or s/// here. $key may contain characters
  95     # that are special in regular expressions.
  96     if (substr($pubpath, 0, length($key)) eq $key)
  97     {
  98       substr($pubpath, 0, length($key)) = $subst_hash{$key};
  99       $$ref_count++;
 100       last;
 101     }
 102   }
 103   return $pubpath;
 104 }
 105
 106 # Copy file to destination while translating references on the fly.
 107 # Sniff the content for the file type, as it is always read in anyway.
 108 sub install_file ($$$)
 109 {
 110   my ($in_name, $out_name, $basename) = @_;
 111   my ($in, $out, $buf);
 112   {
 113     local $/; # slurp mode: read entire file into buffer
 114
 115     open($in, '<', $in_name) and binmode($in) and defined($buf = <$in>) and close($in)
 116       or error('Failed to read ', $basename, ': ', $!);
 117   }
 118
 119   if ((%tags_hash or %subst_hash) and $buf =~ m/\A(?> \s*)(?> (?> <[?!][^<]+ )* )<html[>\s]/sx)
 120   {
 121     # Doxygen 1.8.15 and earlier stores the tag file name and BASEPATH in the html files.
 122     my $count = 0;
 123     my $total = $buf =~
 124       s!(?<= \s) doxygen="((?> [^:"]+)):((?> [^"]*))" # doxygen="(TAGFILE):(BASEPATH)"
 125         (?> \s+) ((?> href|src) =") \2 ((?> [^"]*)")  # (href|src=")BASEPATH(RELPATH")
 126        ! $3 . ((exists $tags_hash{$1}) ? (++$count, $tags_hash{$1}) : $2) . $4
 127        !egsx;
 128     my $change = $total ? "rewrote $count of $total" : 'no';
 129
 130     if ($total == 0 and %subst_hash)
 131     {
 132       # Doxygen 1.8.16 and later does not store the tag file name and BASEPATH in the html files.
 133       # The previous s!!! expression won't find anything to substitute.
 134       $total = $buf =~
 135         s!(\s (?:href|src) = ") ([^"]+") # (href|src=")(BASEPUB RELPATH")
 136          ! $1 . substitute_pub($2, \$count)
 137          !egsx;
 138       $change = $total ? "rewrote $count" : 'no';
 139     }
 140     notice('Translating ', $basename, ' (', $change, ' references)');
 141   }
 142   elsif (defined($book_base) and $buf =~ m/\A(?> \s*)(?> (?> <[?!][^<]+ )* )<book\s/sx)
 143   {
 144     # Substitute new value for attribute "base" of element <book>
 145     my $change = $buf =~ s/(<book \s [^<>]*? \b base=") (?> [^"]*) (?= ")/$1$book_base/sx
 146                  ? 'rewrote base path'
 147                  : 'base path not set';
 148     notice('Translating ', $basename, ' (', $change, ')');
 149   }
 150   else
 151   {
 152     notice('Copying ', $basename);
 153   }
 154
 155   # Avoid inheriting permissions of existing file
 156   unlink($out_name);
 157
 158   open($out, '>', $out_name) and binmode($out) and print $out ($buf) and close($out)
 159     or error('Failed to write ', $basename, ': ', $!);
 160
 161   chmod($perm_mode, $out_name)
 162     or warning('Failed to set ', $basename, ' permissions: ', $!);
 163 }
 164
 165 # Split TAGFILE@BASEPATH or s@BASEPUB@BASEPATH argument into key/value pair
 166 sub split_key_value ($)
 167 {
 168   my ($mapping) = @_;
 169   my ($name, $path) = split(m'@', $mapping, 2);
 170
 171   if ($name ne 's') # Doxygen 1.8.15 and earlier
 172   {
 173     error('Invalid base path mapping: ', $mapping) unless (defined($name) and $name ne '');
 174
 175     if (defined $path)
 176     {
 177       return ($name, $path, 0);
 178     }
 179     notice('Not changing base path for tag file ', $name);
 180     return ();
 181   }
 182   else # Doxygen 1.8.16 and later
 183   {
 184     ($name, $path) = split(m'@', $path, 2);
 185
 186     error('Invalid base path mapping: ', $mapping) unless (defined($name) and $name ne '');
 187
 188     if (defined $path)
 189     {
 190       return ($name, $path, 1);
 191     }
 192     notice('Not changing base path for ', $name);
 193     return ();
 194   }
 195 }
 196
 197 # ======
 198 # main()
 199 # ======
 200 # Define line leader of log messages
 201 $message_prefix = path_basename($0);
 202 $message_prefix =~ s/\.[^.]*$//s if (defined $message_prefix);
 203 $message_prefix = ($message_prefix || 'doc-install') . ': ';
 204
 205 # Process command-line options
 206 {
 207   my @tags = ();
 208   my $mode = '0644';
 209
 210   GetOptions('book-base=s'           => \$book_base,
 211              'tag-base|l=s'          => \@tags,
 212              'mode|m=s'              => \$mode,
 213              'target-directory|t=s'  => \$target_dir,
 214              'no-target-directory|T' => \$target_nodir,
 215              'glob'                  => \$expand_glob,
 216              'verbose|v'             => \$verbose,
 217              'help|?'                => \&exit_help)
 218     or exit 2;
 219
 220   error('Invalid permission mode: ', $mode) unless ($mode =~ m/^[0-7]+$/s);
 221   $perm_mode = oct($mode);
 222
 223   foreach my $tag (@tags)
 224   {
 225     my ($name, $path, $subst) = split_key_value($tag);
 226     if (defined($subst))
 227     {
 228       # Translate a local absolute path to URI.
 229       # (If Autotools (not Meson) is used, this translation is
 230       # also done in mm-doc.m4 (MM_ARG_WITH_TAGFILE_DOC).
 231       # $path will not be changed, if these substitutions have been
 232       # performed before.)
 233       $path =~ s!\\!/!g;
 234       $path =~ s! !%20!g;
 235       $path =~ s!^/!file:///!;
 236       $path =~ s!^([A-Za-z]:/)!file:///$1!; # Windows: C:/path
 237       if ($path !~ m!/$!)
 238       {
 239         $path .= '/';
 240       }
 241
 242       if (!$subst)
 243       {
 244         notice('Using base path ', $path, ' for tag file ', $name);
 245         $tags_hash{$name} = $path;
 246       }
 247       else
 248       {
 249         notice('Using base path ', $path, ' for ', $name);
 250         $subst_hash{$name} = $path;
 251       }
 252     }
 253   }
 254 }
 255
 256 notice('Using base path ', $book_base, ' for Devhelp book') if (defined $book_base);
 257
 258 if ($target_nodir)
 259 {
 260   error('Conflicting target directory options') if (defined $target_dir);
 261   error('Source and destination filenames expected') unless ($#ARGV == 1);
 262   error('Filename globbing requires target directory') if ($expand_glob);
 263
 264   install_file($ARGV[0], $ARGV[1], path_basename($ARGV[1]));
 265   exit;
 266 }
 267
 268 unless (defined $target_dir)
 269 {
 270   if (!$expand_glob and $#ARGV == 1)
 271   {
 272     my $basename = path_basename($ARGV[1]);
 273
 274     if (defined($basename) and $basename ne '')
 275     {
 276       install_file($ARGV[0], $ARGV[1], $basename);
 277       exit;
 278     }
 279   }
 280   $target_dir = pop(@ARGV);
 281 }
 282 error('No target directory specified') unless (defined($target_dir) and $target_dir ne '');
 283
 284 @ARGV = map(bsd_glob($_, GLOB_NOSORT), @ARGV) if ($expand_glob);
 285 my %basename_hash = ();
 286
 287 foreach my $in_name (@ARGV)
 288 {
 289   my $basename = path_basename($in_name);
 290
 291   # If there are multiple files with the same base name in the list, only
 292   # the first one will be installed.  This behavior makes it very easy to
 293   # implement a VPATH search for each individual file.
 294   unless (exists $basename_hash{$basename})
 295   {
 296     $basename_hash{$basename} = undef;
 297     my $out_name = File::Spec->catfile($target_dir, $basename);
 298     install_file($in_name, $out_name, $basename);
 299   }
 300 }
 301 exit;