[librsvgmm] Create doc-install.pl script to replace installdox

[Daniel Elstner <daniel src gnome org>]

commit 4163276614ef712df3cb85696fc88a0190e29bc1
Author: Daniel Elstner <danielk openismus com>
Date:   Sun Aug 2 23:51:01 2009 +0200

    Create doc-install.pl script to replace installdox
    
    * Makefile.am (dist_noinst_DATA): Distribute build/doc-install.pl.
    * build/doc-install.pl: New script, intended to replace Doxygen's own
    installdox, which turned out to be woefully lacking.  This new script
    actually installs files rather than editing them in place after the
    fact.  The idea is that it can be used as a drop-in replacement for
    the 'install' command normally invoked from Automake rules, but with
    on-the-fly translation of documentation references.  Devhelp books
    can be translated as well.  Unrecognized files are simply passed
    through.
    Note that unlike installdox, doc-install.pl is not a generated file
    and can be used without changes by different modules.  See the Perl
    script itself for detailed information and more goodies.

 Makefile.am          |    1 +
 build/doc-install.pl |  207 ++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 208 insertions(+), 0 deletions(-)
---
diff --git a/Makefile.am b/Makefile.am
index 14b5283..9d887bc 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -30,6 +30,7 @@ doc_subdirs =
 endif
 SUBDIRS = $(src_subdirs) librsvg/librsvgmm $(doc_subdirs)
 
+dist_noinst_DATA = build/doc-install.pl
 dist_noinst_SCRIPTS = autogen.sh
 
 pkgconfigdir = $(libdir)/pkgconfig
