|
Packit Service |
e3b512 |
package main;
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
# Copyright (c) 2009 Openismus GmbH <http://www.openismus.com/>
|
|
Packit Service |
e3b512 |
#
|
|
Packit Service |
e3b512 |
# This file is part of mm-common.
|
|
Packit Service |
e3b512 |
#
|
|
Packit Service |
e3b512 |
# mm-common is free software: you can redistribute it and/or modify
|
|
Packit Service |
e3b512 |
# it under the terms of the GNU General Public License as published
|
|
Packit Service |
e3b512 |
# by the Free Software Foundation, either version 2 of the License,
|
|
Packit Service |
e3b512 |
# or (at your option) any later version.
|
|
Packit Service |
e3b512 |
#
|
|
Packit Service |
e3b512 |
# mm-common is distributed in the hope that it will be useful,
|
|
Packit Service |
e3b512 |
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
Packit Service |
e3b512 |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
Packit Service |
e3b512 |
# GNU General Public License for more details.
|
|
Packit Service |
e3b512 |
#
|
|
Packit Service |
e3b512 |
# You should have received a copy of the GNU General Public License
|
|
Packit Service |
e3b512 |
# along with mm-common. If not, see <http://www.gnu.org/licenses/>.
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
use strict;
|
|
Packit Service |
e3b512 |
use warnings;
|
|
Packit Service |
e3b512 |
use bytes;
|
|
Packit Service |
e3b512 |
use File::Glob qw(:glob);
|
|
Packit Service |
e3b512 |
use File::Spec;
|
|
Packit Service |
e3b512 |
use Getopt::Long qw(:config no_getopt_compat no_ignore_case require_order bundling);
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
# Globals
|
|
Packit Service |
e3b512 |
my $message_prefix;
|
|
Packit Service |
e3b512 |
my %tags_hash;
|
|
Packit Service |
e3b512 |
my $book_base;
|
|
Packit Service |
e3b512 |
my $perm_mode;
|
|
Packit Service |
e3b512 |
my $target_dir;
|
|
Packit Service |
e3b512 |
my $target_nodir = '';
|
|
Packit Service |
e3b512 |
my $expand_glob = '';
|
|
Packit Service |
e3b512 |
my $verbose = '';
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
sub path_basename ($)
|
|
Packit Service |
e3b512 |
{
|
|
Packit Service |
e3b512 |
my ($path) = @_;
|
|
Packit Service |
e3b512 |
my $basename = File::Spec->splitpath($path);
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
return $basename;
|
|
Packit Service |
e3b512 |
}
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
sub exit_help ()
|
|
Packit Service |
e3b512 |
{
|
|
Packit Service |
e3b512 |
my $script_name = path_basename($0) || 'doc-install.pl';
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
print <<"EOF";
|
|
Packit Service |
e3b512 |
Usage: perl $script_name [OPTION]... [-T] SOURCE DEST
|
|
Packit Service |
e3b512 |
or: perl $script_name [OPTION]... SOURCE... DIRECTORY
|
|
Packit Service |
e3b512 |
or: perl $script_name [OPTION]... -t DIRECTORY SOURCE...
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
Copy SOURCE to DEST or multiple SOURCE files to the existing DIRECTORY,
|
|
Packit Service |
e3b512 |
while setting permission modes. For HTML files, translate references to
|
|
Packit Service |
e3b512 |
external documentation.
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
Mandatory arguments to long options are mandatory for short options, too.
|
|
Packit Service |
e3b512 |
--book-base=BASEPATH use reference BASEPATH for Devhelp book
|
|
Packit Service |
e3b512 |
-l, --tag-base=TAGFILE\@BASEPATH use BASEPATH for references from TAGFILE
|
|
Packit Service |
e3b512 |
-m, --mode=MODE override file permission MODE (octal)
|
|
Packit Service |
e3b512 |
-t, --target-directory=DIRECTORY copy all SOURCE arguments into DIRECTORY
|
|
Packit Service |
e3b512 |
-T, --no-target-directory treat DEST as normal file
|
|
Packit Service |
e3b512 |
--glob expand SOURCE as filename glob pattern
|
|
Packit Service |
e3b512 |
-v, --verbose enable informational messages
|
|
Packit Service |
e3b512 |
-?, --help display this help and exit
|
|
Packit Service |
e3b512 |
EOF
|
|
Packit Service |
e3b512 |
exit;
|
|
Packit Service |
e3b512 |
}
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
sub notice (@)
|
|
Packit Service |
e3b512 |
{
|
|
Packit Service |
e3b512 |
print($message_prefix, @_, "\n") if ($verbose);
|
|
Packit Service |
e3b512 |
}
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
sub warning (@)
|
|
Packit Service |
e3b512 |
{
|
|
Packit Service |
e3b512 |
print STDERR ($message_prefix, @_, "\n");
|
|
Packit Service |
e3b512 |
}
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
sub error (@)
|
|
Packit Service |
e3b512 |
{
|
|
Packit Service |
e3b512 |
warning(@_);
|
|
Packit Service |
e3b512 |
exit 1;
|
|
Packit Service |
e3b512 |
}
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
# Copy file to destination while translating references on the fly.
|
|
Packit Service |
e3b512 |
# Sniff the content for the file type, as it is always read in anyway.
|
|
Packit Service |
e3b512 |
sub install_file ($$$)
|
|
Packit Service |
e3b512 |
{
|
|
Packit Service |
e3b512 |
my ($in_name, $out_name, $basename) = @_;
|
|
Packit Service |
e3b512 |
my ($in, $out, $buf);
|
|
Packit Service |
e3b512 |
{
|
|
Packit Service |
e3b512 |
local $/; # slurp mode: read entire file into buffer
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
open($in, '<', $in_name) and binmode($in) and defined($buf = <$in>) and close($in)
|
|
Packit Service |
e3b512 |
or error('Failed to read ', $basename, ': ', $!);
|
|
Packit Service |
e3b512 |
}
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
if (%tags_hash and $buf =~ m/\A(?> \s*)(?> (?> <[?!][^<]+ )* )<html[>\s]/sx)
|
|
Packit Service |
e3b512 |
{
|
|
Packit Service |
e3b512 |
my $count = 0;
|
|
Packit Service |
e3b512 |
my $total = $buf =~
|
|
Packit Service |
e3b512 |
s!(?<= \s) doxygen="((?> [^:"]+)):((?> [^"]*))" # doxygen="(TAGFILE):(BASEPATH)"
|
|
Packit Service |
e3b512 |
(?> \s+) ((?> href|src) =") \2 ((?> [^"]*)") # (href|src=")BASEPATH(RELPATH")
|
|
Packit Service |
e3b512 |
! $3 . ((exists $tags_hash{$1}) ? (++$count, $tags_hash{$1}) : $2) . $4
|
|
Packit Service |
e3b512 |
!egsx;
|
|
Packit Service |
e3b512 |
my $change = $total ? "rewrote $count of $total"
|
|
Packit Service |
e3b512 |
: 'no';
|
|
Packit Service |
e3b512 |
notice('Translating ', $basename, ' (', $change, ' references)');
|
|
Packit Service |
e3b512 |
}
|
|
Packit Service |
e3b512 |
elsif (defined($book_base) and $buf =~ m/\A(?> \s*)(?> (?> <[?!][^<]+ )* )
|
|
Packit Service |
e3b512 |
{
|
|
Packit Service |
e3b512 |
# Substitute new value for attribute "base" of element <book>
|
|
Packit Service |
e3b512 |
my $change = $buf =~ s/(<book \s [^<>]*? \b base=") (?> [^"]*) (?= ")/$1$book_base/sx
|
|
Packit Service |
e3b512 |
? 'rewrote base path'
|
|
Packit Service |
e3b512 |
: 'base path not set';
|
|
Packit Service |
e3b512 |
notice('Translating ', $basename, ' (', $change, ')');
|
|
Packit Service |
e3b512 |
}
|
|
Packit Service |
e3b512 |
else
|
|
Packit Service |
e3b512 |
{
|
|
Packit Service |
e3b512 |
notice('Copying ', $basename);
|
|
Packit Service |
e3b512 |
}
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
# Avoid inheriting permissions of existing file
|
|
Packit Service |
e3b512 |
unlink($out_name);
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
open($out, '>', $out_name) and binmode($out) and print $out ($buf) and close($out)
|
|
Packit Service |
e3b512 |
or error('Failed to write ', $basename, ': ', $!);
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
chmod($perm_mode, $out_name)
|
|
Packit Service |
e3b512 |
or warning('Failed to set ', $basename, ' permissions: ', $!);
|
|
Packit Service |
e3b512 |
}
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
# Split TAGFILE@BASEPATH argument into key/value pair
|
|
Packit Service |
e3b512 |
sub split_key_value ($)
|
|
Packit Service |
e3b512 |
{
|
|
Packit Service |
e3b512 |
my ($mapping) = @_;
|
|
Packit Service |
e3b512 |
my ($name, $path) = split(m'@', $mapping, 2);
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
error('Invalid base path mapping: ', $mapping) unless (defined($name) and $name ne '');
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
if (defined $path)
|
|
Packit Service |
e3b512 |
{
|
|
Packit Service |
e3b512 |
notice('Using base path ', $path, ' for tag file ', $name);
|
|
Packit Service |
e3b512 |
return ($name, $path);
|
|
Packit Service |
e3b512 |
}
|
|
Packit Service |
e3b512 |
notice('Not changing base path for tag file ', $name);
|
|
Packit Service |
e3b512 |
return ();
|
|
Packit Service |
e3b512 |
}
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
# Define line leader of log messages
|
|
Packit Service |
e3b512 |
$message_prefix = path_basename($0);
|
|
Packit Service |
e3b512 |
$message_prefix =~ s/\.[^.]*$//s if (defined $message_prefix);
|
|
Packit Service |
e3b512 |
$message_prefix = ($message_prefix || 'doc-install') . ': ';
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
# Process command-line options
|
|
Packit Service |
e3b512 |
{
|
|
Packit Service |
e3b512 |
my @tags = ();
|
|
Packit Service |
e3b512 |
my $mode = '0644';
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
GetOptions('book-base=s' => \$book_base,
|
|
Packit Service |
e3b512 |
'tag-base|l=s' => \@tags,
|
|
Packit Service |
e3b512 |
'mode|m=s' => \$mode,
|
|
Packit Service |
e3b512 |
'target-directory|t=s' => \$target_dir,
|
|
Packit Service |
e3b512 |
'no-target-directory|T' => \$target_nodir,
|
|
Packit Service |
e3b512 |
'glob' => \$expand_glob,
|
|
Packit Service |
e3b512 |
'verbose|v' => \$verbose,
|
|
Packit Service |
e3b512 |
'help|?' => \&exit_help)
|
|
Packit Service |
e3b512 |
or exit 2;
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
error('Invalid permission mode: ', $mode) unless ($mode =~ m/^[0-7]+$/s);
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
$perm_mode = oct($mode);
|
|
Packit Service |
e3b512 |
%tags_hash = map(split_key_value($_), @tags);
|
|
Packit Service |
e3b512 |
}
|
|
Packit Service |
e3b512 |
notice('Using base path ', $book_base, ' for Devhelp book') if (defined $book_base);
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
if ($target_nodir)
|
|
Packit Service |
e3b512 |
{
|
|
Packit Service |
e3b512 |
error('Conflicting target directory options') if (defined $target_dir);
|
|
Packit Service |
e3b512 |
error('Source and destination filenames expected') unless ($#ARGV == 1);
|
|
Packit Service |
e3b512 |
error('Filename globbing requires target directory') if ($expand_glob);
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
install_file($ARGV[0], $ARGV[1], path_basename($ARGV[1]));
|
|
Packit Service |
e3b512 |
exit;
|
|
Packit Service |
e3b512 |
}
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
unless (defined $target_dir)
|
|
Packit Service |
e3b512 |
{
|
|
Packit Service |
e3b512 |
if (!$expand_glob and $#ARGV == 1)
|
|
Packit Service |
e3b512 |
{
|
|
Packit Service |
e3b512 |
my $basename = path_basename($ARGV[1]);
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
if (defined($basename) and $basename ne '')
|
|
Packit Service |
e3b512 |
{
|
|
Packit Service |
e3b512 |
install_file($ARGV[0], $ARGV[1], $basename);
|
|
Packit Service |
e3b512 |
exit;
|
|
Packit Service |
e3b512 |
}
|
|
Packit Service |
e3b512 |
}
|
|
Packit Service |
e3b512 |
$target_dir = pop(@ARGV);
|
|
Packit Service |
e3b512 |
}
|
|
Packit Service |
e3b512 |
error('No target directory specified') unless (defined($target_dir) and $target_dir ne '');
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
@ARGV = map(bsd_glob($_, GLOB_NOSORT), @ARGV) if ($expand_glob);
|
|
Packit Service |
e3b512 |
my %basename_hash = ();
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
foreach my $in_name (@ARGV)
|
|
Packit Service |
e3b512 |
{
|
|
Packit Service |
e3b512 |
my $basename = path_basename($in_name);
|
|
Packit Service |
e3b512 |
|
|
Packit Service |
e3b512 |
# If there are multiple files with the same base name in the list, only
|
|
Packit Service |
e3b512 |
# the first one will be installed. This behavior makes it very easy to
|
|
Packit Service |
e3b512 |
# implement a VPATH search for each individual file.
|
|
Packit Service |
e3b512 |
unless (exists $basename_hash{$basename})
|
|
Packit Service |
e3b512 |
{
|
|
Packit Service |
e3b512 |
$basename_hash{$basename} = undef;
|
|
Packit Service |
e3b512 |
my $out_name = File::Spec->catfile($target_dir, $basename);
|
|
Packit Service |
e3b512 |
install_file($in_name, $out_name, $basename);
|
|
Packit Service |
e3b512 |
}
|
|
Packit Service |
e3b512 |
}
|
|
Packit Service |
e3b512 |
exit;
|