From 267c6f2ac71f92999e969232431ba04678e7437e Mon Sep 17 00:00:00 2001 From: Daniel Baumann Date: Mon, 15 Apr 2024 07:54:39 +0200 Subject: Adding upstream version 4:24.2.0. Signed-off-by: Daniel Baumann --- basegfx/qa/mkpolygons.pl | 347 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 347 insertions(+) create mode 100644 basegfx/qa/mkpolygons.pl (limited to 'basegfx/qa/mkpolygons.pl') diff --git a/basegfx/qa/mkpolygons.pl b/basegfx/qa/mkpolygons.pl new file mode 100644 index 0000000000..714031775e --- /dev/null +++ b/basegfx/qa/mkpolygons.pl @@ -0,0 +1,347 @@ +: +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 . +# + +use IO::File; +use Cwd; +use File::Spec; +use File::Spec::Functions; +use File::Temp; +use File::Path; + +$TempDir = ""; + + +# all the XML package generation is a blatant rip from AF's +# write-calc-doc.pl + + +# Open a file with the given name. +# First it is checked if the temporary directory, in which all files for +# the document are gathered, is already present and create it if it is not. +# Then create the path to the file inside the temporary directory. +# Finally open the file and return a file handle to it. +# +sub open_file +{ + my $filename = pop @_; + + # Create base directory of temporary directory tree if not already + # present. + if ($TempDir eq "") + { + $TempDir = File::Temp::tempdir (CLEANUP => 1); + } + + # Create the path to the file. + my $fullname = File::Spec->catfile ($TempDir, $filename); + my ($volume,$directories,$file) = File::Spec->splitpath ($fullname); + mkpath (File::Spec->catpath ($volume,$directories,"")); + + # Open the file and return a file handle to it. + return new IO::File ($fullname, "w"); +} + + +# Zip the files in the directory tree into the given file. +# +sub zip_dirtree +{ + my $filename = pop @_; + + my $cwd = getcwd; + my $zip_name = $filename; + + # We are about to change the directory. + # Therefore create an absolute pathname for the zip archive. + + # First transfer the drive from $cwd to $zip_name. This is a + # workaround for a bug in file_name_is_absolute which thinks + # the path \bla is an absolute path under DOS. + my ($volume,$directories,$file) = File::Spec->splitpath ($zip_name); + my ($volume_cwd,$directories_cwd,$file_cwd) = File::Spec->splitpath ($cwd); + $volume = $volume_cwd if ($volume eq ""); + $zip_name = File::Spec->catpath ($volume,$directories,$file); + + # Add the current working directory to a relative path. + if ( ! file_name_is_absolute ($zip_name)) + { + $zip_name = File::Spec->catfile ($cwd, $zip_name); + + # Try everything to clean up the name. + $zip_name = File::Spec->rel2abs ($filename); + $zip_name = File::Spec->canonpath ($zip_name); + + # Remove .. directories from the middle of the path. + while ($zip_name =~ /\/[^\/][^\.\/][^\/]*\/\.\.\//) + { + $zip_name = $` . "/" . $'; + } + } + + # Just in case the zip program gets confused by an existing file with the + # same name as the one to be written that file is removed first. + if ( -e $filename) + { + if (unlink ($filename) == 0) + { + print "Existing file $filename could not be deleted.\n"; + print "Please close the application that uses it, then try again.\n"; + return; + } + } + + # Finally create the zip file. First change into the temporary directory + # so that the resulting zip file contains only paths relative to it. + print "zipping [$ZipCmd $ZipFlags $zip_name *]\n"; + chdir ($TempDir); + system ("$ZipCmd $ZipFlags $zip_name *"); + chdir ($cwd); +} + + +sub writeHeader +{ + print $OUT qq~ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +~; + +} + +sub writeSlideHeader +{ + my $titleText = pop @_; + my $slideNum = pop @_; + + print $OUT " \n"; + print $OUT " \n"; + print $OUT " \n"; + print $OUT " Slide: $slideNum\n"; + print $OUT " Path: $titleText\n"; + print $OUT " \n"; +} + + +sub writeSlideFooter +{ + print $OUT " \n"; + print $OUT " \n"; + print $OUT " \n"; + print $OUT " \n"; + print $OUT " \n"; + print $OUT " \n"; + print $OUT " \n"; +} + +sub writeFooter +{ + print $OUT qq~ + + + +~; + +} + +sub writePath +{ + my $pathAry = pop @_; + my $path = $pathAry->[1]; + my $viewBox = $pathAry->[0]; + + print $OUT " \n"; + print $OUT " \n"; + print $OUT " \n"; +} + +sub writeManifest +{ + my $outFile = open_file("META-INF/manifest.xml"); + + print $outFile qq~ + + + + + +~; + + $outFile->close; +} + + +# Print usage information. +# +sub usage () +{ + print <* [] + +output-file-name defaults to polygons.odp. + + -h Print this usage information. + -o output-file-name +END_OF_USAGE +} + +# Process the command line. +# +sub process_command_line +{ + foreach (@ARGV) + { + if (/^-h/) + { + usage; + exit 0; + } + } + + $global_output_name = "polygons.odp"; + my $j = 0, $noMoreOptions = 0; + for (my $i=0; $i<$#ARGV; $i++) + { + if ( !$noMoreOptions and $ARGV[$i] eq "-o") + { + $i++; + $global_output_name = $ARGV[$i]; + } + elsif ( !$noMoreOptions and $ARGV[$i] eq "--") + { + $noMoreOptions = 1; + } + elsif ( !$noMoreOptions and $ARGV[$i] =~ /^-/) + { + print "Unknown option $ARGV[$i]\n"; + usage; + exit 1; + } + else + { + push(@paths, [$ARGV[$i],$ARGV[$i+1]]); + $i++; + } + } + + print "output to $global_output_name\n"; +} + +# Main + +$ZipCmd = $ENV{LOG_FILE_ZIP_CMD}; +$ZipFlags = $ENV{LOG_FILE_ZIP_FLAGS}; +# Provide default values for the zip command and it's flags. +if ( ! defined $ZipCmd) +{ + $ZipCmd = "zip" unless defined $ZipCmd; + $ZipFlags = "-r -q" unless defined $ZipFlags; +} + +process_command_line(); + +writeManifest(); + +$OUT = open_file( "content.xml" ); + +writeHeader(); + +$pathNum=0; +foreach $path (@paths) +{ + writeSlideHeader($pathNum, $path->[1]); + writePath($path); + writeSlideFooter(); + $pathNum++; +} + +writeFooter(); + +$OUT->close; + +zip_dirtree ($global_output_name); + -- cgit v1.2.3