diff --git a/build/doc-install.pl b/build/doc-install.pl
new file mode 100644
index 0000000..68f98ed
--- /dev/null
+++ b/build/doc-install.pl
@@ -0,0 +1,207 @@
+package main;
+
+# Copyright (c) 2009  Daniel Elstner <daniel kitta gmail com>
+#
+# This file is part of mm-autofu.
+#
+# mm-autofu is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published
+# by the Free Software Foundation, either version 2 of the License,
+# or (at your option) any later version.
+#
+# mm-autofu is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with mm-autofu.  If not, see <http://www.gnu.org/licenses/>.
+
+use strict;
+use warnings;
+use bytes;
+use File::Spec;
+use Getopt::Long qw(:config no_getopt_compat no_ignore_case require_order bundling);
+
+# Globals
+my $message_prefix;
+my %tags_hash;
+my $book_base;
+my $perm_mode;
+my $target_dir;
+my $target_nodir = '';
+my $verbose = '';
+
+sub path_basename ($)
+{
+  my ($path) = @_;
+  my $basename = File::Spec->splitpath($path);
+
+  return $basename;
+}
+
+sub exit_help ()
+{
+  my $script_name = path_basename($0) || 'doc-install.pl';
+
+  print <<"EOF";
+Usage: perl $script_name [OPTION]... [-T] SOURCE DEST
+  or:  perl $script_name [OPTION]... SOURCE... DIRECTORY
+  or:  perl $script_name [OPTION]... -t DIRECTORY SOURCE...
+
+Copy SOURCE to DEST or multiple SOURCE files to the existing DIRECTORY,
+while setting permission modes.  For HTML files, translate references to
+external documentation.
+
+Mandatory arguments to long options are mandatory for short options, too.
+  -k, --book-base=BASEPATH          use reference BASEPATH for Devhelp book
+  -l, --tag-base=TAGFILE\ BASEPATH   use BASEPATH for references from TAGFILE
+  -m, --mode=MODE                   override file permission MODE (octal)
+  -t, --target-directory=DIRECTORY  copy all SOURCE arguments into DIRECTORY
+  -T, --no-target-directory         treat DEST as normal file
+  -v, --verbose                     enable informational messages
+  -?, --help                        display this help and exit
+EOF
+  exit;
+}
+
+sub notice (@)
+{
+  print($message_prefix, @_, "\n") if ($verbose);
+}
+
+sub warning (@)
+{
+  print STDERR ($message_prefix, @_, "\n");
+}
+
+sub error (@)
+{
+  warning(@_);
+  exit 1;
+}
+
+# Copy file to destination while translating references on the fly.
+# Sniff the content for the file type, as it is always read in anyway.
+sub install_file ($$$)
+{
+  my ($in_name, $out_name, $basename) = @_;
+  my ($in, $out, $buf);
+  {
+    local $/; # slurp mode: read entire file into buffer
+
+    open($in, '<', $in_name) and binmode($in) and defined($buf = <$in>) and close($in)
+      or error('Failed to read ', $basename, ': ', $!);
+  }
+
+  if (%tags_hash and $buf =~ m/\A(?> \s*)(?> (?> <[?!][^<]+ )* )<html[>\s]/sx)
+  {
+    my $count = 0;
+    my $total = $buf =~
+      s!(?<= \s) doxygen="((?> [^:"]+)):((?> [^"]*))" # doxygen="(TAGFILE):(BASEPATH)"
+        (?> \s+) ((?> href|src) =") \2 ((?> [^"]*)")  # (href|src=")BASEPATH(RELPATH")
+       ! $3 . ((exists $tags_hash{$1}) ? (++$count, $tags_hash{$1}) : $2) . $4
+       !egsx;
+    my $change = $total ? "rewrote $count of $total"
+                        : 'no';
+    notice('Translating ', $basename, ' (', $change, ' references)');
+  }
+  elsif (defined($book_base) and $buf =~ m/\A(?> \s*)(?> (?> <[?!][^<]+ )* )<book\s/sx)
+  {
+    # Substitute new value for attribute "base" of element <book>
+    my $change = $buf =~ s/(<book \s [^<>]*? \b base=") (?> [^"]*) (?= ")/$1$book_base/sx
+                 ? 'rewrote base path'
+                 : 'base path not set';
+    notice('Translating ', $basename, ' (', $change, ')');
+  }
+  else
+  {
+    notice('Copying ', $basename);
+  }
+
+  # Avoid inheriting permissions of existing file
+  unlink($out_name);
+
+  open($out, '>', $out_name) and binmode($out) and print $out ($buf) and close($out)
+    or error('Failed to write ', $basename, ': ', $!);
+
+  chmod($perm_mode, $out_name)
+    or warning('Failed to set ', $basename, ' permissions: ', $!);
+}
+
+# Split TAGFILE BASEPATH argument into key/value pair
+sub split_key_value ($)
+{
+  my ($mapping) = @_;
+  my ($name, $path) = split(m'@', $mapping, 2);
+
+  error('Invalid base path mapping: ', $mapping) unless (defined($name) and $name ne '');
+
+  if (defined $path)
+  {
+    notice('Using base path ', $path, ' for tag file ', $name);
+    return ($name, $path);
+  }
+  notice('Not changing base path for tag file ', $name);
+  return ();
+}
+
+# Define line leader of log messages
+$message_prefix = path_basename($0);
+$message_prefix =~ s/\.[^.]*$//s if (defined $message_prefix);
+$message_prefix = ($message_prefix || 'doc-install') . ': ';
+
+# Process command-line options
+{
+  my @tags = ();
+  my $mode = '0644';
+
+  GetOptions('book-base|k=s'         => \$book_base,
+             'tag-base|l=s'          => \ tags,
+             'mode|m=s'              => \$mode,
+             'target-directory|t=s'  => \$target_dir,
+             'no-target-directory|T' => \$target_nodir,
+             'verbose|v'             => \$verbose,
+             'help|?'                => \&exit_help)
+    or exit 2;
+
+  error('Invalid permission mode: ', $mode) unless ($mode =~ m/^[0-7]+$/s);
+
+  $perm_mode = oct($mode);
+  %tags_hash = map(split_key_value($_), @tags);
+}
+notice('Using base path ', $book_base, ' for Devhelp book') if (defined $book_base);
+
+if ($target_nodir)
+{
+  error('Conflicting target directory options') if (defined $target_dir);
+  error('Source and destination filenames expected') unless ($#ARGV == 1);
+
+  install_file($ARGV[0], $ARGV[1], path_basename($ARGV[1]));
+  exit;
+}
+
+unless (defined $target_dir)
+{
+  if ($#ARGV == 1)
+  {
+    my $basename = path_basename($ARGV[1]);
+
+    if (defined($basename) and $basename ne '')
+    {
+      install_file($ARGV[0], $ARGV[1], $basename);
+      exit;
+    }
+  }
+  $target_dir = pop(@ARGV);
+}
+error('No target directory specified') unless (defined($target_dir) and $target_dir ne '');
+
+foreach my $in_name (@ARGV)
+{
+  my $basename = path_basename($in_name);
+  my $out_name = File::Spec->catfile($target_dir, $basename);
+
+  install_file($in_name, $out_name, $basename);
+}
+exit;