office-gobmx/solenv/bin/packimages.pl
Katarina Behrens 73f04a42a2 Extra provisions for images in helpcontent are no longer needed
Change-Id: I327e1e2ac9c54e0cb7009e206018d82b71134747
Reviewed-on: https://gerrit.libreoffice.org/31952
Reviewed-by: Christian Lohmaier <lohmaier+LibreOffice@googlemail.com>
Tested-by: Christian Lohmaier <lohmaier+LibreOffice@googlemail.com>
Tested-by: Jenkins <ci@libreoffice.org>
2017-05-12 13:48:50 +02:00

550 lines
15 KiB
Perl
Executable file

:
eval 'exec perl -wS $0 ${1+"$@"}'
if 0;
#
# This file is part of the LibreOffice project.
#
# This Source Code Form is subject to the terms of the Mozilla Public
# License, v. 2.0. If a copy of the MPL was not distributed with this
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
#
# This file incorporates work covered by the following license notice:
#
# Licensed to the Apache Software Foundation (ASF) under one or more
# contributor license agreements. See the NOTICE file distributed
# with this work for additional information regarding copyright
# ownership. The ASF licenses this file to you under the Apache
# License, Version 2.0 (the "License"); you may not use this file
# except in compliance with the License. You may obtain a copy of
# the License at http://www.apache.org/licenses/LICENSE-2.0 .
#
#
# packimages.pl - pack images into archives
#
use strict;
use Getopt::Long;
use File::Find;
use File::Basename;
use File::Copy qw(copy);
use File::Path qw(make_path rmtree);
require File::Temp;
use File::Temp qw(tempdir);
#### globals ####
my $img_global = '%GLOBALRES%'; # 'global' image prefix
my $img_module = '%MODULE%'; # 'module' image prefix
my $out_file; # path to output archive
my $tmp_out_file; # path to temporary output file
my $global_path; # path to global images directory
my $module_path; # path to module images directory
my $sort_file; # path to file containing sorting data
my @custom_path; # path to custom images directory
my $imagelist_file; # file containing list of image list files
my $verbose; # be verbose
my $extra_verbose; # be extra verbose
my $do_rebuild = 0; # is rebuilding zipfile required?
my @custom_list;
#### script id #####
( my $script_name = $0 ) =~ s/^.*\b(\w+)\.pl$/$1/;
print "$script_name -- version: 1.17\n" if $verbose;
#### main #####
parse_options();
my $image_lists_ref = get_image_lists();
my %image_lists_hash;
foreach ( @{$image_lists_ref} ) {
$image_lists_hash{$_}="";
}
$do_rebuild = is_file_newer(\%image_lists_hash) if $do_rebuild == 0;
my ($global_hash_ref, $module_hash_ref, $custom_hash_ref) = iterate_image_lists($image_lists_ref);
# custom_hash filled from filesystem lookup
find_custom($custom_hash_ref);
# build a consolidated set of links
my %links;
read_links(\%links, $global_path);
for my $path (@custom_path) {
read_links(\%links, $path);
}
check_links(\%links);
# rebuild if links.txt has been modified
for my $path (@custom_path) {
my $links_file = $path."/links.txt";
if ((-e $links_file ) && ( -e $out_file )){
if ((stat($out_file))[9] < (stat($links_file))[9]){
$do_rebuild = 1;
print_message("$links_file has been modified.") if $verbose;
}
}
}
my $zip_hash_ref = create_zip_list($global_hash_ref, $module_hash_ref, $custom_hash_ref);
remove_links_from_zip_list($zip_hash_ref, \%links);
$do_rebuild = is_file_newer($zip_hash_ref) if $do_rebuild == 0;
if ( $do_rebuild == 1 ) {
my $tmpdir = copy_images($zip_hash_ref);
create_zip_archive($zip_hash_ref, \%links, $tmpdir);
replace_file($tmp_out_file, $out_file);
print_message("packing $out_file finished.") if $verbose;
rmtree($tmpdir);
print_error("failed to delete $tmpdir") if -e $tmpdir;
} else {
print_message("$out_file up to date. nothing to do.") if $verbose;
}
exit(0);
#### subroutines ####
sub parse_options
{
my $opt_help;
my $p = Getopt::Long::Parser->new();
my @custom_path_list;
my $success =$p->getoptions(
'-h' => \$opt_help,
'-o=s' => \$out_file,
'-g=s' => \$global_path,
'-s=s' => \$sort_file,
'-m=s' => \$module_path,
'-c=s' => \@custom_path_list,
'-l=s' => \$imagelist_file,
'-v' => \$verbose,
'-vv' => \$extra_verbose
);
if ( $opt_help || !$success || !$out_file || !$global_path
|| !$module_path || !@custom_path_list || !$imagelist_file )
{
usage();
exit(1);
}
#define intermediate output file
$tmp_out_file="$out_file"."$$".".tmp";
# Sanity checks.
# Check if out_file can be written.
my $out_dir = dirname($out_file);
# Check paths.
print_error("no such file '$_'", 2) if ! -f $imagelist_file;
my @check_directories = ($out_dir, $global_path, $module_path);
foreach (@check_directories) {
print_error("no such directory: '$_'", 2) if ! -d $_;
print_error("can't search directory: '$_'", 2) if ! -x $_;
}
print_error("directory is not writable: '$out_dir'", 2) if ! -w $out_dir;
# Use just the working paths
@custom_path = ();
foreach (@custom_path_list) {
if ( ! -d $_ ) {
print_warning("skipping non-existing directory: '$_'", 2);
}
elsif ( ! -x $_ ) {
print_error("can't search directory: '$_'", 2);
}
else {
push @custom_path, $_;
}
}
}
sub get_image_lists
{
my @image_lists;
open (my $fh, $imagelist_file) or die "cannot open imagelist file $imagelist_file\n";
while (<$fh>) {
chomp;
next if /^\s*$/;
my @ilsts = split ' ';
push @image_lists, @ilsts;
}
close $fh;
return wantarray ? @image_lists : \@image_lists;
}
sub iterate_image_lists
{
my $image_lists_ref = shift;
my %global_hash;
my %module_hash;
my %custom_hash;
my %help_hash;
foreach my $i ( @{$image_lists_ref} ) {
parse_image_list($i, \%global_hash, \%module_hash, \%custom_hash, \%help_hash);
}
return (\%global_hash, \%module_hash, \%custom_hash, \%help_hash);
}
sub parse_image_list
{
my $image_list = shift;
my $global_hash_ref = shift;
my $module_hash_ref = shift;
my $custom_hash_ref = shift;
print_message("parsing '$image_list' ...") if $verbose;
my $linecount = 0;
open(IMAGE_LIST, "< $image_list") or die "ERROR: can't open $image_list: $!";
while ( <IMAGE_LIST> ) {
$linecount++;
next if /^\s*#/;
next if /^\s*$/;
# clean up trailing whitespace
tr/\r\n//d;
s/\s+$//;
# clean up backslashes and double slashes
tr{\\}{/}s;
tr{/}{}s;
# hack "res" back into globals
if ( /^\Q$img_global\E\/(.*)$/o ) {
$global_hash_ref->{"res/".$1}++;
next;
}
if ( /^\Q$img_module\E\/(.*)$/o ) {
$module_hash_ref->{$1}++;
next;
}
# parse failed if we reach this point, bail out
close(IMAGE_LIST);
print_error("can't parse line $linecount from file '$image_list'", 4);
}
close(IMAGE_LIST);
return ($global_hash_ref, $module_hash_ref, $custom_hash_ref);
}
sub find_custom
{
my $custom_hash_ref = shift;
my $keep_back;
for my $path (@custom_path) {
find({ wanted => \&wanted, no_chdir => 0 }, $path);
foreach ( @custom_list ) {
if ( /^\Q$path\E\/(.*)$/ ) {
$keep_back=$1;
if (!defined $custom_hash_ref->{$keep_back}) {
$custom_hash_ref->{$keep_back} = $path;
}
}
}
}
}
sub wanted
{
my $file = $_;
if ( $file =~ /.*\.png$/ && -f $file ) {
push @custom_list, $File::Find::name;
}
}
sub create_zip_list
{
my $global_hash_ref = shift;
my $module_hash_ref = shift;
my $custom_hash_ref = shift;
my %zip_hash;
my @warn_list;
print_message("assemble image list ...") if $verbose;
foreach ( keys %{$global_hash_ref} ) {
# check if in 'global' and in 'module' list and add to warn list
if ( exists $module_hash_ref->{$_} ) {
push(@warn_list, $_);
next;
}
if ( exists $custom_hash_ref->{$_} ) {
$zip_hash{$_} = $custom_hash_ref->{$_};
next;
}
# it's neither in 'module' nor 'custom', record it in zip hash
$zip_hash{$_} = $global_path;
}
foreach ( keys %{$module_hash_ref} ) {
if ( exists $custom_hash_ref->{$_} ) {
$zip_hash{$_} = $custom_hash_ref->{$_};
next;
}
# it's not in 'custom', record it in zip hash
$zip_hash{$_} = $module_path;
}
if ( @warn_list ) {
foreach ( @warn_list ) {
print_warning("$_ is duplicated in 'global' and 'module' list");
}
}
return \%zip_hash
}
sub is_file_newer
{
my $test_hash_ref = shift;
my $reference_stamp = 0;
print_message("checking timestamps ...") if $verbose;
if ( -e $out_file ) {
$reference_stamp = (stat($out_file))[9];
print_message("found $out_file with $reference_stamp ...") if $verbose;
}
return 1 if $reference_stamp == 0;
foreach ( sort keys %{$test_hash_ref} ) {
my $path = $test_hash_ref->{$_};
$path .= "/" if "$path" ne "";
$path .= "$_";
print_message("checking '$path' ...") if $extra_verbose;
my $mtime = (stat($path))[9];
return 1 if $reference_stamp < $mtime;
}
return 0;
}
sub optimize_zip_layout($)
{
my $zip_hash_ref = shift;
if (!defined $sort_file) {
print_message("no sort file - sorting alphabetically ...") if $verbose;
return sort keys %{$zip_hash_ref};
}
print_message("sorting from $sort_file ...") if $verbose;
my $orderh;
my %included;
my @sorted;
open ($orderh, $sort_file) || die "Can't open $sort_file: $!";
while (<$orderh>) {
/^\#.*/ && next; # comments
s/[\r\n]*$//;
/^\s*$/ && next;
my $file = $_;
if (!defined $zip_hash_ref->{$file}) {
print "unknown file '$file'\n" if ($extra_verbose);
} else {
push @sorted, $file;
$included{$file} = 1;
}
}
close ($orderh);
for my $img (sort keys %{$zip_hash_ref}) {
push @sorted, $img if (!$included{$img});
}
print_message("done sort ...") if $verbose;
return @sorted;
}
sub copy_images($)
{
my ($zip_hash_ref) = @_;
my $dir = tempdir();
foreach (keys %$zip_hash_ref) {
my $path = $zip_hash_ref->{$_} . "/$_";
my $outpath = $dir . "/$_";
print_message("copying '$path' to '$outpath' ...") if $extra_verbose;
if ( -e $path) {
my $dirname = dirname($outpath);
if (!-d $dirname) {
make_path($dirname);
}
copy($path, $outpath)
or print_error("can't add file '$path' to image dir: $!", 5);
}
}
return $dir;
}
sub create_zip_archive($$$)
{
my ($zip_hash_ref, $links_hash_ref, $image_dir_ref) = @_;
print_message("creating image archive ...") if $verbose;
chdir $image_dir_ref;
if (keys %{$links_hash_ref}) {
write_links($links_hash_ref, $image_dir_ref);
system "zip $tmp_out_file links.txt";
# print_error("failed to add links file: $!", 5);
}
my @sorted_list = optimize_zip_layout($zip_hash_ref);
my $sorted_file = File::Temp->new();
foreach my $item (@sorted_list) {
print $sorted_file "$item\n";
}
binmode $sorted_file; # flush
system "cat $sorted_file | zip -0 -@ $tmp_out_file";
# print_error("write image zip archive '$tmp_out_file' failed. Reason: $!", 6);
chdir; # just go out of the temp dir
}
sub replace_file
{
my $source_file = shift;
my $dest_file = shift;
my $result = 0;
$result = unlink($dest_file) if -f $dest_file;
if ( $result != 1 && -f $dest_file ) {
unlink $source_file;
print_error("couldn't remove '$dest_file'",1);
} else {
if ( !rename($source_file, $dest_file)) {
unlink $source_file;
print_error("couldn't rename '$source_file'",1);
}
}
return;
}
sub usage
{
print STDERR "Usage: packimages.pl [-h] -o out_file -g g_path -m m_path -c c_path -l imagelist_file\n";
print STDERR "Creates archive of images\n";
print STDERR "Options:\n";
print STDERR " -h print this help\n";
print STDERR " -o out_file path to output archive\n";
print STDERR " -g g_path path to global images directory\n";
print STDERR " -m m_path path to module images directory\n";
print STDERR " -c c_path path to custom images directory\n";
print STDERR " -s sort_file path to image sort order file\n";
print STDERR " -l imagelist_file file containing list of image list files\n";
print STDERR " -v verbose\n";
print STDERR " -vv very verbose\n";
}
sub print_message
{
my $message = shift;
print "$script_name: ";
print "$message\n";
return;
}
sub print_warning
{
my $message = shift;
print STDERR "$script_name: ";
print STDERR "WARNING $message\n";
return;
}
sub print_error
{
my $message = shift;
my $error_code = shift;
print STDERR "$script_name: ";
print STDERR "ERROR: $message\n";
if ( $error_code ) {
print STDERR "\nFAILURE: $script_name aborted.\n";
exit($error_code);
}
return;
}
sub read_links($$)
{
my $links = shift;
my $path = shift;
my $fname = "$path/links.txt";
if (!-f "$fname") {
return;
}
my $fh;
open ($fh, $fname) || die "Can't open: $fname: $!";
# Syntax of links file:
# # comment
# missing-image image-to-load-instead
while (<$fh>) {
my $line = $_;
$line =~ s/\r//g; # DOS line-feeds
$line =~ s/\#.*$//; # kill comments
$line =~ m/^\s*$/ && next; # blank lines
if ($line =~ m/^([^\s]+)\s+(.*)$/) {
my ($missing, $replace) = ($1, $2);
# enter into hash, and overwrite previous layer if necessary
$links->{$1} = $2;
} else {
die "Malformed links line: '$line'\n";
}
}
close ($fh);
}
# write out the links
sub write_links($$)
{
my ($links, $out_dir_ref) = @_;
open (my $fh, ">", "$out_dir_ref/links.txt")
|| die "can't create links.txt";
for my $missing (sort keys %{$links}) {
my $line = $missing . " " . $links->{$missing} . "\n";
print $fh $line;
}
close $fh;
}
# Ensure that no link points to another link
sub check_links($)
{
my $links = shift;
my $stop_die = 0;
for my $link (keys %{$links}) {
my $value = $links->{$link};
if (defined $links->{$value}) {
print STDERR "\nLink: $link -> $value -> " . $links->{$value};
$stop_die = 1;
}
}
if ( $stop_die ) {
die "\nSome icons in links.txt were found to link to other linked icons.\n\n";
}
}
# remove any files from our zip list that are linked
sub remove_links_from_zip_list($$)
{
my $zip_hash_ref = shift;
my $links = shift;
for my $link (keys %{$links}) {
if (defined $zip_hash_ref->{$link}) {
delete $zip_hash_ref->{$link};
}
}
}