diff options
Diffstat (limited to 'support/autolatex/pm/AutoLaTeX/Core')
-rw-r--r-- | support/autolatex/pm/AutoLaTeX/Core/Config.pm | 876 | ||||
-rw-r--r-- | support/autolatex/pm/AutoLaTeX/Core/IntUtils.pm | 201 | ||||
-rw-r--r-- | support/autolatex/pm/AutoLaTeX/Core/Main.pm | 542 | ||||
-rw-r--r-- | support/autolatex/pm/AutoLaTeX/Core/OS.pm | 555 | ||||
-rw-r--r-- | support/autolatex/pm/AutoLaTeX/Core/Progress.pm | 535 | ||||
-rw-r--r-- | support/autolatex/pm/AutoLaTeX/Core/Translator.pm | 1308 | ||||
-rw-r--r-- | support/autolatex/pm/AutoLaTeX/Core/Util.pm | 1467 |
7 files changed, 5484 insertions, 0 deletions
diff --git a/support/autolatex/pm/AutoLaTeX/Core/Config.pm b/support/autolatex/pm/AutoLaTeX/Core/Config.pm new file mode 100644 index 0000000000..9859ee8dec --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/Core/Config.pm @@ -0,0 +1,876 @@ +# autolatex - Config.pm +# Copyright (C) 1998-15 Stephane Galland <galland@arakhne.org> +# +# This program 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. +# +# This program 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 this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +Config.pm - Configuration Files + +=head1 DESCRIPTION + +Provides a set of utilities for manipulating cofiguration files. + +To use this library, type C<use AutoLaTeX::Core::Config;>. + +=head1 FUNCTIONS + +The provided functions are: + +=over 4 + +=cut +package AutoLaTeX::Core::Config; + +$VERSION = '36.0'; +@ISA = ('Exporter'); +@EXPORT = qw( &getProjectConfigFilename &getUserConfigFilename &getSystemConfigFilename + &getSystemISTFilename &readConfiguration &readConfigFile &getUserConfigDirectory + &cfgBoolean &doConfigurationFileFixing &cfgToBoolean &writeConfigFile + &readOnlySystemConfiguration &readOnlyUserConfiguration &readOnlyProjectConfiguration + &setInclusionFlags &reinitInclusionFlags &cfgIsBoolean &rebuiltConfigValue ) ; +@EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use warnings; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); + +use File::Spec; +use Config::Simple; + +use AutoLaTeX::Core::OS; +use AutoLaTeX::Core::Util; +use AutoLaTeX::Core::IntUtils; + +# Constant that is representing an empty string in the INI file. +# This constant is mandatory because Config::Simple does not +# support the empty values, such as "KEY =". In place, +# the INI file must contains something like "KEY = <<<<empty>>>>". +use constant EMPTY_INI_VALUE => '<<<<empty>>>>'; + +####################################################### +# Comments for the sections of the configuration file +my %SECTION_COMMENTS = ( + 'viewer' => _T("Configuration of the viewing functions"), + 'generation' => _T("Configuration of the generation functions"), + 'clean' => _T("Configuration of the several cleaning functions"), + 'scm' => _T("Configuration of the SCM functions"), + 'gtk' => _T("GTK interface configuration"), + 'qt' => _T("Qt interface configuration"), + 'windows' => _T("Windows interface configuration"), + 'macos' => _T("MacOS interface configuration"), + 'wxwidget' => _T("wxWidgets interface configuration"), +); + +####################################################### +# Comments for the public configuration entries +my %CONFIGURATION_COMMENTS = ( + # <NO CATEGORY> + # CLEAN + 'clean.files to clean' => _T( "List of additional files to remove when cleaning (shell ". + "wild cards are allowed). This list is used when the ". + "target 'clean' is invoked."), + 'clean.files to desintegrate' => _T( "List of additional files to remove when all cleaning ". + "(shell wild cards are allowed). This list is used when ". + "the target 'cleanall' is invoked."), + # GENERATION + 'generation.biblio' => _T( "Indicates if bibliography tool (bibtex,biber) should be run ('yes' or 'no')."), + 'generation.generate images' => _T( "Does the figures must be automatically generated ('yes' or 'no')?"), + 'generation.image directory' => _T( "Specify the directories inside which AutoLaTeX ". + "will find the pictures which must be processed ". + "by the translators. Each time this option is ". + "put on the command line, a directory is added ". + "inside the list of the directories to explore. ". + "The different paths are separated by the ". + "path-separator character (':' on Unix, ';' on ". + "Windows)"), + 'generation.main file' => _T( "Main filename (this option is only available in project's ". + "configuration files)."), + 'generation.generation type' => _T( "Type of generation.\n pdf : use pdflatex to create a ". + "PDF document."), + 'generation.makeglossaries' => _T( "Indicates if glossary tool (makeglossaries) should be run ('yes' or 'no')."), + 'generation.makeindex style' => _T( "Specify the style that must be used by makeindex.\n". + "Valid values are:\n <filename> if a filename ". + "was specified, AutoLaTeX assumes that it is the .ist ". + "file;\n \@system AutoLaTeX uses the system ". + "default .ist file (in AutoLaTeX distribution);\n". + " \@detect AutoLaTeX will tries to find a .ist ". + "file in the project's directory. If none was found, ". + "AutoLaTeX will not pass a style to makeindex;\n \@none". + " AutoLaTeX assumes that no .ist file must be ". + "passed to makeindex;\n <empty> AutoLaTeX assumes ". + "that no .ist file must be passed to makeindex."), + 'generation.post compilation runs' => _T( "Defines the minimal number of times the LaTeX compilation tools (usually ". + "pdflatex) is run during the last running stage of AutoLaTeX. The default value is 1."), + 'generation.translator include path' => _T( "Defines the paths from which the translators could be ". + "loaded. This is a list of paths separated by the path ". + "separator character used by your operating system: ':' ". + "on Unix platforms or ';' on Windows platforms for example."), + 'generation.synctex' => _T( "Indicates if the PDF document must be produced with the SyncTeX flag on or not. ". + "SyncTeX enables to link a PDF viewer (as evince) and a text editor (as Gedit). ". + "When you click inside one, the other is highlighting the line in its side."), + # SCM + 'scm.scm commit' => _T( "Tool to launch when a SCM commit action is requested. ". + "Basically the SCM tools are CVS, SVN, or GIT."), + 'scm.scm update' => _T( "Tool to launch when a SCM update action is requested. ". + "Basically the SCM tools are CVS, SVN, or GIT."), + # VIEWER + 'viewer.view' => _T( "Indicates if a viewer should be launch after the compilation. ". + "Valid values are 'yes' and 'no'."), + 'viewer.viewer' => _T( "Specify, if not commented,the command line of the viewer."), + 'viewer.asynchronous run' => _T( "Indicates if the viewer is launched in background, or not."), +); + +####################################################### +# Comments for the private configuration entries +# action.create config file +# action.create ist file +# action.fix config file +# config.command line +# input.project directory +# input.latex file +# output.directory +# ouput.ist file +# output.latex basename + + +=pod + +=item B<getProjectConfigFilename(@)> + +Replies the name of a project's configuration file +which is located inside the given directory. + +I<Parameters:> + +=over 8 + +=item * the components of the paths, each parameter is a directory in the path. + +=back + +I<Returns:> the configuration filename according to the current operating system rules. + +=cut +sub getProjectConfigFilename(@) { + my $operatingsystem = getOperatingSystem(); + if (("$operatingsystem" eq 'Unix')||(("$operatingsystem" eq 'Cygwin'))) { + return File::Spec->rel2abs(File::Spec->catfile(@_,".autolatex_project.cfg")); + } + else { + return File::Spec->rel2abs(File::Spec->catfile(@_,"autolatex_project.cfg")); + } +} + +=pod + +=item B<getUserConfigFilename()> + +Replies the name of a user's configuration file. + +I<Returns:> the configuration filename according to the current operating system rules. + +=cut +sub getUserConfigFilename() { + my $confdir = getUserConfigDirectory(); + if (-d "$confdir") { + return File::Spec->catfile("$confdir","autolatex.conf"); + } + my $operatingsystem = getOperatingSystem(); + if (("$operatingsystem" eq 'Unix')||(("$operatingsystem" eq 'Cygwin'))) { + return File::Spec->rel2abs(File::Spec->catfile($ENV{'HOME'},".autolatex")); + } + elsif ("$operatingsystem" eq 'Win32') { + return File::Spec->rel2abs(File::Spec->catfile("C:","Documents and Settings",$ENV{'USER'},"Local Settings","Application Data","autolatex.conf")); + } + else { + return File::Spec->rel2abs(File::Spec->catfile($ENV{'HOME'},"autolatex.conf")); + } +} + +=pod + +=item B<getUserConfigDirectory()> + +Replies the name of a user's configuration directory. + +I<Returns:> the configuration directory according to the current operating system rules. + +=cut +sub getUserConfigDirectory() { + my $operatingsystem = getOperatingSystem(); + if (("$operatingsystem" eq 'Unix')||(("$operatingsystem" eq 'Cygwin'))) { + return File::Spec->rel2abs(File::Spec->catfile($ENV{'HOME'},".autolatex")); + } + elsif ("$operatingsystem" eq 'Win32') { + return File::Spec->rel2abs(File::Spec->catfile("C:","Documents and Settings",$ENV{'USER'},"Local Settings","Application Data","autolatex")); + } + else { + return File::Spec->rel2abs(File::Spec->catfile($ENV{'HOME'},"autolatex")); + } +} + +=pod + +=item B<getSystemConfigFilename()> + +Replies the name of the configuration file for all users. + +I<Returns:> the configuration filename according to the current operating system rules. + +=cut +sub getSystemConfigFilename() { + return File::Spec->catfile(getAutoLaTeXDir(),"default.cfg"); +} + +=pod + +=item B<getSystemISTFilename()> + +Replies the name of the MakeIndex style file for all users. + +I<Returns:> the filename according to the current operating system rules. + +=cut +sub getSystemISTFilename() { + return File::Spec->catfile(getAutoLaTeXDir(),"default.ist"); +} + +=pod + +=item B<cfgBoolean($;$)> + +Replies the Perl boolean value that corresponds to the specified +string. If the first parameter is not a valid boolean string, the second +parameter will be replied if it is specified; if not undef will be replied; + +The valid string are (case insensitive): S<true>, S<false>, S<yes>, S<no>. + +I<Parameters:> + +=over 8 + +=item * the value to test. + +=item * the data structure to fill + +=back + +I<Returns:> nothing + +=cut +sub cfgBoolean($;$) { + if ($_[0]) { + my $v = lc($_[0]); + return 1 if (($v eq 'yes')||($v eq 'true')); + return 0 if (($v eq 'no')||($v eq 'false')); + } + return $_[1]; +} + +=pod + +=item B<cfgToBoolean($)> + +Replies the configuration's file boolean value that corresponds to the specified +Perl boolean value. + +I<Parameters:> + +=over 8 + +=item * the value to test. + +=back + +I<Returns:> nothing + +=cut +sub cfgToBoolean($) { + return ($_[0]) ? 'true' : 'false'; +} + +=pod + +=item B<cfgIsBoolean($)> + +Replies if the specified string is a valid boolean string. + +I<Parameters:> + +=over 8 + +=item * the value to test. + +=back + +I<Returns:> nothing + +=cut +sub cfgIsBoolean($) { + if (defined($_[0])) { + my $v = lc($_[0]); + return 1 + if (($v eq 'yes')||($v eq 'no')||($v eq 'true')||($v eq 'false')); + } + return 0; +} + +=pod + +=item B<readConfiguration()> + +Replies the current configuration. The configuration +is extracted from the system configuration file +(from AutoLaTeX distribution) and from the user +configuration file. + +I<Returns:> a hashtable containing (attribute name, attribute value) pairs. +The attribute name could be S<section.attribute> to describe the attribute inside +a section. + +=cut +sub readConfiguration() { + my %configuration = (); + my $systemFile = getSystemConfigFilename(); + my $userFile = getUserConfigFilename(); + readConfigFile("$systemFile",\%configuration); + readConfigFile("$userFile",\%configuration); + # Remove the main intput filename + if (exists $configuration{'generation.main file'}) { + delete $configuration{'generation.main file'}; + } + return %configuration; +} + +=pod + +=item B<readOnlySystemConfiguration()> + +Replies the current configuration. The configuration +is extracted from the system configuration file +(from AutoLaTeX distribution) only. + +I<Returns:> a hashtable containing (attribute name, attribute value) pairs. +The attribute name could be S<section.attribute> to describe the attribute inside +a section. + +=cut +sub readOnlySystemConfiguration(;$) { + my %configuration = (); + my $systemFile = getSystemConfigFilename(); + readConfigFile("$systemFile",\%configuration,$_[0]); + # Remove the main intput filename + if (exists $configuration{'generation.main file'}) { + delete $configuration{'generation.main file'}; + } + return %configuration; +} + +=pod + +=item B<readOnlyUserConfiguration(;$)> + +Replies the current configuration. The configuration +is extracted from the user configuration file +($HOME/.autolatex or $HOME/.autolatex/autolatex.conf) only. + +I<Returns:> a hashtable containing (attribute name, attribute value) pairs. +The attribute name could be S<section.attribute> to describe the attribute inside +a section. + +=cut +sub readOnlyUserConfiguration(;$) { + my %configuration = (); + my $userFile = getUserConfigFilename(); + readConfigFile("$userFile",\%configuration,$_[0]); + # Remove the main intput filename + if (exists $configuration{'generation.main file'}) { + delete $configuration{'generation.main file'}; + } + return %configuration; +} + +=pod + +=item B<readOnlyProjectConfiguration(@)> + +Replies the current configuration. The configuration +is extracted from the project configuration file +($PROJECT_PATH/.autolatex_project.cfg) only. + +I<Returns:> a hashtable containing (attribute name, attribute value) pairs. +The attribute name could be S<section.attribute> to describe the attribute inside +a section. + +=cut +sub readOnlyProjectConfiguration(@) { + my %configuration = (); + my $userFile = getProjectConfigFilename(@_); + if (-r "$userFile") { + readConfigFile("$userFile",\%configuration); + $configuration{'__private__'}{'input.project directory'} = File::Spec->catfile(@_); + return \%configuration; + } + return undef; +} + +=pod + +=item B<readConfigFile($\%;$)> + +Fill the configuration data structure from the specified file information. +The structure of the filled hashtable is a set of (attribute name, attribute value) pairs. +The attribute name could be S<section.attribute> to describe the attribute inside +a section. + +I<Parameters:> + +=over 8 + +=item * the name of the file to read + +=item * the data structure to fill + +=item * boolean value that indicates if a warning message should be ignored when an old fashion file was detected. + +=back + +I<Returns:> nothing + +=cut +sub readConfigFile($\%;$) { + my $filename = shift; + die('second parameter of readConfigFile() is not a hash') unless(isHash($_[0])); + printDbg(formatText(_T("Opening configuration file {}"),$filename)); + if (-r "$filename") { + my $cfgReader = new Config::Simple("$filename"); + if ($cfgReader) { + my %config = $cfgReader->vars(); + my $warningDisplayed = $_[1]; + while (my ($k,$v) = each (%config)) { + $k = lc("$k"); + if ($k !~ /^__private__/) { + ($k,$v) = ensureAccendentCompatibility("$k",$v,"$filename",$warningDisplayed); + $v = rebuiltConfigValue("$k",$v); + if ($v) { + $_[0]->{"$k"} = $v; + } + } + } + } + printDbg(_T("Succeed on reading")); + } + else { + printDbg(formatText(_T("Failed to read {}: {}"),$filename,$!)); + } + 1; +} + +# Put formatted comments inside an array +sub pushComment(\@$;$) { + my $limit = $_[2] || 60; + $limit = 1 unless ($limit>=1); + my @lines = split(/\n/, $_[1]); + foreach my $line (@lines) { + my @words = split(/\s+/, $line); + my $wline = ''; + if ($line =~ /^(\s+)/) { + $wline .= $1; + } + foreach my $w (@words) { + if ((length($wline)+length($w)+1)>$limit) { + push @{$_[0]}, "#$wline\n"; + if (length($w)>$limit) { + while (length($w)>$limit) { + push @{$_[0]}, "# ".substr($w,0,$limit)."\n"; + $w = substr($w,$limit); + } + } + $wline = " $w"; + } + else { + $wline .= " $w"; + } + } + if ($wline) { + push @{$_[0]}, "#$wline\n"; + } + } +} + +# Reformat the value to be written inside a configuration file. +# $_[0]: value name, +# $_[1]: value to validated. +sub serializeConfigValue($$) { + my $v = $_[1]; + if (isArray($v)) { + $v = ''; + foreach my $ev (@{$_[1]}) { + if ($v) { + $v .= ', '; + } + $v .= &serializeConfigValue($_[0], $ev); + } + } + elsif (isHash($v)) { + $v = ''; + while (my ($key, $value) = each(%{$_[1]})) { + if ($v) { + $v .= ', '; + } + $v .= "$key:{"; + $v .= &serializeConfigValue($_[0], $value); + $v .= "}"; + } + } + return $v; +} + +=pod + +=item B<writeConfigFile($\%;$)> + +Write the specified configuration into a file. + +I<Parameters:> + +=over 8 + +=item * the name of the file to write + +=item * the configuration data structure to write + +=item * (optional) indicates if the comments must be written + +=back + +I<Returns:> nothing + +=cut +sub writeConfigFile($\%;$) { + my $filename = shift; + die('second parameter of writeConfigFile() is not a hash') unless(isHash($_[0])); + + # Write the values + printDbg(formatText(_T("Writing configuration file {}"),$filename)); + printDbgIndent(); + my $cfgWriter = new Config::Simple(syntax=>'ini'); + my $has = 0; + while (my ($attr,$value) = each (%{$_[0]})) { + if ($value && $attr ne '__private__') { + $value = serializeConfigValue($attr, $value); + if ($value) { + $cfgWriter->param("$attr",$value); + $has = 1; + } + } + } + if ($has) { + $cfgWriter->write("$filename") or printErr($cfgWriter->error()); + + if ($_[1]) { + # Updating for comments + printDbg(_T("Adding configuration comments")); + local *CFGFILE; + open (*CFGFILE, "< $filename") or printErr("$filename:","$!"); + my @lines = (); + my $lastsection = undef; + while (my $l = <CFGFILE>) { + if ($l =~ /^\s*\[\s*(.+?)\s*\]\s*$/) { + $lastsection = lc($1); + if ($SECTION_COMMENTS{"$lastsection"}) { + push @lines, "\n"; + pushComment @lines, $SECTION_COMMENTS{"$lastsection"}; + } + else { + push @lines, "\n"; + pushComment @lines, _T("Configuration of the translator")." '$lastsection'"; + } + } + elsif (($l =~ /^\s*(.*?)\s*=/)&&($lastsection)) { + my $attr = lc($1); + if ($CONFIGURATION_COMMENTS{"$lastsection.$attr"}) { + push @lines, "\n"; + pushComment @lines, $CONFIGURATION_COMMENTS{"$lastsection.$attr"}; + } + } + push @lines, $l; + } + close(*CFGFILE); + + printDbg(_T("Saving configuration comments")); + local *CFGFILE; + open (*CFGFILE, "> $filename") or printErr("$filename:","$!"); + print CFGFILE (@lines); + close(*CFGFILE); + } + } + else { + # Create an empty file + open (*CFGFILE, "> $filename") or printErr("$filename:","$!"); + close(*CFGFILE); + } + printDbgUnindent(); + 1; +} + +=pod + +=item B<doConfigurationFileFixing($)> + +Fix the specified configuration file. + +I<Parameters:> + +=over 8 + +=item * the name of the file to fix + +=back + +I<Returns:> nothing + +=cut +sub doConfigurationFileFixing($) { + my $filename = shift; + my %configuration = (); + + readConfigFile("$filename",%configuration,1); + + writeConfigFile("$filename",%configuration); + + 1; +} + +# Try to detect an old fashioned configuration file +# and fix the value +sub ensureAccendentCompatibility($$$$) { + my $k = $_[0]; + my $v = $_[1]; + my $changed = 0; + $v = '' unless (defined($v)); + + if ($k eq 'generation.bibtex') { + $k = 'generation.biblio'; + $changed = 1; + } + + if (!isArray($v)) { + # Remove comments on the same line as values + if ($v =~ /^\s*(.*?)\s*\#.*$/) { + $v = "$1" ; + $changed = 1; + } + + if ($v eq '@detect@system') { + $v = ['detect','system']; + $changed = 1; + } + } + + if (($changed)&&(!$_[3])) { + printWarn(formatText(_T("AutoLaTeX has detecting an old fashion syntax for the configuration file {}\nPlease regenerate this file with the command line option --fixconfig."), $_[2])); + $_[3] = 1; + } + + return ($k,$v); +} + +# Reformat the value from a configuration file to apply several rules +# which could not be directly applied by the configuration readed. +# $_[0]: value name, +# $_[1]: value to validated. +sub rebuiltConfigValue($$) { + my $v = $_[1]; + if (($_[0])&&($v)) { + my $v_str = trim($v); + # If the string "empty value" is detected, delete the value + if ($v_str eq EMPTY_INI_VALUE) { + $v = ''; + } + # Split the include path of translators + elsif ($_[0] eq 'generation.translator include path') { + my $sep = getPathListSeparator(); + if (isHash($v)) { + while (my ($key,$val) = each(%{$v})) { + my @tab = split(/\s*$sep\s*/,"$val"); + if (@tab>1) { + $v->{"$key"} = @tab; + } + else { + $v->{"$key"} = pop @tab; + } + } + } + else { + my @paths = (); + if (isArray($v)) { + foreach my $p (@{$v}) { + push @paths, split(/\s*$sep\s*/,"$p"); + } + } + else { + push @paths, split(/\s*$sep\s*/,"$v"); + } + if (@paths>1) { + $v = \@paths; + } + else { + $v = pop @paths; + } + } + } + } + return $v; +} + +=pod + +=item B<setInclusionFlags(\%\%;\%\%)> + +Set the translator inclusion flags obtained from the configurations. + +This function assumed that the translator list is an hashtable of +(translator_name => { 'included' => { level => boolean } }) pairs. + +I<Parameters:> + +=over 8 + +=item * the translator list. + +=item * the system configuration. + +=item * the user configuration. + +=item * the project configuration. + +=back + +I<Returns:> nothing + +=cut +sub setInclusionFlags(\%\%;\%\%) { + die('first parameter of setInclusionFlags() is not a hash') + unless (isHash($_[0])); + die('second parameter of setInclusionFlags() is not a hash') + unless (isHash($_[1])); + foreach my $trans (keys %{$_[0]}) { + if (!$_[0]->{"$trans"}{'included'}) { + $_[0]->{"$trans"}{'included'} = {}; + } + + if ((exists $_[1]->{"$trans.include module"})&&(cfgIsBoolean($_[1]->{"$trans.include module"}))) { + $_[0]->{"$trans"}{'included'}{'system'} = cfgBoolean($_[1]->{"$trans.include module"}); + } + else { + # On system level, a module which was not specified as not includable must + # be included even if it will cause conflicts + $_[0]->{"$trans"}{'included'}{'system'} = undef; + } + + if (($_[2])&& + (exists $_[2]->{"$trans.include module"})&& + (cfgIsBoolean($_[2]->{"$trans.include module"}))) { + $_[0]->{"$trans"}{'included'}{'user'} = cfgBoolean($_[2]->{"$trans.include module"}); + } + else { + $_[0]->{"$trans"}{'included'}{'user'} = undef; + } + + if (($_[3])&& + (exists $_[3]->{"$trans.include module"})&& + (cfgIsBoolean($_[3]->{"$trans.include module"}))) { + $_[0]->{"$trans"}{'included'}{'project'} = cfgBoolean($_[3]->{"$trans.include module"}); + } + else { + $_[0]->{"$trans"}{'included'}{'project'} = undef; + } + } +} + +=pod + +=item B<reinitInclusionFlags(\%\%;\%\%)> + +Init the translator inclusion flags obtained from the configurations. + +This function assumed that the translator list is an hashtable of +(translator_name => { 'included' => { level => undef } }) pairs. + +I<Parameters:> + +=over 8 + +=item * the translator list. + +=item * the system configuration. + +=item * the user configuration. + +=item * the project configuration. + +=back + +I<Returns:> nothing + +=cut +sub reinitInclusionFlags(\%\%;\%\%) { + die('first parameter of setInclusionFlags() is not a hash') + unless (isHash($_[0])); + die('second parameter of setInclusionFlags() is not a hash') + unless (isHash($_[1])); + foreach my $trans (keys %{$_[0]}) { + if (!$_[0]->{"$trans"}{'included'}) { + $_[0]->{"$trans"}{'included'} = {}; + } + + $_[0]->{"$trans"}{'included'}{'system'} = undef; + + if ($_[2]) { + $_[0]->{"$trans"}{'included'}{'user'} = undef; + } + + if ($_[3]) { + $_[0]->{"$trans"}{'included'}{'project'} = undef; + } + } +} + +1; +__END__ +=back + +=head1 BUG REPORT AND FEEDBACK + +To report bugs, provide feedback, suggest new features, etc. (in prefered order): a) visit the developer site on GitHub <https://github.com/gallandarakhneorg/autolatex/>, b) visit the AutoLaTeX main page <http://www.arakhne.org/autolatex/>, or c) send email to the main author at galland@arakhne.org. + +=head1 LICENSE + +S<GNU Public License (GPL)> + +=head1 COPYRIGHT + +S<Copyright (c) 1998-2016 Stéphane Galland E<lt>galland@arakhne.orgE<gt>> + +=head1 SEE ALSO + +L<autolatex-dev> diff --git a/support/autolatex/pm/AutoLaTeX/Core/IntUtils.pm b/support/autolatex/pm/AutoLaTeX/Core/IntUtils.pm new file mode 100644 index 0000000000..7012f26a31 --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/Core/IntUtils.pm @@ -0,0 +1,201 @@ +# autolatex - IntUtils.pm +# Copyright (C) 2007-14 Stephane Galland <galland@arakhne.org> +# +# This program 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. +# +# This program 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 this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +Locale.pm - Internationalization Utilities + +=head1 DESCRIPTION + +Provides a set of utilities for internationalization. + +To use this library, type C<use AutoLaTeX::Core::IntUtils;>. + +=head1 FUNCTIONS + +The provided functions are: + +=over 4 + +=cut +package AutoLaTeX::Core::IntUtils; + +our @ISA = qw( Exporter ); +our @EXPORT = qw( &_T &initTextDomain &getCurrentLocale &getCurrentLanguage &getCurrentCodeset &getActiveTextDomains ); +our @EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use Exporter; + +use Carp; +use Locale::gettext; + +our $VERSION = '1.1'; + +my @ACTIVE_DOMAINS = (); + +=pod + +=item B<_T($)> + +Marker for the internationalization. +The parameter of this function is a string that +may be localized. +Replies the localized string that is corresponding +to the given parameter. + +CAUTION: tries to find a translation in all the initialized +text domain (see initTextDomain function). + +=cut +sub _T($) { + my $previous; + foreach my $domain (@ACTIVE_DOMAINS) { + #print "SEARCH FOR '".$_[0]."' in $domain\n"; + my $p = textdomain($domain); + $previous = $p unless $previous; + my $translation = gettext($_[0]); + #print ">$translation<\n"; + if ($translation && $translation ne $_[0]) { + return $translation; + } + } + if ($previous) { + textdomain($previous); + } + return $_[0]; +} + +=pod + +=item B<initTextDomain($$)> + +Initialize the internationalization domain. + +=over 4 + +=item domain: is the name of the text domain to use for internationalization. + +=item directory: is the directory where '.mo' (compiled '.po') could be found for the domain. + +=item codeset: is the code set used to encode the po files. + +=cut +sub initTextDomain($$;$) { + my $domain = shift || confess("initTextDomain must takes a domain as first parameter"); + my $directory = shift || confess("initTextDomain must takes a directory as second parameter"); + my $codeset = shift; + bindtextdomain($domain, $directory); + if ($codeset) { + bind_textdomain_codeset($domain, $codeset); + } + textdomain($domain); + push @ACTIVE_DOMAINS, $domain; +} + +=pod + +=item B<getActiveTextDomains()> + +Replies the active text domains. + +=cut +sub getActiveTextDomains() { + my @copy = @ACTIVE_DOMAINS; + return \@copy; +} + +=pod + +=item B<getCurrentLocale()> + +Replies the current locale. + +=cut +sub getCurrentLocale() { + my $lang = $ENV{'LC_ALL'} || $ENV{'LANG'}; + if ($lang =~ /^([a-zA-Z]+_[a-zA-Z]+)/) { + return "$1"; + } + elsif ($lang =~ /^([a-zA-Z]+)/) { + return "$1"; + } + return undef; +} + +=pod + +=item B<getCurrentCodeset()> + +Replies the current codeset. + +=cut +sub getCurrentCodeset() { + my $lang = $ENV{'LC_ALL'} || $ENV{'LANG'}; + if ($lang =~ /^[a-zA-Z]+_[a-zA-Z]+\.(.*)$/) { + return "$1"; + } + elsif ($lang =~ /^[a-zA-Z]+\.(.*)$/) { + return "$1"; + } + return undef; +} + +=pod + +=item B<getCurrentLangage()> + +Replies the current language. + +=cut +sub getCurrentLanguage() { + my $lang = $ENV{'LC_ALL'} || $ENV{'LANG'}; + if ($lang =~ /^([a-zA-Z]+)_[a-zA-Z]+/) { + return "$1"; + } + elsif ($lang =~ /^([a-zA-Z]+)/) { + return "$1"; + } + return undef; +} + + +1; +__END__ +=back + +=head1 BUG REPORT AND FEEDBACK + +To report bugs, provide feedback, suggest new features, etc. visit the AutoLaTeX Project management page at <http://www.arakhne.org/autolatex/> or send email to the author at L<galland@arakhne.org>. + +=head1 LICENSE + +S<GNU Public License (GPL)> + +=head1 COPYRIGHT + +S<Copyright (c) 2007-14 Stéphane Galland E<lt>galland@arakhne.orgE<gt>> + +=head1 SEE ALSO + +L<autolatex-dev> diff --git a/support/autolatex/pm/AutoLaTeX/Core/Main.pm b/support/autolatex/pm/AutoLaTeX/Core/Main.pm new file mode 100644 index 0000000000..f27e98e1ea --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/Core/Main.pm @@ -0,0 +1,542 @@ +# autolatex - Main.pm +# Copyright (C) 1998-16 Stephane Galland <galland@arakhne.org> +# +# This program 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. +# +# This program 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 this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +Main.pm - Main program + +=head1 FUNCTIONS + +The provided functions are: + +=over 4 + +=cut +package AutoLaTeX::Core::Main; + +$VERSION = '37.0'; +$COPYRIGHT_YEAR = '2016'; +@ISA = ('Exporter'); +@EXPORT = qw( &analyzeCommandLineOptions &mainProgram &detectMainTeXFile ) ; +@EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION $COPYRIGHT_YEAR); + +use Getopt::Long; +use File::Basename; +use AutoLaTeX::Core::Util; +use AutoLaTeX::Core::Config; +use AutoLaTeX::Core::OS; +use AutoLaTeX::Core::IntUtils; +use AutoLaTeX::TeX::DocumentDetector; + +#------------------------------------------------------ +# +# FUNCTION: analyze the command line options and update the configuration accordingly +# +#------------------------------------------------------ +sub analyzeCommandLineOptions(\%) { + printDbg(_T("Reading command line options")); + + my $realcfg = $_[0]; + $_[0]->{'__private__'}{'CLI.warning level'} = 1; + $_[0]->{'__private__'}{'config.command line'} = {}; + my $cfg = \%{$_[0]->{'__private__'}{'config.command line'}}; + my $debugLevel = getDebugLevel(); + + Getopt::Long::Configure ("bundling"); + if (!GetOptions( + + 'auto!' => sub { $cfg->{'generation.generate images'} = ($_[1] ? 'yes' : 'no'); }, + 'asyncview!' => sub { $cfg->{'viewer.asynchronous run'} = ($_[1] ? 'yes' : 'no'); }, + 'imgdirectory=s' => sub { $cfg->{'generation.image directory'} = $_[1]; }, + + 'continuous:i' => sub { + my $duration = int($_[1]); + $duration = 0 if ($duration<0); + $realcfg->{'__private__'}{'action.continuous mode'} = $duration; + $cfg->{'viewer.asynchronous run'} = 'true'; + }, + 'nocontinuous' => sub { + delete $realcfg->{'__private__'}{'action.continuous mode'}; + }, + + 'createconfig:s' => \$realcfg->{'__private__'}{'action.create config file'}, + + 'createist' => \$realcfg->{'__private__'}{'action.create ist file'}, + + 'debug' => \$realcfg->{'__private__'}{'action.create ist file'}, + + 'defaultist' => sub { + $cfg->{'generation.makeindex style'} = '@system'; + }, + + 'directory=s' => sub { + if (!$realcfg->{'__private__'}{'action.input directories'}) { + $realcfg->{'__private__'}{'action.input directories'} = []; + } + push @{$realcfg->{'__private__'}{'action.input directories'}}, $_[1]; + }, + + 'dvi' => sub { + $cfg->{'generation.generation type'} = 'dvi'; + }, + + 'biblio!' => sub { + $cfg->{'generation.biblio'} = ($_[1] ? 'yes' : 'no'); + $realcfg->{'__private__'}{'CLI.biblio'} = ($_[1] ? 'yes' : 'no'); # For makeflat action + }, + + 'exclude=s' => sub { + foreach my $module (split /\s*,\s*/,$_[1]) { + $module =~ s/[^a-zA-Z0-9_+-]+//g; + $cfg->{lc("$module").".include module"} = 'no'; + } + }, + + 'f=s' => \$realcfg->{'__private__'}{'input.latex file'}, + 'file=s' => \$realcfg->{'__private__'}{'input.latex file'}, + + 'file-line-warning' => \$realcfg->{'__private__'}{'CLI.is extended tex warnings'}, + + 'fixconfig:s' => sub { + $realcfg->{'__private__'}{'action.fix config file'} = $_[1]; + $realcfg->{'__private__'}{'action.fix config file'} = File::Spec->rel2abs($realcfg->{'__private__'}{'action.fix config file'}) if ($realcfg->{'__private__'}{'action.fix config file'}); + }, + + 'gloss!' => sub { $cfg->{'generation.makeglossaries'} = ($_[1] ? 'yes' : 'no'); }, + + 'help|?' => sub { showManual(getAutoLaTeXDocDir(),"autolatex.pod"); }, + + 'I=s@' => sub { + if (!$cfg->{'generation.translator include path'}) { + $cfg->{'generation.translator include path'} = []; + } + push @{$cfg->{'generation.translator include path'}}, $_[1]; + }, + + 'include=s' => sub { + my $sep = getPathListSeparator(); + foreach my $module (split /\s*$sep\s*/,$_[1]) { + $module =~ s/[^a-zA-Z0-9_+-]+//g; + $cfg->{lc("$module").".include module"} = 'yes'; + } + }, + + 'index:s' => sub { + if ($_[1]) { + $cfg->{'generation.makeindex style'} = $_[1]; + } + else { + $cfg->{'generation.makeindex style'} = ['@detect','@none']; + } + }, + + 'latex' => sub { + $cfg->{'generation.tex compiler'} = 'latex'; + }, + + + 'lualatex' => sub { + $cfg->{'generation.tex compiler'} = 'lualatex'; + }, + + 'noindex' => sub { + delete $cfg->{'generation.makeindex style'}; + }, + + 'noview' => sub { $cfg->{'viewer.view'} = 'no'; }, + + 'pdf' => sub { $cfg->{'generation.generation type'} = 'pdf'; }, + + 'pdflatex' => sub { + $cfg->{'generation.tex compiler'} = 'pdflatex'; + }, + + 'postcompilationruns=i' => sub { + my $number = int($_[1]); + $number = 1 if ($number<1); + $cfg->{'generation.post compilation runs'} = $number; + }, + + 'progress:s' => sub { + if ($_[1] eq 'n') { + $realcfg->{'__private__'}{'action.show progress'} = 'n'; + } + else { + $realcfg->{'__private__'}{'action.show progress'} = 'r'; + } + }, + + 'ps' => sub { + $cfg->{'generation.generation type'} = 'ps'; + }, + + 'quiet' => sub { $debugLevel = 0; }, + + 'search-project-from=s' => sub { + $realcfg->{'__private__'}{'action.search project from'} = $_[1]; + }, + + 'set=s%' => sub { $cfg->{'generation.set'}{$_[1]} = $_[2]; }, + + 'stdout' => sub { redirectToSTDOUT(); }, + + 'stderr' => sub { redirectToSTDERR(); }, + + 'synctex!' => sub { $cfg->{'generation.synctex'} = ($_[1] ? 'yes' : 'no'); }, + + 'xelatex' => sub { + $cfg->{'generation.tex compiler'} = 'xelatex'; + }, + + 'v+' => \$debugLevel, + + 'version' => sub { if (getAutoLaTeXLaunchingName() ne getAutoLaTeXName()) { + print formatText(_T("{} {} ({}) - {} platform\n(c) 1998-{} Stephane GALLAND <galland\@arakhne.org> (under GPL)\n"), + getAutoLaTeXLaunchingName(), + getAutoLaTeXVersion(), + getAutoLaTeXName(), + getOperatingSystem(), + $COPYRIGHT_YEAR); + } + else { + print formatText(_T("{} {} - {} platform\n(c) 1998-{} Stephane GALLAND <galland\@arakhne.org> (under GPL)\n"), + getAutoLaTeXLaunchingName(), + getAutoLaTeXVersion(), + getOperatingSystem(), + $COPYRIGHT_YEAR); + } + exit(0); }, + + 'view:s' => sub { + $cfg->{'viewer.view'} = 'yes'; + if ($_[1]) { + $cfg->{'viewer.viewer'} = $_[1]; + } + }, + + 'W' => sub { + $realcfg->{'__private__'}{'CLI.warning level'}++; + }, + 'Wall' => sub { + $realcfg->{'__private__'}{'CLI.warning level'} = 2; + }, + 'Wnone' => sub { + $realcfg->{'__private__'}{'CLI.warning level'} = 0; + }, + + )) { + exit(255); + } + + setDebugLevel($debugLevel); +} + +#------------------------------------------------------ +# +# FUNCTION: Seach for a TeX main file in the current directory +# +# Requires $_[0]->{__private__}{output.directory} +# Set $_[0]->{__private__}{input.latex file} +# +#------------------------------------------------------ +sub detectMainTeXFile(\%) { + my $configuration = shift; + local *DIR; + opendir(*DIR,$configuration->{'__private__'}{'output.directory'}) or printErr($configuration->{'__private__'}{'output.directory'}.":","$!"); + my @texfiles = (); + while (my $subfile = readdir(*DIR)) { + if ((!isIgnorableDirectory($subfile)) && $subfile =~ /\.tex$/i && $subfile ne 'autolatex_autogenerated.tex') { + push @texfiles, "$subfile"; + } + } + closedir(*DIR); + if (@texfiles==1) { + my $basename = pop @texfiles; + $configuration->{'__private__'}{'input.latex file'} = + File::Spec->catfile( + $configuration->{'__private__'}{'output.directory'}, + $basename); + printDbg(formatText(_T("Selecting TeX file '{}'"), $basename)); + } + else { + printDbg(formatText(_T("Detecting several TeX files: {}"),join(' ',@texfiles))); + # Issue #9: try to detect the file with the \documentclass + my @documents = (); + foreach my $file (@texfiles) { + if (isLaTeXDocument($file)) { + push @documents, $file; + } + } + if (@documents==1) { + my $basename = pop @documents; + $configuration->{'__private__'}{'input.latex file'} = + File::Spec->catfile( + $configuration->{'__private__'}{'output.directory'}, + $basename); + printDbg(formatText(_T("Selecting TeX file '{}'"), $basename)); + } + } +} + +#------------------------------------------------------ +# +# FUNCTION: Main program +# +#------------------------------------------------------ +sub mainProgram(;$) { + my $exitOnError = shift; + $exitOnError = 1 if (!defined($exitOnError)); + # Get system and user configurations + my %configuration = readConfiguration(); + + # Put the internationalization values in the configuration + $configuration{'__private__'}{'internationalization'}{'locale'} = getCurrentLocale(); + $configuration{'__private__'}{'internationalization'}{'language'} = getCurrentLanguage(); + $configuration{'__private__'}{'internationalization'}{'codeset'} = getCurrentCodeset(); + $configuration{'__private__'}{'internationalization'}{'domains'} = getActiveTextDomains(); + + # Analyze and apply the command line + analyzeCommandLineOptions(%configuration); + + # -- Bug fix: avoid the "No TeX file found" error message to be + # displayed when a non-generation action was requested + # on the command line + if (($exitOnError)&& + (($configuration{'__private__'}{'action.fix config file'})|| + ($configuration{'__private__'}{'action.create config file'})|| + ($configuration{'__private__'}{'action.create ist file'}))) { + $exitOnError = 0; + } + + # Search for the root directory + if ($configuration{'__private__'}{'action.search project from'}) { + my $file = $configuration{'__private__'}{'action.search project from'}; + if (-e "$file" && ! -d "$file") { + $file = dirname($file); + } + $file = File::Spec->rel2abs($file); + my $autolatex_dir = undef; + my $parent = dirname($file); + while (!$autolatex_dir && $parent && $file && $parent ne $file) { + my $cfgFile = getProjectConfigFilename($file); + if (-e "$cfgFile") { + $autolatex_dir = $file; + } + $file = $parent; + $parent = dirname($file); + } + if ($autolatex_dir && -d "$autolatex_dir") { + chdir($autolatex_dir) or printErr("$autolatex_dir: $!"); + } + } + + # detect main TeX file + $configuration{'__private__'}{'output.directory'} = File::Spec->curdir(); + $configuration{'__private__'}{'output.latex basename'} = undef; + + if (!$configuration{'__private__'}{'input.latex file'}) { + detectMainTeXFile(%configuration); + } + + # read project's configuration + { + my $projectConfigFilename = getProjectConfigFilename($configuration{'__private__'}{'output.directory'}); + if ( -f "$projectConfigFilename") { + readConfigFile("$projectConfigFilename",%configuration); + + # Remove the main intput filename + if (exists $configuration{'generation.main file'}) { + if (!$configuration{'__private__'}{'input.latex file'}) { + $configuration{'__private__'}{'input.latex file'} = basename($configuration{'generation.main file'}); + printDbg(formatText(_T("Detecting TeX file from project's configuration: '{}'"),$configuration{'__private__'}{'input.latex file'})); + } + delete $configuration{'generation.main file'}; + } + $configuration{'__private__'}{'input.project directory'} = dirname("$projectConfigFilename"); + } + } + + if (!$configuration{'__private__'}{'input.latex file'}) { + $configuration{'__private__'}{'input.latex file'} = 'Main.tex'; + } + + # final project main file management + if ($configuration{'__private__'}{'input.latex file'}) { + # check its value + if (-f $configuration{'__private__'}{'input.latex file'}) { + $configuration{'__private__'}{'output.directory'} = dirname($configuration{'__private__'}{'input.latex file'}); + $configuration{'__private__'}{'output.latex basename'} = basename($configuration{'__private__'}{'input.latex file'}); + $configuration{'__private__'}{'output.latex basename'} =~ s/\.tex$//i; + } + elsif (-f $configuration{'__private__'}{'input.latex file'}.".tex") { + $configuration{'__private__'}{'input.latex file'} .= ".tex"; + $configuration{'__private__'}{'output.directory'} = dirname($configuration{'__private__'}{'input.latex file'}); + $configuration{'__private__'}{'output.latex basename'} = basename($configuration{'__private__'}{'input.latex file'}); + } + } + + if ($configuration{'__private__'}{'input.latex file'}) { + printDbg(formatText(_T("Using TeX file '{}'"),$configuration{'__private__'}{'input.latex file'})); + } + elsif ($exitOnError) { + printErr(formatText(_T("No LaTeX file found nor specified for the directory '{}'.\n You must specify one on the command line option -f, or set the the variable 'generation.main file' in your configuration file, rename one of your files 'Main.tex'."), $configuration{'__private__'}{'output.directory'})); + } + + # now apply the command line options into the configuration + { + printDbg(_T("Applying command line options")); + if ($configuration{'__private__'}{'config.command line'}) { + while (my ($k,$v) = each(%{$configuration{'__private__'}{'config.command line'}})) { + if (isArray($v)) { + if (!$configuration{"$k"}) { + $configuration{"$k"} = $v; + } + elsif (isHash($configuration{"$k"})) { + for(my $i=0; $i<$#{$v}; $i=$i+2) { + $configuration{"$k"}{$v->[$i]} = $v->[$i+1]; + } + } + elsif (isArray($configuration{"$k"})) { + push @{$configuration{"$k"}}, @{$v}; + } + else { + unshift @{$v}, $configuration{"$k"}; + $configuration{"$k"} = $v; + } + } + elsif (isHash($v)) { + if (!$configuration{"$k"}) { + $configuration{"$k"} = $v; + } + elsif (isArray($configuration{"$k"})) { + push @{$configuration{"$k"}}, @{$v}; + } + elsif (isHash($configuration{"$k"})) { + while (my ($key,$val) = each(%{$v})) { + $configuration{"$k"}{$key} = $val; + } + } + else { + $v->{$configuration{"$k"}} = undef; + $configuration{"$k"} = $v; + } + } + else { + $configuration{"$k"} = $v; + } + } + if ($configuration{'generation.set'}) { + while (my ($k,$v) = each(%{$configuration{'generation.set'}})) { + $configuration{$k} = $v; + } + delete $configuration{'generation.set'} + } + delete $configuration{'__private__'}{'config.command line'}; + } + } + + # check MakeIndex parameters + if ($configuration{'generation.makeindex style'}) { + if (!isArray($configuration{'generation.makeindex style'})) { + $configuration{'generation.makeindex style'} = [$configuration{'generation.makeindex style'}]; + } + foreach my $isttype (@{$configuration{'generation.makeindex style'}}) { + if ($isttype) { + if ($isttype eq '@detect') { + # Seach for a MakeIndex style file in the current directory + local *DIR; + opendir(*DIR,$configuration{'__private__'}{'output.directory'}) or printErr($configuration{'__private__'}{'output.directory'}.":","$!"); + my @istfiles = (); + while (my $subfile = readdir(*DIR)) { + if (!isIgnorableDirectory($subfile) && $subfile =~ /\.ist$/i) { + push @istfiles, File::Spec->catfile( + $configuration{'__private__'}{'output.directory'}, + "$subfile"); + } + } + closedir(*DIR); + if (@istfiles==1) { + $configuration{'__private__'}{'output.ist file'} = File::Spec->rel2abs(pop @istfiles); + printDbg(formatText(_T("Selecting project's style for MakeIndex: {}"), $configuration{'__private__'}{'output.ist file'})); + } + else { + delete $configuration{'__private__'}{'output.ist file'}; + printDbg(formatText(_T("Unable to selected a project's style for MakeIndex: no file or too many .ist files in directory {}"), $configuration{'__private__'}{'output.directory'})); + } + } + elsif ($isttype eq '@system') { + $configuration{'__private__'}{'output.ist file'} = getSystemISTFilename(); + printDbg(formatText(_T("Selecting the system default style for MakeIndex"))); + } + elsif ($isttype eq '@none') { + delete $configuration{'__private__'}{'output.ist file'}; + printDbg(formatText(_T("Unselecting any style for MakeIndex"))); + } + + if (($configuration{'__private__'}{'output.ist file'})&& + (-r $configuration{'__private__'}{'output.ist file'})) { + last; + } + else { + delete $configuration{'__private__'}{'output.ist file'}; + } + } + } + } + + # set the project's directory if never set before + if (!$configuration{'__private__'}{'input.project directory'} && + $configuration{'__private__'}{'input.latex file'}) { + $configuration{'__private__'}{'input.project directory'} = File::Spec->rel2abs(dirname($configuration{'__private__'}{'input.latex file'})); + } + + # Set the directory of the pictures to a default value if not defined in + # the configuration nor given on the CLI + if (! defined($configuration{'generation.image directory'})) { + $configuration{'generation.image directory'} = $configuration{'__private__'}{'input.project directory'}; + } + + return %configuration; +} + +1; +__END__ +=back + +=head1 BUG REPORT AND FEEDBACK + +To report bugs, provide feedback, suggest new features, etc. visit the AutoLaTeX Project management page at <http://www.arakhne.org/autolatex/> or send email to the author at L<galland@arakhne.org>. + +=head1 LICENSE + +S<GNU Public License (GPL)> + +=head1 COPYRIGHT + +S<Copyright (c) 1998-2016 Stéphane Galland E<lt>galland@arakhne.orgE<gt>> + +=head1 SEE ALSO + +L<autolatex-dev> diff --git a/support/autolatex/pm/AutoLaTeX/Core/OS.pm b/support/autolatex/pm/AutoLaTeX/Core/OS.pm new file mode 100644 index 0000000000..f33dcf69ff --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/Core/OS.pm @@ -0,0 +1,555 @@ +# autolatex - OS.pm +# Copyright (C) 1998-13 Stephane Galland <galland@arakhne.org> +# +# This program 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. +# +# This program 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 this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +OS.pm - Operating System + +=head1 DESCRIPTION + +Identify the current operating system. + +To use this library, type C<use AutoLaTeX::Core::OS;>. + +=head1 FUNCTIONS + +The provided functions are: + +=over 4 + +=cut +package AutoLaTeX::Core::OS; + +$VERSION = '5.0'; +@ISA = ('Exporter'); +@EXPORT = qw( &getPathListSeparator &getOperatingSystem &getSupportedOperatingSystems &which + &touch &readlink_osindep &parseCLI &parseCLIWithExceptions &lastFileChange ) ; +@EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use Config; # Perl configuration +use File::stat; +use File::Basename; +use File::Path qw(make_path); + +my %operatingsystem = + (MacOS => 'Mac', + MSWin32 => 'Win32', + os2 => 'OS2', + VMS => 'VMS', + epoc => 'Epoc', + NetWare => 'Win32', + symbian => 'Win32', + dos => 'OS2', + cygwin => 'Cygwin'); + +my $Is_VMS = ($^O eq 'VMS'); +my $Is_MacOS = ($^O eq 'MacOS'); +my $Is_DOSish = (($^O eq 'MSWin32') or + ($^O eq 'dos') or + ($^O eq 'os2')); + +# For Win32 systems, stores the extensions used for +# executable files +# For others, the empty string is used +# because 'perl' . '' eq 'perl' => easier +my @path_ext = (''); +if ($Is_DOSish) { + if ($ENV{PATHEXT} and $Is_DOSish) { # WinNT. PATHEXT might be set on Cygwin, but not used. + push @path_ext, split ';', $ENV{PATHEXT}; + } + else { + push @path_ext, qw(.com .exe .bat); # Win9X or other: doesn't have PATHEXT, so needs hardcoded. + } +} +elsif ($Is_VMS) { + push @path_ext, qw(.exe .com); +} + +=pod + +=item B<getPathListSeparator()> + +Replies the separator of paths inside a path list. + +I<Returns:> the separator. + +=cut +sub getPathListSeparator() { + return $Config{'path_sep'} || ':'; +} + +=pod + +=item B<getOperatingSystem()> + +Replies the name of the current operating system. + +I<Returns:> the name. + +=cut +sub getOperatingSystem() { + return $operatingsystem{$^O} || 'Unix'; +} + +=pod + +=item B<getSupportedOperatingSystems()> + +Replies all the names of the supported operating systems. + +I<Returns:> the list of operating system's names. + +=cut +sub getSupportedOperatingSystems() { + my %list = (); + foreach my $v (values %operatingsystem) { + $list{"$v"} = 1; + } + return keys %list; +} + +sub expandShellCharsOnUnix(@) { + my $t = shift; + if ($t) { + my @parts = File::Spec->splitdir("$t"); + foreach my $e (@parts) { + if ($e eq '~') { + $e = $ENV{'HOME'}; + } + elsif ($e =~ /^~([a-zA-Z_][a-zA-Z_0-9]*)$/) { + my @p = File::Spec->split($ENV{'HOME'}); + pop @p; + $e = File::Spec->catdir(@p); + } + } + $t = File::Spec->catfile(@parts); + $t =~ s/\$([a-zA-Z_][a-zA-Z_0-9]*)/$ENV{$1}/g; + $t =~ s/\$\{([a-zA-Z_][a-zA-Z_0-9]*)\}/$ENV{$1}/g; + $t =~ s/\$\(([a-zA-Z_][a-zA-Z_0-9]*)\)/$ENV{$1}/g; + } + return $t; +} + +sub expandShellCharsOnWindows(@) { + my $t = shift; + if ($t) { + $t =~ s/\%{1,2}([a-zA-Z_][a-zA-Z_0-9]*)/$ENV{$1}/g; + $t =~ s/\%{1,2}\{([a-zA-Z_][a-zA-Z_0-9]*)\}/$ENV{$1}/g; + $t =~ s/\%{1,2}\(([a-zA-Z_][a-zA-Z_0-9]*)\)/$ENV{$1}/g; + } + return $t; +} + +=pod + +=item B<expandShellChars($)> + +Expand the specified value with the Shell metacommands. + +I<Parameters:> + +=over 8 + +=item * the string to expand. + +=back + +I<Returns:> the result of the epxansion. + +=cut +sub expandShellChars($) { + my $operatingsystem = getOperatingSystem(); + if (("$operatingsystem" eq 'Unix')||(("$operatingsystem" eq 'Cygwin'))) { + return expandShellCharsOnUnix(@_); + } + else { + return expandShellCharsOnWindows(@_); + } +} + +=pod + +=item B<which(@)> + +Replies the paths to executable programs on systems under which the `which' program wasn't implemented in the shell. + +C<which()> searches the directories of the user's C<PATH> (as returned by +C<File::Spec-E<gt>path()>), looking for executable files having the name specified +as a parameter to C<which()>. Under Win32 systems, which do not have a notion of +directly executable files, but uses special extensions such as C<.exe> and +C<.bat> to identify them, C<which()> takes extra steps to assure that you +will find the correct file (so for example, you might be searching for C<perl>, +it'll try C<perl.exe>, C<perl.bat>, etc.) + +If it finds an executable with the name you specified, C<which()> will return +the absolute path leading to this executable (for example, C</usr/bin/perl> or +C<C:\Perl\Bin\perl.exe>). + +If it does I<not> find the executable, it returns C<undef>. + +If C<which()> is called in list context, it will return I<all> the +matches. + +=over 4 + +=item C<short_exe_name> is the name used in the shell to call the program (for example, C<perl>). + +=back + +=cut +sub which(@) { + my ($exec) = @_; + + return undef unless $exec; + + my $all = wantarray; + my @results = (); + + # check for aliases first + if ($Is_VMS) { + my $symbol = `SHOW SYMBOL $exec`; + chomp($symbol); + if (!$?) { + return $symbol unless $all; + push @results, $symbol; + } + } + if ($Is_MacOS) { + my @aliases = split /\,/, $ENV{Aliases}; + foreach my $alias (@aliases) { + # This has not been tested!! + # PPT which says MPW-Perl cannot resolve `Alias $alias`, + # let's just hope it's fixed + if (lc($alias) eq lc($exec)) { + chomp(my $file = `Alias $alias`); + last unless $file; # if it failed, just go on the normal way + return $file unless $all; + push @results, $file; + # we can stop this loop as if it finds more aliases matching, + # it'll just be the same result anyway + last; + } + } + } + + my @path = File::Spec->path(); + unshift @path, File::Spec->curdir if $Is_DOSish or $Is_VMS or $Is_MacOS; + + for my $base (map { File::Spec->catfile($_, $exec) } @path) { + for my $ext (@path_ext) { + my $file = $base.$ext; + # print STDERR "$file\n"; + + if ((-x $file or # executable, normal case + ($Is_MacOS || # MacOS doesn't mark as executable so we check -e + ($Is_DOSish and grep { $file =~ /$_$/i } @path_ext[1..$#path_ext]) + # DOSish systems don't pass -x on non-exe/bat/com files. + # so we check -e. However, we don't want to pass -e on files + # that aren't in PATHEXT, like README. + and -e _) + ) and !-d _) + { # and finally, we don't want dirs to pass (as they are -x) + + # print STDERR "-x: ", -x $file, " -e: ", -e _, " -d: ", -d _, "\n"; + + return $file unless $all; + push @results, $file; # Make list to return later + } + } + } + + if($all) { + return @results; + } + else { + return undef; + } +} + +=pod + +=item B<touch(@)> + +Change the time associated to the specified files. + +=cut +sub touch(@) { + #my ($atime, $mtime); + #$atime = $mtime = time; + foreach my $f (@_) { + make_path(dirname("$f")); + if (-e "$f") { + utime(undef, undef, "$f"); + } + else { + local *FILE; + open(*FILE, "> $f") or die("$f: $!\n"); + close(*FILE); + } + } +} + +=pod + +=item B<readlink_osindep(@)> + +Try to dereference symbolic links. + +=cut +sub _readlink($) { + my $f = shift; + while ( $f && -l "$f" ) { + $f = readlink("$f"); + } + return $f; +} +sub readlink_osindep(@) { + if (wantarray) { + my @result = (); + foreach my $s (@_) { + push @result, _readlink($s); + } + return @result; + } + else { + if ($_[0]) { + return _readlink($_[0]); + } + return undef; + } +} + +=pod + +=item B<parseCLI(@)> + +Parse the given strings as command lines and extract each component. +The components are separated by space characters. If you want a +space character inside a component, you muse enclose the component +with quotes. To have quotes in components, you must protect them +with the backslash character. +This function expand the environment variables. + +I<Note:> Every paramerter that is an associative array is assumed to be an +environment of variables that should be used prior to C<@ENV> to expand the +environment variables. The elements in the parameter are treated from the +first to the last. Each time an environment was found, it is replacing any +previous additional environment. + +I<Parameters:> + +=over 8 + +=item * c<c> are the strings to parse. + +=back + +I<Returns:> the array of components if one string is given as parameter; or the array of arrays of components, +each sub array corresponds to one of the given parameters. + +=cut +sub parseCLI(@) { + my %e = (); + my @r = (); + my $addenv = undef; + if (@_>1) { + foreach my $s (@_) { + if (_ishash($s)) { + $addenv = $s; + } + else { + my @rr = _parseCLI($s,\%e,$addenv); + push @r, \@rr; + } + } + if (@r==1) { + @r = @{$r[0]}; + } + } + elsif (@_>0 && !_ishash($_[0])) { + @r = _parseCLI($_[0],\%e,$addenv); + } + return @r; +} + +=pod + +=item B<parseCLI(@)> + +Parse the given strings as command lines and extract each component. +The components are separated by space characters. If you want a +space character inside a component, you muse enclose the component +with quotes. To have quotes in components, you must protect them +with the backslash character. +This function expand the environment variables. + +I<Note:> Every paramerter that is an associative array is assumed to be an +environment of variables that should be used prior to C<@ENV> to expand the +environment variables. The elements in the parameter are treated from the +first to the last. Each time an environment was found, it is replacing any +previous additional environment. + +I<Parameters:> + +=over 8 + +=item * c<exceptions> are the names of the environment variables to not expand. + +=item * c<c> are the strings to parse. + +=back + +I<Returns:> the array of components if one string is given as parameter; or the array of arrays of components, +each sub array corresponds to one of the given parameters. + +=cut +sub parseCLIWithExceptions(\@@) { + my $e = shift; + my %ex = (); + my $addenv = undef; + foreach my $e (@{$e}) { + $ex{$e} = undef; + } + my @r = (); + if (@_>1) { + foreach my $s (@_) { + if (_ishash($s)) { + $addenv = $s; + } + else { + my @rr = _parseCLI($s,\%ex,$addenv); + push @r, \@rr; + } + } + if (@r==1) { + @r = @{$r[0]}; + } + } + elsif (@_>0 && !_ishash($_[0])) { + @r = _parseCLI($_[0],\%ex,$addenv); + } + return @r; +} + +sub _parseCLI($$$) { + my $text = shift; + my $exceptions = shift; + my $addenv = shift; + my @r = (); + if ($text) { + $text =~ s/^\s+//gs; + $text =~ s/\s+$//gs; + if ($text) { + my $protect = ''; + my $value = ''; + while ($text && $text =~ /^(.*?)(["']|(?:\s+)|(?:\\.)|(?:\$[a-zA-Z0-9_]+)|(?:\$\{[a-zA-Z0-9_]+\}))(.*)$/s) { + (my $prefix, my $sep, $text) = ($1, $2, $3); + $value .= $prefix; + if ($sep =~ /^\\(.)$/) { + $value .= $1; + } + elsif ($sep =~ /^\$(?:([a-zA-Z0-9_]+))|(?:\{([a-zA-Z0-9_]+)\})$/) { + my $varname = $1 || $2; + if ($protect eq '\'' || exists $exceptions->{"$varname"}) { + $value .= $sep; + } + elsif ($addenv && exists $addenv->{$varname}) { + $value .= ($addenv->{$varname} || ''); + } + else { + $value .= ($ENV{$varname} || ''); + } + } + elsif ($sep eq '"' || $sep eq '\'') { + if (!$protect) { + $protect = $sep; + } + elsif ($protect eq $sep) { + $protect = ''; + } + else { + $value .= $sep; + } + } + elsif ($protect) { + $value .= $sep; + } + elsif ($value) { + push @r, $value; + $value = ''; + } + } + if ($text) { + $value .= $text; + } + if ($value) { + push @r, $value; + } + } + } + return @r; +} + +sub _ishash($) { + return 0 unless defined($_[0]) ; + my $r = ref( $_[0] ) ; + return ( $r eq "HASH" ) ; +} + +=pod + +=item B<lastFileChange($)> + +Replies the date of the last change for the specified file. +If the file does not exist, C<undef> is replied. + +=cut +sub lastFileChange($) { + my $file = shift; + return undef unless ($file); + my $stats = stat("$file"); + return undef unless ($stats); + return ($stats->mtime > $stats->ctime) ? $stats->mtime : $stats->ctime; +} + + +1; +__END__ +=back + +=head1 BUG REPORT AND FEEDBACK + +To report bugs, provide feedback, suggest new features, etc. visit the AutoLaTeX Project management page at <http://www.arakhne.org/autolatex/> or send email to the author at L<galland@arakhne.org>. + +=head1 LICENSE + +S<GNU Public License (GPL)> + +=head1 COPYRIGHT + +S<Copyright (c) 1998-13 Stéphane Galland E<lt>galland@arakhne.orgE<gt>> + +=head1 SEE ALSO + +L<autolatex-dev> diff --git a/support/autolatex/pm/AutoLaTeX/Core/Progress.pm b/support/autolatex/pm/AutoLaTeX/Core/Progress.pm new file mode 100644 index 0000000000..1e7b27ed9e --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/Core/Progress.pm @@ -0,0 +1,535 @@ +# autolatex - Progress.pm +# Copyright (C) 2013 Stephane Galland <galland@arakhne.org> +# +# This program 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. +# +# This program 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 this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +Progress.pm - Implementation of a progress indicator + +=head1 DESCRIPTION + +Provides a tool to show the progress of the tasks. + +To use this library, type C<use AutoLaTeX::Core::Progress;>. + +=head1 GETTING STARTED + +=head2 Initialization + +To create a progress tool, say something like this: + + use AutoLaTeX::Core::Progress; + + my $max = 100; + my $progress = AutoLaTeX::Core::Progress->new($max) ; + +...or something similar. + +=head1 METHOD DESCRIPTIONS + +This section contains only the methods in Progress.pm itself. + +=over + +=cut +package AutoLaTeX::Core::Progress; + +our @ISA = qw( Exporter ); +our @EXPORT = qw( ); +our @EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use Exporter; +use Carp; +use AutoLaTeX::Core::IntUtils; +use AutoLaTeX::Core::Util qw($INTERNAL_MESSAGE_PREFIX); + +our $VERSION = '4.0'; + +#------------------------------------------------------ +# +# Constructor +# +#------------------------------------------------------ + +sub new(;$) : method { + my $proto = shift; + my $class = ref($proto) || $proto; + my $parent = ref($proto) && $proto ; + my $max = $_[0]; + if (!defined($max) || $max<0) { + $max = 100; + } + my $self; + if ( $parent ) { + %{$self} = %{$parent} ; + } + else { + $self = { + 'child' => undef, + 'max' => $max, + 'value' => 0, + 'parent' => undef, + 'bar-width' => 30, + 'comment' => '', + 'comment-to-display' => '', + 'previous-message-size' => 0, + 'carriage-return' => 1, + }; + } + bless( $self, $class ); + + return $self; +} + +sub _newChild($$$) : method { + my $proto = shift; + my $class = ref($proto) || $proto; + my $parent = shift; + my $min = shift; + my $max = shift; + my $self = { + 'child' => undef, + 'value' => 0, + 'parent' => $parent, + 'min-in-parent' => $min, + 'max-in-parent' => $max, + 'max' => 0, + 'comment' => '', + }; + bless( $self, $class ); + return $self; +} + +=pod + +=item * setCarriageReturn($) + +Enable or disable the use of the carraige-return character +C<\r> at the end of the lines. If the carriage-return +character is not used, the new-line character C<\n> is +used. + +=over 4 + +=item B<use_carriage_return> + +=over + +=cut +sub setCarriageReturn($) : method { + my $self = shift; + $self->{'carriage-return'} = shift; +} + +=pod + +=item * getCarriageReturn() + +Replies if the carriage-return character is used at the end +of the output lines. + +=cut +sub getCarriageReturn() : method { + my $self = shift; + return $self->{'carriage-return'}; +} + +=pod + +=item * setBarWidth($) + +Set the number of characters for rendering the progress bar. + +=over 4 + +=item B<width> is the number of characters of the bar. + +=over + +=cut +sub setBarWidth($) : method { + my $self = shift; + my $width = shift; + if ($self->{'parent'}) { + $self->{'parent'}->setBarWidth($width); + } + else { + $self->{'bar-width'} = $width; + } +} + +=pod + +=item * getBarWidth() + +Replies the number of characters for rendering the progress bar. + +=cut +sub getBarWidth() : method { + my $self = shift; + if ($self->{'parent'}) { + return $self->{'parent'}->getBarWidth(); + } + else { + return $self->{'bar-width'}; + } +} + +=pod + +=item * setComment($) + +Set the comment associated to the progress process. + +=over 4 + +=item B<label> is the comment text. + +=over + +=cut +sub setComment($) : method { + my $self = shift; + my $label = shift || ''; + $self->{'comment'} = $label || ''; + my $c = ''; + my $p = $self; + while ($p->{'parent'}) { + if (!$c && $p->{'comment'}) { + $c = $p->{'comment'}; + } + $p = $p->{'parent'}; + } + if ($p && $p->{'comment-to-display'} ne $c) { + $p->{'comment-to-display'} = $c; + $p->_report(); + return 1; + } + return 0; +} + +=pod + +=item * getComment() + +Replies the comment in the progress bar. + +=cut +sub getComment() : method { + my $self = shift; + if ($self->{'parent'}) { + return $self->{'parent'}->getComment(); + } + else { + return $self->{'comment-to-display'}; + } +} + +=pod + +=item * setMax() + +Set the maximal value. It must be greater than the previous +value of max. This function does not output on the console. + +=cut +sub setMax($) : method { + my $self = shift; + my $max = shift; + if ($max>$self->{'max'}) { + $self->{'max'} = $max; + } +} + +=pod + +=item * getMax() + +Replies the maximal value. + +=cut +sub getMax() : method { + my $self = shift; + return $self->{'max'}; +} + +=pod + +=item * getValue() + +Replies the current value. + +=cut +sub getValue() : method { + my $self = shift; + return $self->{'value'}; +} + +=pod + +=item * setValue($) + +Change the progress value and display the progress message. + +=over 4 + +=item B<value> is the current value of the progress indicator. + +=back + +Returns a boolean value that indicates if something was setValueed. + +=cut +sub setValue($;$) : method { + my $self = shift; + my $value = shift; + my $comment = shift; + my $max = $self->getMax(); + my $currentValue = $self->getValue(); + my $reported = undef; + confess('undef $value') unless (defined($value)); + if ($value>$currentValue) { + $self->_set_value($value); + $currentValue = $self->getValue(); + # Close any child progress + if ($self->{'child'}) { + my $mip = $self->{'child'}{'max-in-parent'}; + if ($currentValue>=$mip) { + $reported = $self->_disconnectChildProgress(); + } + } + # Notify parent + if ($self->{'parent'}) { + my $range = $self->{'max-in-parent'} - $self->{'min-in-parent'}; + my $parent_value = ($value * $range) / $max; + $parent_value += $self->{'min-in-parent'}; + if (!defined($comment) && $self->{'comment'}) { + $comment = $self->{'comment'}; + } + my $reported2 = $self->{'parent'}->setValue($parent_value, $comment); + $reported = $reported || $reported2; + } + # Change the comment to be displayed + elsif (defined($comment) && $comment ne $self->{'comment-to-display'}) { + $self->{'comment-to-display'} = $comment; + $reported = undef; + } + # Force reporting + if (!$reported) { + $reported = $self->_report(); + } + } + return $reported ; +} + +sub _set_value($) : method { + my $self = shift; + my $value = shift; + if ($value>=$self->{'max'}) { + $self->{'value'} = $self->{'max'}; + } + else { + $self->{'value'} = $value; + } +} + +sub _report() : method { + my $self = shift; + my $value = $self->getValue(); + my $max = $self->getMax(); + if (!$self->{'parent'}) { + my $message = "[".$self->_formatPercent($value, $max)."] ".$self->_formatBar($value, $max); + if ($self->{'comment-to-display'}) { + $message .= ' '.$self->{'comment-to-display'}; + } + my $l = length($message); + my $tmp_l = $l; + while ($tmp_l<$self->{'previous-message-size'}) { + $message .= ' '; + $tmp_l++; + } + $self->{'previous-message-size'} = $l; + if (!$self->{'carriage-return'} || ($value>=$max)) { + print STDOUT "$message\n"; + } + else { + print STDOUT "$message\r"; + } + $INTERNAL_MESSAGE_PREFIX = "\n"; + return 1; + } + return undef; +} + +sub _formatPercent($$) : method { + my $self = shift; + my $value = shift; + my $max = shift; + my $percent = int(($value * 100) / $max); + while (length($percent)<3) { + $percent = " $percent"; + } + return "$percent\%"; +} + +sub _formatBar($$) : method { + my $self = shift; + my $value = shift; + my $max = shift; + my $bar_width = $self->getBarWidth(); + my $nchars = int(($value * $bar_width) / $max); + my $i = 0; + my $bar = ''; + while ($i<$nchars) { + $bar .= '#'; + $i++; + } + while ($i<$bar_width) { + $bar .= '.'; + $i++; + } + return $bar; +} + +sub _disconnectChildProgress() : method { + my $self = shift; + if ($self->{'child'}) { + my $max_in_parent = $self->{'child'}{'max-in-parent'}; + $self->{'child'} = undef; + return $self->setValue($max_in_parent); + } + return undef; +} + +=pod + +=item * subProgress($$) + +Create a subtask. + +=over 4 + +=item B<size> (optional) is the size of the subtask in this progress. If not given, the rest of the parent task is covered by the sub task. + +=back + +Replies the subtask progress object. + +=cut +sub subProgress(;$) : method { + my $self = shift; + my $size = shift; + + my $parent_max = $self->getMax(); + my $min_in_parent = $self->getValue(); + + if (!defined($size) || $size<0) { + $size = $parent_max - $min_in_parent; + } + + my $max_in_parent = $min_in_parent + $size; + if ($max_in_parent>$parent_max) { + $max_in_parent = $parent_max; + } + + $self->{'child'} = AutoLaTeX::Core::Progress->_newChild( + $self, + $min_in_parent, + $max_in_parent); + + return $self->{'child'}; +} + +=pod + +=item * increment(;$) + +Increment the current value by the given amount, or by 1 if the amount is not given or invalid. + +=cut +sub increment(;$) : method { + my $self = shift; + my $inc = shift; + if (!defined($inc) || $inc<=0) { + $inc = 1; + } + my $value = $self->getValue(); + $self->setValue($value+$inc); +} + +=pod + +=item * stop() + +Stop the progress. + +=cut +sub stop() : method { + my $self = shift; + my $max = $self->getMax(); + $self->setValue($max); +} + +=pod + +=item * debug() + +Output the state of this progress. + +=cut +sub debug(;$) : method { + my $self = shift; + my $level = shift || 0; + printf STDERR ("%s[\%3d] value: 0<=\%f<=\%f\n", $INTERNAL_MESSAGE_PREFIX, $level, $self->{'value'}, $self->{'max'}); + $INTERNAL_MESSAGE_PREFIX = ''; + if ($self->{'parent'}) { + my $parent_value = $self->{'parent'}->getValue(); + printf STDERR ("[\%3d] in-parent: \%f<=%f<=\%f\n", $level, $self->{'min-in-parent'}, $parent_value, $self->{'max-in-parent'}); + } + else { + printf STDERR ("[\%3d] comment: \%s\n", $level, $self->{'comment'}); + } + if ($self->{'child'}) { + $self->{'child'}->debug($level+1); + } +} + +1; +__END__ +=back + +=head1 BUG REPORT AND FEEDBACK + +To report bug, provide feedback, suggest new features, etc. visit the AutoLaTeX Project management page at <http://www.arakhne.org/autolatex/> or send email to the author at L<galland@arakhne.org>. + +=head1 LICENSE + +S<GNU Public License (GPL)> + +=head1 COPYRIGHT + +S<Copyright (c) 2013 Stéphane Galland E<lt>galland@arakhne.orgE<gt>> + +=head1 SEE ALSO + +L<autolatex-dev> diff --git a/support/autolatex/pm/AutoLaTeX/Core/Translator.pm b/support/autolatex/pm/AutoLaTeX/Core/Translator.pm new file mode 100644 index 0000000000..2216cc905f --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/Core/Translator.pm @@ -0,0 +1,1308 @@ +# autolatex - Translator.pm +# Copyright (C) 2014-2015 Stephane Galland <galland@arakhne.org> +# +# This program 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. +# +# This program 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 this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +Translator.pm - Translator Utilities + +=head1 DESCRIPTION + +Permits to get translators and to resolve conflicts on them. + +To use this library, type C<use AutoLaTeX::Core::Translator;>. + +=head1 FUNCTIONS + +The provided functions are: + +=over 4 + +=cut +package AutoLaTeX::Core::Translator; + +$VERSION = '21.0'; +@ISA = ('Exporter'); +@EXPORT = qw( &getTranslatorFilesFrom &getLoadableTranslatorList &getTranslatorList + &detectConflicts @ALL_LEVELS + &makeTranslatorHumanReadable &extractTranslatorNameComponents + &readTranslatorFile &runRootTranslator &runTranslator &loadTranslator + &loadTranslatorsFromConfiguration &loadTranslatableImageList ) ; +@EXPORT_OK = qw(); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION @ALL_LEVELS); +use Carp; +use File::Spec; +use File::Basename; +use File::Path qw(make_path remove_tree); +use File::Copy; + +use AutoLaTeX::Core::Util; +use AutoLaTeX::Core::Config; +use AutoLaTeX::Core::IntUtils; +use AutoLaTeX::Core::OS; + +# Sorted list of the levels +our @ALL_LEVELS = ('system', 'user', 'project'); + +# Data for the translators +my %ROOT_TRANSLATORS = (); + +=pod + +=item * extractTranslatorNameComponents($) + +Parse a complete translator name to extract the components. +The name must have the syntax: +=over 8 + +=item * C<"I<source>2I<target>"> + +=item * C<"I<source>2I<target>+I<target2>"> + +=item * C<"I<source>2I<target>_I<variante>"> + +=item * C<"I<source>2I<target>+I<target2>_I<variante>"> + +=back + +I<Parameters:> + +=over 8 + +=item * The name to parse (string). + +=back + +I<Returns:> a hashtable containing the components of the name. The keys are: + +=over 8 + +=item * C<name> is the name of the translator. + +=item * C<full-source> is the decoded of the source type. + +=item * C<source> is the source type given in the parameter of the function. + +=item * C<target> is the decoded target. + +=item * C<variante> is the decoded variante. + +=item * C<basename> is the basename of the translator. + +=back + +=cut +sub extractTranslatorNameComponents($) { + my $name = shift; + if ($name =~ /^([a-zA-Z+-]+)2([a-zA-Z0-9-]+)(?:\+([a-zA-Z0-9+-]+))?(?:_(.*))?$/) { + my $source = $1; + my $target = $2; + my $target2 = $3||''; + my $variante = $4||''; + my $osource = "$source"; + my $basename = "${source}2${target}${target2}"; + if ($target2) { + if ($target2 eq 'tex') { + $source = "ltx.$source"; + } + elsif ($target2 eq 'layers') { + $source = "layers.$source"; + } + elsif ($target2 eq 'layers+tex' || $target2 eq 'tex+layers') { + $source = "layers.ltx.$source"; + } + else { + $target .= "+$target2"; + } + } + return { 'name' => $name, 'full-source' => $source, 'source' => $osource, 'target' => $target, 'variante' => $variante, 'basename' => $basename }; + } + return undef; +} + +=pod + +=item * makeTranslatorHumanReadable($) + +Replies a human readable string that corresponds to the specified translator data. + +I<Parameters:> + +=over 8 + +=item * C<description> is the description of the translator (hasharray). The value of the parameter may be obtained with C<extractTranslatorNameComponents()>. + +=back + +I<Returns:> the description of the translator. + +=cut +sub makeTranslatorHumanReadable($) { + my $data = shift; + if ($data->{'variante'}) { + return formatText(_T("Translate {} to {} with {} alternative"), + $data->{'full-source'}, + $data->{'target'}, + $data->{'variante'}); + } + else { + return formatText(_T("Translate {} to {}"), + $data->{'full-source'}, + $data->{'target'}); + } +} + +=pod + +=item * getTranslatorFilesFrom($) + +Replies the descriptions of the translator files installed on the system. + +I<Parameters:> + +=over 8 + +=item * C<configuration> (hashtable) is the current configuration of AutoLaTeX. + +=item * C<directory> (string) is the path to the directory to explore. + +=item * C<fileSet> (hashtable) is the associative array in which the discovered translators will be put. + +=item * C<recursive> (boolean) indicates if the function must recurse in the directories. + +=item * C<warn> (boolean) indicates if the warning may be output or not. + +=item * C<onlyincluded> (boolean) indicates if only the included translated will be considered as discovered. + +=item * C<level> (string) is the level to consider (see C<@ALL_LEVELS>). + +=back + +I<Returns:> nothing. + +=cut +sub getTranslatorFilesFrom(\%$\%$$$;$) { + my $configuration = shift; + my $filename = shift; + my $fileSet = shift; + my $recursive = shift; + my $warn = shift; + my $onlyincluded = shift; + my $level = shift || 'unknown'; + my $ispdfmode = ($configuration->{'generation.generation type'} || 'pdf') eq 'pdf'; + local *DIR; + if (-d "$filename") { + my @dirs = ( "$filename" ); + while (@dirs) { + my $dirname = shift @dirs; + formatText(_T("Get translator list from {}"),$dirname); + if (opendir(*DIR,"$dirname")) { + while (my $file = readdir(*DIR)) { + if ( ! isIgnorableDirectory($file) ) { + my $fullname = File::Spec->catfile("$dirname","$file"); + if (-d "$fullname") { + push @dirs, "$fullname" if ($recursive); + } + elsif ($file =~ /^([a-zA-Z+-]+2[a-zA-Z0-9+-]+(?:_[a-zA-Z0-9_+-]+)?).transdef$/i) { + my $scriptname = "$1"; + if ($onlyincluded) { + $fileSet->{"$scriptname"} = extractTranslatorNameComponents($scriptname); + $fileSet->{"$scriptname"}{'human-readable'} = makeTranslatorHumanReadable($fileSet->{"$scriptname"}); + $fileSet->{"$scriptname"}{'file'} = "$fullname"; + $fileSet->{"$scriptname"}{'level'} = "$level"; + $fileSet->{"$scriptname"}{'ispdfmode'} = $ispdfmode; + } + else { + $fileSet->{"$scriptname"} = "$fullname"; + } + } + } + } + closedir(*DIR); + } + else { + printWarn("$dirname:","$!"); + } + } + } + elsif ($warn) { + printWarn("$filename:","$!"); + } + 1; +} + +=pod + +=item * resolveConflicts($) + +Resolve conflicts between translator inclusions. + +I<Parameter:> + +=over 8 + +=item * C<includedTranslators> (hashtable) is the loaded translators. The keys are the names of the translators, and the values are the filenames of the translators. + +=back + +I<Returns:> nothing. + +=cut +sub resolveConflicts(\%) { + my $includedTranslators = shift; + my %bysources = (); + # The targets with "*+tex" are translated into sources "ltx.*" + # The targets with "*+layers" are translated into sources "layers.*" + while (my ($trans,$transfile) = each (%{$includedTranslators})) { + my $components = extractTranslatorNameComponents($trans); + if ($components) { + if (!$bysources{$components->{'full-source'}}) { + $bysources{$components->{'full-source'}} = []; + } + push @{$bysources{$components->{'full-source'}}}, { + 'source' => $components->{'source'}, + 'target' => $components->{'target'}, + 'variante' => $components->{'variante'}, + 'filename' => "$transfile" }; + } + } + + while (my ($source,$trans) = each(%bysources)) { + if (@{$trans}>1) { + my $msg = ''; + my ($excludemsg,$excludename); + foreach my $t (@{$trans}) { + $msg .= ",\n" if ($msg); + $msg .= makeTranslatorHumanReadable($t); + if (!$excludename) { + $excludename = $t->{'source'}."2".$t->{'target'}; + $excludename .= "_".$t->{'variante'} if ($t->{'variante'}); + } + if (!$excludemsg) { + $excludemsg = "[$excludename]\ninclude module = no\n"; + } + } + printErr(formatText(_T("Several possibilities exist for generating a figure from a {} file:\n{}\n\nYou must specify which to include (resp. exclude) with --include (resp. --exclude).\n\nIt is recommended to update your {} file with the following configuration for each translator to exclude (example on the translator {}):\n\n{}\n"), + $source, + $msg, + getUserConfigFilename(), + $excludename, + $excludemsg)); + } + } + 1; +} + +=pod + +=item B<detectConflicts(\%)> + +Replies the list of the translators that are in conflict. + +I<Parameters:> + +=over 8 + +=item * List of translator pairs (translator name => hashtable) + +=back + +I<Returns:> a hashtable containing (level => hash of translator descriptions) pairs. + +=cut +sub detectConflicts(\%) { + die('first parameter of detectConflicts() is not a hash') + unless (isHash($_[0])); + my %bysources = (); + # Build the list of included translators + while (my ($name,$data) = each(%{$_[0]})) { + # By default a module is included + for(my $i=0; $i<@ALL_LEVELS; $i++) { + my $level = $ALL_LEVELS[$i]; + if ($data->{'included'}{$level}) { + $bysources{$level}{$data->{'full-source'}}{$data->{'name'}} = $data; + # Propagate the inclusion to the following levels + for(my $j=$i+1; $j<@ALL_LEVELS; $j++) { + my $flevel = $ALL_LEVELS[$j]; + $bysources{$flevel}{$data->{'full-source'}}{$data->{'name'}} = $data; + } + } + elsif (defined($data->{'included'}{$level})) { + # Propagate the non inclusion to the following levels + # This action cancels previous propagation of included translators + for(my $j=$i; $j<@ALL_LEVELS; $j++) { + my $flevel = $ALL_LEVELS[$j]; + if ($bysources{$flevel}{$data->{'full-source'}}) { + delete $bysources{$flevel}{$data->{'full-source'}}{$data->{'name'}}; + } + } + } + elsif ($i==0) { + # By default a module is included + # Propagate the inclusion to the following levels + $bysources{$level}{$data->{'full-source'}}{$data->{'name'}} = $data; + for(my $j=$i+1; $j<@ALL_LEVELS; $j++) { + my $flevel = $ALL_LEVELS[$j]; + $bysources{$flevel}{$data->{'full-source'}}{$data->{'name'}} = $data; + } + } + } + } + + # Remove the translators that are not under conflict + foreach my $level (@ALL_LEVELS) { + foreach my $source (keys %{$bysources{$level}}) { + my @keys = keys %{$bysources{$level}{$source}}; + if (@keys<=1) { + delete $bysources{$level}{$source}; + } + } + unless ($bysources{$level}) { + delete $bysources{$level}; + } + } + + return %bysources; +} + +=pod + +=item B<getLoadableTranslatorList(\%)> + +Replies the list of the translators that could be loaded. + +I<Parameters:> + +=over 8 + +=item * hashtable that contains the current configuration, and that will +be updating by this function. + +=back + +I<Returns:> a hashtable containing (translator name => translator file) pairs. + +=cut +sub getLoadableTranslatorList(\%) { + local *DIR; + + my %includes = (); + + # Load distribution modules + my $filename = File::Spec->catfile(getAutoLaTeXDir(),"translators"); + printDbg(formatText(_T("Get loadable translators from {}"),$filename)); + printDbgIndent(); + opendir(*DIR,"$filename") + or printErr("$filename:","$!"); + while (my $file = readdir(*DIR)) { + if ((!isIgnorableDirectory($file))&& + ($file =~ /^(.*)\.transdef$/i)) { + my $fullname = File::Spec->rel2abs(File::Spec->catfile("$filename","$file")); + my $scriptname = "$1"; + if ((!exists $_[0]->{"$scriptname.include module"})|| + (cfgBoolean($_[0]->{"$scriptname.include module"}))) { + $includes{"$scriptname"} = "$fullname"; + } + else { + printDbg(formatText(_T("Translator {} is ignored"),$scriptname)); + } + } + } + closedir(*DIR); + printDbgUnindent(); + + # Load user modules recursively from ~/.autolatex/translators + getTranslatorFilesFrom( + %{$_[0]}, + File::Spec->catfile(getUserConfigDirectory(),"translators"), + %includes, + 1, # recursion + 0, # no warning + 0, # only included translators + 'user' # configuration level + ); + + # Load user modules non-recursively the paths specified inside the configurations + if ($_[0]->{'generation.translator include path'}) { + my @paths = (); + if ((isArray($_[0]->{'generation.translator include path'}))|| + (isHash($_[0]->{'generation.translator include path'}))) { + @paths = @{$_[0]->{'generation.translator include path'}}; + } + else { + push @paths, $_[0]->{'generation.translator include path'}; + } + foreach my $path (@paths) { + getTranslatorFilesFrom( + %{$_[0]}, + "$path", + %includes, + 0, # no recursion + 1, # warning + 0, # only included translators + 'user' # configuration level + ); + } + } + + resolveConflicts(%includes); + + return %includes; +} + +=pod + +=item B<getTranslatorList(\%;$)> + +Replies the list of the translators and their status. + +I<Parameters:> + +=over 8 + +=item * hashtable that contains the configuration. + +=item * recurse on user inclusion directories + +=back + +I<Returns:> a hashtable containing (translator name => { 'file' => translator file, +'level' => installation level, 'ispdfmode' => boolean value indicating that +the pdf mode is one } ) pairs. + +=cut +sub getTranslatorList(\%;$) { + local *DIR; + die('first parameter of getTranslatorList() is not a hash') + unless(isHash($_[0])); + + my $recurse = $_[1]; + $recurse = 1 unless (defined($recurse)); + + my $ispdfmode = ($_[0]->{'generation.generation type'} || 'pdf') eq 'pdf'; + + my %translators = (); + + # Load distribution modules + my $filename = File::Spec->catfile(getAutoLaTeXDir(),"translators"); + printDbg(formatText(_T("Get translators from {}"),$filename)); + printDbgIndent(); + opendir(*DIR,"$filename") or printErr("$filename:","$!"); + while (my $file = readdir(*DIR)) { + if ((!isIgnorableDirectory($file))&& + ($file =~ /^(.*)\.transdef$/i)) { + my $fullname = File::Spec->rel2abs(File::Spec->catfile("$filename","$file")); + my $scriptname = "$1"; + $translators{"$scriptname"} = extractTranslatorNameComponents($scriptname); + $translators{"$scriptname"}{'human-readable'} = makeTranslatorHumanReadable($translators{"$scriptname"}); + $translators{"$scriptname"}{'file'} = "$fullname"; + $translators{"$scriptname"}{'level'} = 'system'; + $translators{"$scriptname"}{'ispdfmode'} = $ispdfmode; + } + } + closedir(*DIR); + printDbgUnindent(); + + if ($recurse) { + # Load user modules recursively from ~/.autolatex/translators + getTranslatorFilesFrom( + %{$_[0]}, + File::Spec->catfile(getUserConfigDirectory(),"translators"), + %translators, + 1, # recursion + 0, # no warning + 1, # all included and not-included translators + 'user' # configuration level + ); + + # Load user modules non-recursively the paths specified inside the configurations + if ($_[0]->{'generation.translator include path'}) { + my @paths = (); + if ((isArray($_[0]->{'generation.translator include path'}))|| + (isHash($_[0]->{'generation.translator include path'}))) { + @paths = @{$_[0]->{'generation.translator include path'}}; + } + else { + push @paths, $_[0]->{'generation.translator include path'}; + } + foreach my $path (@paths) { + getTranslatorFilesFrom( + %{$_[0]}, + "$path", + %translators, + 0, # no recursion + 1, # warning + 1, # all included and not-included translators + 'user' # configuration level + ); + } + } + } # if ($recurse) + + return %translators; +} + +=pod + +=item B<readTranslatorFile($$)> + +Replies the content of a translator definition file. + +I<Parameters:> + +=over 8 + +=item * C<file> is the name of the file to parse. + +=item * C<ispdfmode> indicates of AutoLaTeX is in pdf mode (true) or in eps mode (false). + +=back + +I<Returns:> a hashtable containing the entries of the definition. + +=cut +sub readTranslatorFile($$) { + my $file = shift || confess('you must pass a filename to readTranslatorFile($$)'); + my $ispdfmode = shift; + my %content = (); + local *FILE; + open(*FILE, "< $file") or printErr("$file: $!"); + my $curvar = ''; + my $eol = undef; + my $lineno = 0; + while (my $line = <FILE>) { + $lineno++; + if ($eol) { + if ($line =~ /^\Q$eol\E\s*$/) { + $eol = undef; + $curvar = undef; + } + elsif ($curvar) { + $content{"$curvar"}{'value'} .= $line; + } + } + elsif ($line !~ /^\s*[#;]/) { + if ($line =~ /^\s*([azA-Z0-9_]+)(?:\s+with\s+(.*?))?(?:\s+for\s+((?:pdf)|(?:eps)))?\s*=\<\<([a-zA-Z0-9_]+)\s*(.*?)\s*$/i) { + ($curvar, my $interpreter, my $mode, $eol, my $value) = ($1, $2, $3, $4, $5); + if (!$mode || + ($ispdfmode && lc($mode) eq 'pdf') || + (!$ispdfmode && lc($mode) eq 'eps')) { + $curvar = uc($curvar); + $content{"$curvar"} = { + 'lineno' => $lineno, + 'value' => $value, + 'interpreter' => ($interpreter ? lc($interpreter) : undef), + }; + } + else { + $curvar = ''; + } + } + elsif ($line =~ /^\s*([azA-Z0-9_]+)(?:\s+with\s+(.*?))?(?:\s+for\s+((?:pdf)|(?:eps)))?\s*=\s*(.*?)\s*$/i) { + my ($var, $interpreter, $mode, $value) = ($1, $2, $3, $4); + if (!$mode || + ($ispdfmode && lc($mode) eq 'pdf') || + (!$ispdfmode && lc($mode) eq 'eps')) { + $curvar = undef; + $eol = undef; + $content{uc("$var")} = { + 'lineno' => $lineno, + 'value' => $value, + 'interpreter' => ($interpreter ? lc($interpreter) : undef), + }; + } + } + elsif ($line !~ /^\s*$/) { + printErr(formatText(_T("Line outside a definition ({}:{})."),$lineno, $file)); + } + } + } + close(*FILE); + if ($eol) { + printErr(formatText(_T("The block for the variable '{}' is not closed. Keyword '{}' was not found ({}:{})."), + $curvar, $eol, $file, $lineno)); + } + + + # Translate the values into suitable Perl objects + if (exists $content{'INPUT_EXTENSIONS'}{'value'}) { + my @exts = split(/\s+/, ($content{'INPUT_EXTENSIONS'}{'value'} || '')); + $content{'INPUT_EXTENSIONS'}{'value'} = []; + foreach my $e (@exts) { + if ($e !~ /^\^s*$/) { + if ($e !~ /^[\.+]/) { + $e = ".$e"; + } + push @{$content{'INPUT_EXTENSIONS'}{'value'}}, $e; + } + } + } + + if (exists $content{'OUTPUT_EXTENSIONS'}{'value'}) { + my @exts = split(/\s+/, ($content{'OUTPUT_EXTENSIONS'}{'value'} || '')); + $content{'OUTPUT_EXTENSIONS'}{'value'} = []; + foreach my $e (@exts) { + if ($e !~ /^\^s*$/) { + if ($e !~ /^\./) { + $e = ".$e"; + } + push @{$content{'OUTPUT_EXTENSIONS'}{'value'}}, $e; + } + } + } + + if (exists $content{'TRANSLATOR_PERL_DEPENDENCIES'}{'value'}) { + my @exts = split(/\s+/, ($content{'TRANSLATOR_PERL_DEPENDENCIES'}{'value'} || '')); + $content{'TRANSLATOR_PERL_DEPENDENCIES'}{'value'} = []; + while (@exts) { + my $e = shift @exts; + if ($exts[0] && + ( ($exts[0] =~ /^\Q'\E.*?\Q'\E$/) || + ($exts[0] =~ /^\Qqw(\E.+?\Q)\E$/) || + ($exts[0] =~ /^\Qqw{\E.+?\Q}\E$/))) { + my $p = shift @exts; + $e .= " $p"; + } + push @{$content{'TRANSLATOR_PERL_DEPENDENCIES'}{'value'}}, $e; + } + } + + if (exists $content{'FILES_TO_CLEAN'}{'value'}) { + my @patterns = split(/\s+/, ($content{'FILES_TO_CLEAN'}{'value'} || '')); + $content{'FILES_TO_CLEAN'}{'value'} = []; + foreach my $p (@patterns) { + if ($p !~ /^\^s*$/) { + push @{$content{'FILES_TO_CLEAN'}{'value'}}, $p; + } + } + } + + return \%content; +} + +=pod + +=item B<runRootTranslator(\%$$\%$;$)> + +Run the translator on a file as a root translator. + +I<Parameters:> + +=over 8 + +=item * C<configuration> is AutoLaTeX configuration. + +=item * C<name> is name of the translator. + +=item * C<in> is the name of the input file. + +=item * C<translators> definition of all the translators. + +=item * C<force> indicates if the translation is always run (true) or only if the source file is more recent than the target file. + +=back + +I<Returns:> true if a file was created; otherwise false. + +=cut + +sub runRootTranslator(\%$$\%$) { + my $configuration = shift || confess("configuration is mandatory"); + my $transname = shift || confess("transname is mandatory"); + my $in = shift || confess("input is mandatory"); + my $translators = shift || confess("translators are mandatory"); + my $force = shift; + + my $out = undef; + my @transexts = sort { + my $la = length($a); + my $lb = length($b); + my $c = $lb <=> $la; + if ($c) { + ($c); + } + else { + ($a cmp $b); + } + } + @{$translators->{"$transname"}{'transdef'}{'INPUT_EXTENSIONS'}{'value'}}; + my $i = 0; + while (($i<@transexts) && (!$out)) { + if ($in =~ /^(.+)\Q$transexts[$i]\E$/i) { + $out = "$1"; + } + $i++; + } + $out = "$in" unless ($out); + $out .= $translators->{"$transname"}{'transdef'}{'OUTPUT_EXTENSIONS'}{'value'}[0] || ''; + + $ROOT_TRANSLATORS{'configuration'} = $configuration; + $ROOT_TRANSLATORS{'translators'} = $translators; + $ROOT_TRANSLATORS{'force'} = $force; + $ROOT_TRANSLATORS{'loglevel'} = 1; + $ROOT_TRANSLATORS{'fail-on-error'} = 1; + + return _runTranslator( + $configuration, + $translators, + $transname, + $in, + $out, + $force, + 1, + 1); +} + +=pod + +=item B<runTranslator($$$)> + +Run the translator on a file. + +I<Parameters:> + +=over 8 + +=item * C<name> is name of the translator. + +=item * C<in> is the name of the input file. + +=item * C<out> is the name of the output file. + +=item * C<failOnError> (optional) indicates if the translator must fail on error or not. + +=back + +I<Returns:> true if a file was created; otherwise false. + +=cut +sub runTranslator($$$;$) { + my $transname = shift || confess("name is mandatory"); + my $in = shift || confess("input is mandatory"); + my $out = shift || confess("output is mandatory"); + my $failOnError = shift; + if (!$ROOT_TRANSLATORS{'translators'}) { + printErr(_T("You cannot call runTranslator() outside the call stack of runRootTranslator().")); + } + if (!defined($failOnError)) { + $failOnError = $ROOT_TRANSLATORS{'fail-on-error'}; + } + printDbgIndent(); + my $savedFailure = $ROOT_TRANSLATORS{'fail-on-error'}; + $ROOT_TRANSLATORS{'fail-on-error'} = $failOnError; + $ROOT_TRANSLATORS{'loglevel'}++; + my $r = _runTranslator( + $ROOT_TRANSLATORS{'configuration'}, + $ROOT_TRANSLATORS{'translators'}, + $transname, + $in, + $out, + $ROOT_TRANSLATORS{'force'}, + $ROOT_TRANSLATORS{'loglevel'}, + $failOnError); + $ROOT_TRANSLATORS{'loglevel'}--; + $ROOT_TRANSLATORS{'fail-on-error'} = $savedFailure; + printDbgUnindent(); + return $r; +} + +# Private translator function +sub _runTranslator($$$$$$$$) { + my $configuration = shift || confess("configuration is mandatory"); + my $translators = shift || confess("translators are mandatory"); + my $transname = shift || confess("transname is mandatory"); + my $in = shift || confess("input is mandatory"); + my $out = shift || confess("output is mandatory"); + my $force = shift; + my $logLevel = shift; + my $failOnError = shift; + my $ispdfmode = (($configuration->{'generation.generation type'} || 'pdf') eq 'pdf'); + my $isepsmode = !$ispdfmode; + + $in = File::Spec->rel2abs("$in"); + $out = File::Spec->rel2abs("$out"); + + if (! -r "$in") { + my $errmsg = formatText(_T("{}: file not found or not readable."), $in); + if ($failOnError) { + printErr($errmsg); + } + else { + print STDERR formatErr($errmsg); + return 0; + } + } + + if (!exists $translators->{"$transname"} || + !exists $translators->{"$transname"}{'transdef'} || + !$translators->{"$transname"}{'transdef'}) { + # The requested translator was not enabled by the user. + # We try to enable it on the fly. + loadTranslator($transname, $translators); + } + + # Try to avoid the translation if the source file is no more recent than the target file. + if (!$force) { + my $inChange = lastFileChange("$in"); + my $outChange = lastFileChange("$out"); + if (!defined($outChange)) { + # No out file, try to detect other types of generated files + local *DIR; + my $dirname = dirname("$out"); + if (opendir(*DIR, "$dirname")) { + my $fn; + my $ext = $translators->{"$transname"}{'transdef'}{'OUTPUT_EXTENSIONS'}{'value'}[0] || ''; + my $bn = basename($out, $ext); + while (!defined($outChange) && ($fn = readdir(*DIR))) { + if (!isIgnorableDirectory($fn) + && $fn =~ /^(\Q${bn}_\E.*)\Q$ext\E$/s) { + my $ffn = File::Spec->catfile("$dirname", "$fn"); + my $t = lastFileChange("$ffn"); + if (defined($t) && (!defined($outChange) || $t<$outChange)) { + $outChange = $t; + } + } + } + closedir(*DIR); + } + } + + if (defined($outChange) && $inChange<$outChange) { + # No need to translate again + printDbgFor(2, formatText(_T("{} is up-to-date."), basename($out))); + return 1; + } else { + printDbgFor(3, formatText(_T("in={}; out={}."), $outChange, $inChange)); + } + } + + if ($logLevel) { + printDbgFor($logLevel, formatText(_T("{} -> {}"), basename($in), basename($out))); + } + + if ($translators->{"$transname"}{'transdef'}{'COMMAND_LINE'}{'value'}) { + ################################ + # Run an external command line # + ################################ + my $cli = ($translators->{"$transname"}{'transdef'}{'COMMAND_LINE'}{'value'} || ''); + # Create the environment of variables for the CLI + my %environment = (%{$translators->{"$transname"}{'environment_variables'}}); + while (my ($k,$v) = each(%{$configuration})) { + if (!isArray($v) && !isHash($v)) { + $environment{$k} = $v; + } + } + $environment{'in'} = $in; + $environment{'out'} = $out; + my $inext; + while ((!$inext)&& ((undef,my $e) = each @{$translators->{"$transname"}{'transdef'}{'INPUT_EXTENSIONS'}{'value'}})) { + if ($in =~ /\Q$e\E$/i) { + $inext = $e; + } + } + if (!$inext) { + $inext = $translators->{"$transname"}{'transdef'}{'INPUT_EXTENSIONS'}{'value'}[0]; + } + $environment{'inext'} = $inext; + my $ext = $translators->{"$transname"}{'transdef'}{'OUTPUT_EXTENSIONS'}{'value'}[0] || ''; + $environment{'outbasename'} = basename($out, $ext); + $environment{'outwoext'} = File::Spec->catfile(dirname($out), $environment{'outbasename'}); + # Create the CLI to run + my @cli = parseCLI(\%environment, "$cli"); + + if (getDebugLevel>=4) { + $cli = '$'; + foreach my $elt (@cli) { + $cli .= " ".addSlashes($elt); + } + printDbg("$cli"); + } + + runCommandOrFail(@cli); + } + elsif ($translators->{"$transname"}{'transdef'}{'TRANSLATOR_FUNCTION'}{'value'}) { + ######################### + # Run the embedded code # + ######################### + my $lineno = $translators->{"$transname"}{'transdef'}{'TRANSLATOR_FUNCTION'}{'lineno'} - 1; + my $interpreter = $translators->{"$transname"}{'transdef'}{'TRANSLATOR_FUNCTION'}{'interpreter'}; + + my @inexts = @{$translators->{"$transname"}{'transdef'}{'INPUT_EXTENSIONS'}{'value'}}; + my $inext; + while ((!$inext)&& ((undef,my $e) = each @inexts)) { + if ($in =~ /\Q$e\E$/i) { + $inext = $e; + } + } + if (!$inext) { + $inext = $inexts[0]; + } + my $outext = $translators->{"$transname"}{'transdef'}{'OUTPUT_EXTENSIONS'}{'value'}[0]; + my @outexts = @{$translators->{"$transname"}{'transdef'}{'OUTPUT_EXTENSIONS'}{'value'}}; + my $ext = $translators->{"$transname"}{'transdef'}{'OUTPUT_EXTENSIONS'}{'value'}[0] || ''; + my $outbasename = basename($out, $ext); + my $outwoext = File::Spec->catfile(dirname($out), $outbasename); + + if (!$interpreter || $interpreter eq 'perl') { + # + # PERL INTERPRETER + # + my $code; + { + my $perlDeps = $translators->{"$transname"}{'transdef'}{'TRANSLATOR_PERL_DEPENDENCIES'}{'value'} || []; + $code = "{\n"; + if ($perlDeps) { + foreach my $dep (@{$perlDeps}) { + $code .= "use ".$dep.";\n"; + $lineno++; + } + } + $code .= $translators->{"$transname"}{'transdef'}{'TRANSLATOR_FUNCTION'}{'value'}; + $code .= "}\n"; + } + + my $c = eval $code; + if (!defined($c) && $@) { + my $msg = "$@"; + $msg =~ s/(\(eval\s+[0-9]+\)\s*line\s+)([0-9]+)/$1.($2 + $lineno)."($2)"/egsi; + $msg = formatText(_T("Error in the TRANSLATOR_FUNCTION of '{}':\n{}"), $transname, $msg); + if ($failOnError) { + printErr($msg); + } + else { + #print STDERR formatErr($msg); + return 0; + } + } + # Return the last value of the translator's script + return $c; + } + else { + # + # OTHER INTERPRETER + # + my $wrapper; + eval "use AutoLaTeX::Interpreter::$interpreter; \$wrapper = AutoLaTeX::Interpreter::$interpreter->new();"; + if (!$wrapper) { + my $errmsg = formatText(_T("Cannot find an interpreter wrapper for {}: {}"), $interpreter, ($@||'')); + if ($failOnError) { + printErr($errmsg); + } + else { + print STDERR formatErr($errmsg); + return 0; + } + } + + $wrapper->define_global_variable('_in', $in); + $wrapper->define_global_variable('_out', $out); + $wrapper->define_global_variable('_inexts', \@inexts); + $wrapper->define_global_variable('_inext', $inext); + $wrapper->define_global_variable('_outext', $outext); + $wrapper->define_global_variable('_outexts', \@outexts); + $wrapper->define_global_variable('_ext', $ext); + $wrapper->define_global_variable('_outbasename', $outbasename); + $wrapper->define_global_variable('_outwoext', $outwoext); + + my $code = $translators->{"$transname"}{'transdef'}{'TRANSLATOR_FUNCTION'}{'value'} || ''; + $wrapper->run($code); + } + } + else { + my $errmsg = formatText(_T("Unable to find the method of translation for '{}'."), $transname); + if ($failOnError) { + printErr($errmsg); + } + else { + print STDERR formatErr($errmsg); + return 0; + } + } + + return 1; +} + + +=pod + +=item B<loadTranslator()> + +Load the all the data needed to run a translator. +This function read the translator definition (transdef) +file; it sets the 'environment_variables' entry; and +it make symbolic link from the translator basename to +the translator itself. + +I<Parameters:> + +=over 8 + +=item * C<name> is the name of the translator to load. + +=item * C<translators> is the associative array that contains all the informations +about all the translators. + +=back + +I<Returns:> true if a file was created; otherwise false. + +=cut +sub loadTranslator($\%) { + my $name = shift || confess('you must pass the name of the translator to load'); + my $translators = shift || confess('you must pass the descriptions of the translators'); + + printDbgFor(4, formatText(_T("Searching translator '{}'."), $name)); + + # Check if the translator name corresponds to an existing translator. + # If not, try to find a variante. + if (!exists $translators->{$name} || + !$translators->{$name} || + !$translators->{$name}{'file'}) { + my $loadedlinkname = undef; + my $linkname = undef; + while ((!$loadedlinkname) && (my ($k,$v) = each (%{$translators}))) { + if (isHash($v) && $v->{'basename'} && $v->{'basename'} eq $name + && $v->{'file'}) { + if (exists $v->{'transdef'}) { + $loadedlinkname = $k; + } + else { + $linkname = $k; + } + } + } + if (!$linkname && !$loadedlinkname) { + printErr(formatText(_T("The translator '{}' cannot be found."), $name)); + } + elsif ($loadedlinkname) { + $linkname = $loadedlinkname; + } + printDbgFor(4, formatText(_T("Linking '{}' to '{}'."), $name, $linkname)); + $translators->{"$name"} = $translators->{"$linkname"}; + $name = $linkname; + } + + # Load the translator if not already loaded + if (exists $translators->{$name}{'transdef'}) { + printDbgFor(4, formatText(_T("'{}' is already loaded."), $name)); + } + else { + printDbgFor(4, formatText(_T("Loading translator '{}'."), $name)); + # Read the translator definition + $translators->{$name}{'transdef'} = readTranslatorFile( + $translators->{$name}{'file'}, + $translators->{$name}{'ispdfmode'}); + # Add environment variables + while ( my ($k,$v) = each(%{$translators->{$name}{'transdef'}})) { + if ($v && $v->{'value'} && !isHash($v->{'value'}) && !isArray($v->{'value'})) { + $translators->{$name}{'environment_variables'}{"$k"} = $v->{'value'}; + } + } + } + +} + + +=pod + +=item B<loadTranslatorsFromConfiguration(%%)> + +Run the algorithm that permits to load the translator +according to a given configuration. +This function is provided to be invoked by the main +program of AutoLaTex, or any other program that is +needing to load the list of translators according +to a configuration. + +I<Parameters:> + +=over 8 + +=item * C<configuration> is the associative array that contains the configuration. + +=item * C<data> is the associative array that IS FILLED with the data of the loaded translators. + +=back + +I<Returns:> Nothing + +=cut +sub loadTranslatorsFromConfiguration(\%\%) { + my $configuration = shift or confess("First parameter is mandatory: the associative array of the configuration"); + my $data = shift or confess("Second parameter is mandatory: the associative array of loaded data"); + if (!$data->{'translators'}) { + %{$data->{'translators'}} = getTranslatorList(%{$configuration}); + } + if (!$data->{'loadableTranslators'}) { + %{$data->{'loadableTranslators'}} = getLoadableTranslatorList(%{$configuration}); + + foreach my $translator (keys %{$data->{'loadableTranslators'}}) { + # Load the translator + loadTranslator($translator, %{$data->{'translators'}}); + + # Extract image extensions + foreach my $input (@{$data->{'translators'}{$translator}{'transdef'}{'INPUT_EXTENSIONS'}{'value'}}) { + $data->{'imageDatabase'}{"$input"}{'translator'} = $translator; + } + } + } + return undef; +} + + +=pod + +=item B<loadTranslatableImageList(%%)> + +Run the algorithm that permits to load the list +of the images that should be processed by the translators. +This function is provided to be invoked by the main +program of AutoLaTex, or any other program that is +needing this list. + +I<Parameters:> + +=over 8 + +=item * C<configuration> is the associative array that contains the configuration. + +=item * C<data> is the associative array that IS FILLED with the data of the pictures. + +=item * C<skipManualAssignment> (optional) is a boolean flag that indicates if the manual +assignments with C<"*.files to convert"> from the configuration must be skipped. + +=back + +I<Returns:> Nothing + +=cut +sub loadTranslatableImageList(\%\%;$) { + my $configuration = shift or confess("First parameter is mandatory: the associative array of the configuration"); + my $data = shift or confess("Second parameter is mandatory: the associative array of loaded data"); + my $skipManualAssignment = shift; + if (!$data->{'imageDatabaseReady'} && exists $configuration->{'generation.image directory'}) { + $data->{'numberOfImages'} = 0; + my $separator = getPathListSeparator(); + # Prepare the configuration entries '*.files to convert' + if (!$skipManualAssignment) { + $configuration->{'__private__'}{'files to convert'} = {}; + while (my ($k,$v) = each(%{$configuration})) { + if ($k =~ /^(.+)\.files\s+to\s+convert$/) { + my $trans = $1; + my @t = split(/\s*\Q$separator\E\s*/, $v); + foreach my $t (@t) { + $t = File::Spec->rel2abs($t, $configuration->{'__private__'}{'input.project directory'}); + $configuration->{'__private__'}{'files to convert'}{$t} = $trans; + } + } + } + } + # Detect the image from the file system + local* DIR; + printDbg(formatText(_T("Detecting images inside '{}'"), $configuration->{'generation.image directory'})); + my $rawdirs = $configuration->{'generation.image directory'}; + $rawdirs =~ s/^\s+//s; + $rawdirs =~ s/\s+$//s; + if ($rawdirs) { + my $separators = getPathListSeparator() || ''; + my @dirs = split( /[$separators]/is, $rawdirs); + my @imageExtensions = keys %{$data->{'imageDatabase'}}; + @imageExtensions = sort { + my $la = length($a); + my $lb = length($b); + if ($la==$lb) { + ($a cmp $b); + } + else { + ($lb - $la); + } + } @imageExtensions; + while (@dirs) { + my $dir = shift @dirs; + $dir = File::Spec->rel2abs($dir, $configuration->{'__private__'}{'input.project directory'}); + if (opendir(*DIR, "$dir")) { + while (my $fn = readdir(*DIR)) { + if (!isIgnorableDirectory($fn)) { + my $ffn = File::Spec->catfile("$dir", "$fn"); + if (-d "$ffn") { + push @dirs, "$ffn"; + } + else { + my $selectedExtension = undef; + if (!$skipManualAssignment && + $configuration->{'__private__'}{'files to convert'}{$ffn}) { + my $trans = $configuration->{'__private__'}{'files to convert'}{$ffn}; + $selectedExtension = "$separator$separator$trans$separator$separator"; + $data->{'imageDatabase'}{"$selectedExtension"}{'translator'} = $trans; + loadTranslator($trans, %{$data->{'translators'}}); + } + if (!$selectedExtension) { + for(my $i=0; !$selectedExtension && $i<@imageExtensions; ++$i) { + if ($fn =~ /\Q$imageExtensions[$i]\E$/i) { + $selectedExtension = $imageExtensions[$i]; + } + } + } + if ($selectedExtension) { + if (!$data->{'imageDatabase'}{"$selectedExtension"}{'files'}) { + $data->{'imageDatabase'}{"$selectedExtension"}{'files'} = []; + } + push @{$data->{'imageDatabase'}{"$selectedExtension"}{'files'}}, "$ffn"; + $data->{'activatedImageExtensions'}{"$selectedExtension"} = 1; + $data->{'numberOfImages'}++; + } + } + } + } + closedir(*DIR); + } + } + } + if ($data->{'activatedImageExtensions'}) { + my @keys = keys %{$data->{'activatedImageExtensions'}}; + $data->{'activatedImageExtensions'} = \@keys; + } + $data->{'imageDatabaseReady'} = 1; + } + return undef; +} + +1; +__END__ +=back + +=head1 BUG REPORT AND FEEDBACK + +To report bugs, provide feedback, suggest new features, etc. visit the AutoLaTeX Project management page at <http://www.arakhne.org/autolatex/> or send email to the author at L<galland@arakhne.org>. + +=head1 LICENSE + +S<GNU Public License (GPL)> + +=head1 COPYRIGHT + +S<Copyright (c) 1998-14 Stéphane Galland E<lt>galland@arakhne.orgE<gt>> + +=head1 SEE ALSO + +L<autolatex-dev> diff --git a/support/autolatex/pm/AutoLaTeX/Core/Util.pm b/support/autolatex/pm/AutoLaTeX/Core/Util.pm new file mode 100644 index 0000000000..79b037da88 --- /dev/null +++ b/support/autolatex/pm/AutoLaTeX/Core/Util.pm @@ -0,0 +1,1467 @@ +# Copyright (C) 1998-15 Stephane Galland <galland@arakhne.org> +# +# This program 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. +# +# This program 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 this program; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +=pod + +=head1 NAME + +Util.pm - Utilities + +=head1 DESCRIPTION + +Provides a set of general purpose utilities. + +To use this library, type C<use AutoLaTeX::Core::Util;>. + +=head1 FUNCTIONS + +The provided functions are: + +=over 4 + +=cut +package AutoLaTeX::Core::Util; + +our $INTERNAL_MESSAGE_PREFIX = ''; + +our $VERSION = '38.3'; + +@ISA = ('Exporter'); +@EXPORT = qw( &isHash &isArray &removeFromArray &arrayContains &getAutoLaTeXDir + &getAutoLaTeXName &getAutoLaTeXDocDir &getAutoLaTeXLaunchingName &getAutoLaTeXVersion + &setAutoLaTeXInfo &showManual &printDbg &printErr &formatErr &printWarn &setDebugLevel + &getDebugLevel &printDbgFor &dumpDbgFor &arrayIndexOf &printDbgIndent + &printDbgUnindent &runCommandOrFail &runSystemCommand &runCommandOrFailFromInput + ¬ifySystemCommandListeners &exitDbg &addSlashes + &runCommandRedirectToInternalLogs &countLinesIn + &readFileLines &writeFileLines &runCommandOrFailRedirectTo + &runCommandSilently &removePathPrefix &trim &trim_ws &formatText + &makeMessage &makeMessageLong &secure_unlink &str2language + &killSubProcesses &toANSI &toUTF8 &redirectToSTDOUT &redirectToSTDERR + &isIgnorableDirectory ) ; +@EXPORT_OK = qw( $INTERNAL_MESSAGE_PREFIX ); + +require 5.014; +use strict; +use utf8; +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); + +use File::Spec; +use File::Path qw(remove_tree); +use POSIX ":sys_wait_h"; +use Carp; +use Data::Dumper; + +use AutoLaTeX::Core::IntUtils; + +my $autolatexUseSTDERR = 1; +my $autoLaTeXName = undef; +my $autoLaTeXDirectory = undef; +my $autoLaTeXLaunchingName = undef; +my $autoLaTeXVersion = "$VERSION or higher"; +my $debugLevel = 0; +my $dbgIndent = 0; +my %runningChildren = (); +my $lastListenerCheck = 0; + +# Array of launched subprocesses +my %launchedSubProcesses = (); + + +sub __print(@) { + if ($autolatexUseSTDERR) { + print STDOUT (@_); + } + else { + print STDERR (@_); + } +} + +=pod + +=item B<redirectToSTDOUT()> + +Redirect the verbosing text on the STDOUT in place of STDERR. + +I<Returns:> None. + +=cut +sub redirectToSTDOUT() { + $autolatexUseSTDERR = 0; +} + +=pod + +=item B<redirectToSTDERR()> + +Redirect the verbosing text on the STDERR in place of STDOUT. + +I<Returns:> None. + +=cut +sub redirectToSTDERR() { + $autolatexUseSTDERR = 1; +} + +=pod + +=item B<toANSI(@)> + +Convert the given elements from UTF-8 to ANSI. + +I<Returns:> the array that contains the convertion result. + +=cut +sub toANSI(@) { + my @result = (); + foreach my $e (@_) { + if (utf8::is_utf8($e)) { + my $ne = "$e"; + utf8::downgrade($ne); + push @result, $ne; + } + else { + push @result, $e; + } + } + if (wantarray) { + return @result; + } + return \@result; +} + +=pod + +=item B<toUTF8(@)> + +Convert the given elements from ANSI to UTF8. + +I<Returns:> the array that contains the convertion result. + +=cut +sub toUTF8(@) { + my @result = (); + foreach my $e (@_) { + if (utf8::is_utf8($e)) { + push @result, $e; + } + else { + my $ne = "$e"; + utf8::upgrade($ne); + push @result, $ne; + } + } + if (wantarray) { + return @result; + } + return \@result; +} + +=pod + +=item B<getAutoLaTeXDir()> + +Replies the location of the main AutoLaTeX script. +This value must be set with a call to setAutoLaTeXInfo(). + +I<Returns:> the AutoLaTeX main directory. + +=cut +sub getAutoLaTeXDir() { + return $autoLaTeXDirectory; +} + +=pod + +=item B<getAutoLaTeXDocDir()> + +Replies the location of the documentation of AutoLaTeX. + +I<Returns:> the AutoLaTeX documentation directory. + +=cut +sub getAutoLaTeXDocDir() { + return File::Spec->catfile(getAutoLaTeXDir(), "doc"); +} + +=pod + +=item B<getAutoLaTeXName()> + +Replies the base filename of the main AutoLaTeX script. +This value must be set with a call to setAutoLaTeXInfo(). + +I<Returns:> the AutoLaTeX main script filename. + +=cut +sub getAutoLaTeXName() { + return $autoLaTeXName; +} + +=pod + +=item B<getAutoLaTeXLaunchingName()> + +Replies the base filename of the command which permits +to launch AutoLaTeX. It could differ from the AutoLaTeX name +due to several links. +This value must be set with a call to setAutoLaTeXInfo(). + +I<Returns:> the AutoLaTeX command name. + +=cut +sub getAutoLaTeXLaunchingName() { + return $autoLaTeXLaunchingName; +} + +=pod + +=item B<getAutoLaTeXVersion()> + +Replies the current version of AutoLaTeX. +This number is extracted from the VERSION filename if +it exists. +This value must be set with a call to setAutoLaTeXInfo(). + +I<Returns:> the AutoLaTeX version number. + +=cut +sub getAutoLaTeXVersion() { + return $autoLaTeXVersion; +} + +=pod + +=item B<setAutoLaTeXInfo($$$)> + +Set the information about the main AutoLaTeX script. +This function should only be could by the AutoLaTeX main script. + +I<Parameters:> + +=over 8 + +=item * the name of the command typed on the command line. + +=item * the name of the main script. + +=item * the path where the main script is located. + +=back + +=cut +sub setAutoLaTeXInfo($$$) { + $autoLaTeXLaunchingName = "$_[0]"; + $autoLaTeXName = "$_[1]"; + $autoLaTeXDirectory = File::Spec->rel2abs("$_[2]"); + + # Detect the version number + my $versionFile = File::Spec->catfile($autoLaTeXDirectory,'VERSION'); + if (-f "$versionFile") { + if (-r "$versionFile") { + local *VERSIONFILE; + open(*VERSIONFILE, "< $versionFile") or die("$versionFile: $!\n"); + while (my $line = <VERSIONFILE>) { + if ($line =~ /^\s*autolatex\s+(.*?)\s*$/i) { + $autoLaTeXVersion = "$1"; + last; + } + } + close(*VERSIONFILE); + } + else { + __print(formatText(_T("No read access to the VERSION file of AutoLaTeX. AutoLaTeX should not be properly installed. Assuming version: {}\n"),$autoLaTeXVersion)); + } + } + else { + __print(formatText(_T("Unable to find the VERSION file of AutoLaTeX. AutoLaTeX should not be properly installed. Assuming version: {}\n"), $autoLaTeXVersion)); + } +} + +=pod + +=item B<showManual(@)> + +Display the manual page extracted from the specified POD file. + +I<Parameters:> + +=over 8 + +=item * the components of the path to the POD file to use. + +=back + +I<Returns:> NEVER RETURN. + +=cut +sub showManual(@) { + my $pod; + # Try to localize + my $filename = pop @_; + my $ext = ''; + if ($filename =~ /^(.*)(\.pod)$/i) { + $ext = "$2"; + $filename = "$1"; + } + + my $currentLocale = getCurrentLocale(); + my $currentLang = getCurrentLanguage(); + + { + my ($localePod,$localeLang); + local *DIR; + opendir(*DIR,File::Spec->catfile(@_)) + or die(_T("no manual page found\n").File::Spec->catfile(@_).": $!\n"); + while (my $file = readdir(*DIR)) { + if (!isIgnorableDirectory($file)) { + if ($file =~ /^\Q$filename\E[._\-]\Q$currentLocale$ext\E$/) { + $localePod = $file; + } + if ($file =~ /^\Q$filename\E[._\-]\Q$currentLang$ext\E$/) { + $localeLang = $file; + } + if ($file =~ /^\Q$filename$ext\E$/) { + $pod = $file; + } + } + } + closedir(*DIR); + if ($localePod) { + $pod = $localePod; + } + elsif ($localeLang) { + $pod = $localeLang; + } + } + + # Display the POD + if ($pod) { + my $pod = File::Spec->catfile(@_, $pod); + if ( -r "$pod" ) { + use Pod::Perldoc; + @ARGV = ( "$pod" ); + Pod::Perldoc->run(); + exit(0); + } + } + __print(_T("no manual page found\n")); + exit(255); +} + +=pod + +=item B<isHash($)> + +Replies if the given value is a reference to a hashtable. + +I<Parameters:> + +=over 8 + +=item * a variable of scalar type. + +=back + +I<Returns:> C<true> if the parameter is a reference to a hashtable, otherwhise C<false>. + +=cut +sub isHash($) { + return 0 unless defined($_[0]) ; + my $r = ref( $_[0] ) ; + return ( $r eq "HASH" ) ; +} + +=pod + +=item B<isArray($)> + +Replies if the given value is a reference to an array. + +I<Parameters:> + +=over 8 + +=item * a variable of scalar type. + +=back + +I<Returns:> C<true> if the parameter is a reference to an array, otherwhise C<false>. + +=cut +sub isArray($) { + return 0 unless defined($_[0]) ; + my $r = ref( $_[0] ) ; + return ( $r eq "ARRAY" ) ; +} + +=pod + +=item B<arrayContains(\@$)> + +Replies if an element exists in an array. +The equality test is based on the C<eq> operator. + +I<Parameters:> + +=over 8 + +=item * the array in which the search must be done. + +=item * the element to search for. + +=back + +I<Returns:> C<true> if the element is inside the array, otherwhise C<false> + +=cut +sub arrayContains(\@$) { + foreach my $e (@{$_[0]}) { + if ($_[1] eq $e) { + return 1; + } + } + return 0; +} + +=pod + +=item B<arrayIndexOf(\@$)> + +Replies the index of an element in the array. +The equality test is based on the C<eq> operator. + +I<Parameters:> + +=over 8 + +=item * the array in which the search must be done. + +=item * the element to search for. + +=back + +I<Returns:> the index or C<-1> if the element was not found. + +=cut +sub arrayIndexOf(\@$) { + for(my $i=0; $i<@{$_[0]}; $i++) { + if ($_[1] eq $_[0]->[$i]) { + return $i; + } + } + return -1; +} + +=pod + +=item B<removeFromArray(\@$)> + +Remove all the occurences of the specified element +from an array. +The equality test is based on the C<eq> operator. + +I<Parameters:> + +=over 8 + +=item * the array. + +=item * the element to remove. + +=back + +I<Returns:> the array in which all the elements was removed. + +=cut +sub removeFromArray(\@@) { + my @tab2 = @_; + my $t = shift @tab2; + my @tab = (); + foreach my $e (@{$t}) { + if (!arrayContains(@tab2,$e)) { + push @tab, "$e"; + } + } + @{$_[0]} = @tab; +} + +=pod + +=item B<makeMessageLong(\%@)> + +Cut the given string at the given column. + +I<The supported keys of the first parameter are:> + +=over 8 + +=item * limit: is the maximal number of characters per lines. + +=item * indent: is the number of white spaces to add at the beginning of each line. + +=item * prefix_nosplit: is the text to put at the beginning of a line, before any spliting. + +=item * prefix_split: is the text to put at the beginning of a line, after spliting. + +=item * postfix_split: is the text to put at the end of a line, when spliting. + +=item * indent_char: is the character to use as the indentation unit. + +=back + +I<Returns:> the given strings, restricted to the given limit for each line. + +=cut +sub makeMessageLong(\%@) { + my $params = shift; + my $limit = $params->{'limit'}; + my $indent = $params->{'indent'}; + my $prefix_nosplit = $params->{'prefix_nosplit'} || ''; + my $prefix_split = $params->{'prefix_split'} || ''; + my $postfix_split = $params->{'postfix_split'} || ''; + my $indent_char = $params->{'indent_char'} || ' '; + $limit -= $indent; + my $indentstr = ''; + while (length($indentstr)<$indent) { + $indentstr .= $indent_char; + } + my @text = (); + my @lines = split(/\n/, join(' ',@_)); + foreach my $line (@lines) { + my @words = split(/\s+/, $line); + my $splitted = undef; + my $currentLine = ''; + for(my $i=0; $i<@words; $i++) { + my $word = $words[$i]; + if (!$currentLine) { + $currentLine = $prefix_nosplit.$indentstr.$word; + } + elsif ((length($currentLine)+length($word)+1)>$limit) { + $currentLine .= $postfix_split; + push @text, $currentLine; + $currentLine = $prefix_split.$indentstr.$word; + } + else { + $currentLine .= ' '.$word; + } + } + if ($currentLine) { + push @text, $currentLine; + } + @words = undef; + } + @lines = undef; + return @text; +} + +=pod + +=item B<makeMessage($$@)> + +Cut the given string at the given column. + +I<Parameters:> + +=over 8 + +=item * limit: is the maximal number of characters per lines. + +=item * indent: is the number of white spaces to add at the beginning of each line. + +=item * rest of the parameters: are the strings to output. + +=back + +I<Returns:> the given strings, restricted to the given limit for each line. + +=cut +sub makeMessage($$@) { + my $limit = shift; + my $indent = shift; + my %params = ( 'limit' => $limit, + 'indent' => $indent, + 'prefix_nosplit' => '', + 'prefix_split' => '...', + 'postfix_split' => '...', + 'indent_char' => ' ', + ); + return makeMessageLong(%params, @_); +} + +=pod + +=item B<setDebugLevel($)> + +Set the debug level. This level is used by L<printDbg> +to know is a debug message could be displayed. + +=cut +sub setDebugLevel($) { + $debugLevel = "$_[0]"; +} + +=pod + +=item B<getDebugLevel()> + +Replies the debug level. This level is used by L<printDbg> +to know is a debug message could be displayed. + +=cut +sub getDebugLevel() { + return "$debugLevel"; +} + +=pod + +=item B<printDbg(@)> + +display a DEBUG message. The parameters will be displayed separated by a space character. + +=cut +sub printDbg(@) { + printDbgFor(1,@_); +} + +=pod + +=item B<printDbgIndent()> + +Indent future DEBUG messages. + +=cut +sub printDbgIndent() { + $dbgIndent += 4; + $dbgIndent = 50 if ($dbgIndent>50); +} + +=pod + +=item B<printDbgUnindent()> + +Unindent future DEBUG messages. + +=cut +sub printDbgUnindent() { + $dbgIndent -= 4; + $dbgIndent = 0 if ($dbgIndent<0); +} + +=pod + +=item B<printDbgFor($@)> + +display a DEBUG message. The parameters will be displayed separated by a space character. + +=cut +sub printDbgFor($@) { + my $requestedLevel = shift; + if ($debugLevel>=$requestedLevel) { + my @text = makeMessage(60,$dbgIndent,@_); + foreach my $p (@text) { + __print($INTERNAL_MESSAGE_PREFIX, _T("[AutoLaTeX]"), " $p", "\n"); + $INTERNAL_MESSAGE_PREFIX = ''; + } + } + 1; +} + +=pod + +=item B<dumpDbgFor($@)> + +display the internal value of the specified variables. + +=cut +sub dumpDbgFor($@) { + my $requestedLevel = shift; + if ($debugLevel>=$requestedLevel) { + use Data::Dumper; + my @text = makeMessage(60,$dbgIndent,Dumper(@_)); + foreach my $p (@text) { + __print($INTERNAL_MESSAGE_PREFIX, _T("[AutoLaTeX]"), " $p", "\n"); + $INTERNAL_MESSAGE_PREFIX = ''; + } + } + 1; +} + +=pod + +=item B<formatErr(@)> + +format an error message. The parameters will be displayed separated by a space character. + +=cut +sub formatErr(@) { + my $errorMessage = ''; + my @text = makeMessage(55,0,@_); + foreach my $p (@text) { + $errorMessage .= $INTERNAL_MESSAGE_PREFIX._T("[AutoLaTeX]").' '.formatText("Error: {}","$p")."\n"; + $INTERNAL_MESSAGE_PREFIX = ''; + } + return $errorMessage; +} + +=pod + +=item B<printErr(@)> + +display an error message and exit. The parameters will be displayed separated by a space character. + +=cut +sub printErr(@) { + __print(formatErr(@_)); + exit(255); + undef; +} + +=pod + +=item B<printWarn(@)> + +display a warning message. The parameters will be displayed separated by a space character. + +=cut +sub printWarn(@) { + my @text = makeMessage(50,0,@_); + foreach my $p (@text) { + __print($INTERNAL_MESSAGE_PREFIX, _T("[AutoLaTeX]"), ' ', formatText(_T("Warning: {}"),"$p"), "\n"); + $INTERNAL_MESSAGE_PREFIX = ''; + } + 1; +} + +=pod + +=item B<runCommandOrFailRedirectTo($@)> + +Run a system command, block and stop the program when the +command has failed. The standartd output of the command +is written (in binary mode when possible) into the file +with the name given as first parameter. + +=over 4 + +=item C<file> is the file in which the stdout must be written. + +=item is the command to run. + +=back + +I<Returns:> Always C<0>. + +=cut +sub runCommandOrFailRedirectTo($@) { + my $stdoutfile = shift; + printDbgFor(4, formatText(_T("Command line is:\n{}"), join(' ',@_))); + my $pid = fork(); + if ($pid == 0) { + # Child process + open(STDOUT, '>', "$stdoutfile") or printErr(formatText(_T("Can't redirect STDOUT: {}"), $!)); + open(STDERR, '>', "autolatex_exec_stderr.log") or printErr(formatText(_T("Can't redirect STDERR: {}"), $!)); + select STDERR; $| = 1; # make unbuffered + select STDOUT; $| = 1; # make unbuffered + my @t = toANSI(@_); + exec(@t); + } + elsif (defined($pid)) { + # Parent process + $launchedSubProcesses{$pid} = $pid; + my $kpid = waitpid($pid, 0); + delete $launchedSubProcesses{$pid}; + my $exitcode = $?; + my @stdout = (); + if ($kpid>0) { + local *LOGFILE; + if ($exitcode!=0) { + open(*LOGFILE, "< autolatex_exec_stderr.log") or printErr(formatText(_T("{}: {}"), "autolatex_exec_stderr.log", $!)); + while (my $line = <LOGFILE>) { + __print($INTERNAL_MESSAGE_PREFIX.$line); + $INTERNAL_MESSAGE_PREFIX = ''; + } + close(*LOGFILE); + } + } + unlink("autolatex_exec_stdout.log"); + unlink("autolatex_exec_stderr.log"); + } + else { + printErr(formatText(_T("Unable to fork for the system command: {}"),join(' ',@_))); + } + return 0; +} + +=pod + +=item B<runCommandRedirectToInternalLogs(@)> + +Run a system command, block. The standard and error +outputs of the command are written (in binary mode +when possible) into the internal log files. + +=over 4 + +=item is the command to run. + +=back + +I<Returns:> The exit code of the command. + +=cut +sub runCommandRedirectToInternalLogs(@) { + printDbgFor(4, formatText(_T("Command line is:\n{}"), join(' ',@_))); + my $pid = fork(); + unlink("autolatex_exec_stdout.log"); + unlink("autolatex_exec_stderr.log"); + if ($pid == 0) { + # Child process + open(STDOUT, '>', "autolatex_exec_stdout.log") or printErr(formatText(_T("Can't redirect STDOUT: {}"), $!)); + open(STDERR, '>', "autolatex_exec_stderr.log") or printErr(formatText(_T("Can't redirect STDERR: {}"), $!)); + select STDERR; $| = 1; # make unbuffered + select STDOUT; $| = 1; # make unbuffered + my @t = toANSI(@_); + exec(@t); + } + elsif (defined($pid)) { + # Parent process + $launchedSubProcesses{$pid} = $pid; + waitpid($pid, 0); + delete $launchedSubProcesses{$pid}; + my $exitcode = $?; + return $exitcode; + } + else { + printErr(formatText(_T("Unable to fork for the system command: {}"),join(' ',@_))); + return 255; + } +} + +=pod + +=item B<runCommandOrFail(@)> + +Run a system command, block and stop the program when the +command has failed. + +=over 4 + +=item is the command to run. + +=back + +I<Returns:> If this function is called in an array context, an array of all +the lines from the stdout is replied. +If this function is not called in an array context, the exit code 0 is always +replied. + +=cut +sub runCommandOrFail(@) { + printDbgFor(4, formatText(_T("Command line is:\n{}"), join(' ',@_))); + my $wantstdout = wantarray; + my $pid = fork(); + if ($pid == 0) { + # Child process + open(STDOUT, '>', "autolatex_exec_stdout.log") or printErr(formatText(_T("Can't redirect STDOUT: {}"), $!)); + open(STDERR, '>', "autolatex_exec_stderr.log") or printErr(formatText(_T("Can't redirect STDERR: {}"), $!)); + select STDERR; $| = 1; # make unbuffered + select STDOUT; $| = 1; # make unbuffered + my @t = toANSI(@_); + exec(@t); + } + elsif (defined($pid)) { + # Parent process + $launchedSubProcesses{$pid} = $pid; + my $kpid = waitpid($pid, 0); + delete $launchedSubProcesses{$pid}; + my $exitcode = $?; + my @stdout = (); + if ($kpid>0) { + local *LOGFILE; + if ($exitcode!=0) { + open(*LOGFILE, "< autolatex_exec_stdout.log") or printErr(formatText(_T("{}: {}"), "autolatex_exec_stdout.log", $!)); + while (my $line = <LOGFILE>) { + print STDOUT $INTERNAL_MESSAGE_PREFIX.$line; + $INTERNAL_MESSAGE_PREFIX = ''; + } + close(*LOGFILE); + open(*LOGFILE, "< autolatex_exec_stderr.log") or printErr(formatText(_T("{}: {}"), "autolatex_exec_stderr.log", $!)); + while (my $line = <LOGFILE>) { + __print($INTERNAL_MESSAGE_PREFIX.$line); + $INTERNAL_MESSAGE_PREFIX = ''; + } + close(*LOGFILE); + @_ = map { '\''.addSlashes($_).'\''; } @_; + confess("\$ ", join(' ', @_)); + } + elsif ($wantstdout) { + @stdout = readFileLines("autolatex_exec_stdout.log"); + } + } + unlink("autolatex_exec_stdout.log"); + unlink("autolatex_exec_stderr.log"); + if ($wantstdout) { + return @stdout; + } + } + else { + printErr(formatText(_T("Unable to fork for the system command: {}"),join(' ',@_))); + } + return 0; +} + +=pod + +=item B<runCommandOrFailFromInput(@)> + +Run a system command with the given text as the standard +input, block and stop the program when the +command has failed. + +=over 4 + +=item the text to send to the standard input of the command. + +=item is the command to run. + +=back + +I<Returns:> If this function is called in an array context, an array of all +the lines from the stdout is replied. +If this function is not called in an array context, the exit code 0 is always +replied. + +=cut +sub runCommandOrFailFromInput($@) { + my $input = shift || ''; + printDbgFor(4, formatText(_T("Command line is:\n{}"), join(' ',@_))); + local *INFILE; + open(*INFILE, '> autolatex_exec_stdin.data') or printErr(formatText(_T("Can't write {}: {}"), 'autolatex_exec_stdin.data', $!)); + print INFILE $input; + close(*INFILE); + my $wantstdout = wantarray; + my $pid = fork(); + if ($pid == 0) { + # Child process + open(STDIN, '<', "autolatex_exec_stdin.data") or printErr(formatText(_T("Can't redirect STDIN: {}"), $!)); + open(STDOUT, '>', "autolatex_exec_stdout.log") or printErr(formatText(_T("Can't redirect STDOUT: {}"), $!)); + open(STDERR, '>', "autolatex_exec_stderr.log") or printErr(formatText(_T("Can't redirect STDERR: {}"), $!)); + select STDERR; $| = 1; # make unbuffered + select STDOUT; $| = 1; # make unbuffered + my @t = toANSI(@_); + exec(@t); + } + elsif (defined($pid)) { + # Parent process + $launchedSubProcesses{$pid} = $pid; + my $kpid = waitpid($pid, 0); + delete $launchedSubProcesses{$pid}; + my $exitcode = $?; + my @stdout = (); + if ($kpid>0) { + local *LOGFILE; + if ($exitcode!=0) { + open(*LOGFILE, "< autolatex_exec_stdout.log") or printErr(formatText(_T("{}: {}"), "autolatex_exec_stdout.log", $!)); + while (my $line = <LOGFILE>) { + print STDOUT $INTERNAL_MESSAGE_PREFIX.$line; + $INTERNAL_MESSAGE_PREFIX = ''; + } + close(*LOGFILE); + open(*LOGFILE, "< autolatex_exec_stderr.log") or printErr(formatText(_T("{}: {}"), "autolatex_exec_stderr.log", $!)); + while (my $line = <LOGFILE>) { + __print($INTERNAL_MESSAGE_PREFIX.$line); + $INTERNAL_MESSAGE_PREFIX = ''; + } + close(*LOGFILE); + @_ = map { '\''.addSlashes($_).'\''; } @_; + confess("\$ ", join(' ', @_)); + } + elsif ($wantstdout) { + @stdout = readFileLines("autolatex_exec_stdout.log"); + } + } + unlink("autolatex_exec_stdout.log"); + unlink("autolatex_exec_stderr.log"); + unlink("autolatex_exec_stdin.data"); + if ($wantstdout) { + return @stdout; + } + } + else { + printErr(formatText(_T("Unable to fork for the system command: {}"),join(' ',@_))); + } + return 0; +} + +=pod + +=item B<runCommandSilently(@)> + +Run a system command, block and return the exit code. +The standard outputs are catched and trashed. + + + +Parameters are + +=over 4 + +=item [options] (optional hash ref), if the first parameter is an hash table, it is assumed to be +additional options to pass to this function. + +=over 4 + +=item C<wait> is a boolean flag that is indicating if the caller must wait for the termination of the sub-process. + +=back + +=item rest of the parameters are constituting the command to run. + +=back + +I<Returns:> If this function is called in an array context, an array of all +the lines from the stdout is replied. +If this function is not called in an array context, the exit code 0 is always +replied. + +=cut +sub runCommandSilently(@) { + my $opts = {}; + if ($_[0] && isHash($_[0])) { + $opts = shift; + } + printDbgFor(4, formatText(_T("Command line is:\n{}"), join(' ',@_))); + my $pid = fork(); + if ($pid == 0) { + # Child process + if ($opts->{'stdin'}) { + open(STDIN, '<', $opts->{'stdin'}) or printErr(formatText(_T("Can't redirect STDIN: {}"), $!)); + select STDIN; $| = 1; # make unbuffered + } + open(STDOUT, '>', File::Spec->devnull()) or printErr(formatText(_T("Can't redirect STDOUT: {}"), $!)); + open(STDERR, '>', File::Spec->devnull()) or printErr(formatText(_T("Can't redirect STDERR: {}"), $!)); + select STDERR; $| = 1; # make unbuffered + select STDOUT; $| = 1; # make unbuffered + my @t = toANSI(@_); + exec(@t); + } + elsif (defined($pid)) { + # Parent process + $launchedSubProcesses{$pid} = $pid; + if (!defined($opts->{'wait'}) || $opts->{'wait'}) { + waitpid($pid, 0); + delete $launchedSubProcesses{$pid}; + return $?; + } + else { + # Do not wait for the child. + return 0; + } + } + else { + printErr(formatText(_T("Unable to fork for the system command: {}"),join(' ',@_))); + return 1; + } +} + +=pod + +=item B<runSystemCommand($@)> + +Run a system command and notify a listener about the terminaison. +This subroutine does not block the caller. + +=over 4 + +=item is the listener which will be notified with a call to C<$self-E<gt>onSystemCommandTerminaison(\@$)> + +=back + +=cut +sub runSystemCommand($@) { + printDbgFor(4, formatText(_T("Command line is:\n{}"), join(' ',@_))); + my $listener = shift; + my $pid = fork(); + if ($pid == 0) { + # Child process + my @t = toANSI(@_); + exec(@t); + } + elsif (defined($pid)) { + # Parent process + $launchedSubProcesses{$pid} = $pid; + $runningChildren{"$pid"} = { 'listener' => $listener, + 'command' => \@_, + }; + return 0; + } + else { + printErr(formatText(_T("Unable to fork for the system command: {}"),join(' ',@_))); + return 1; + } +} + +=pod + +=item B<notifySystemCommandListeners()> + +Notifies the listeners on system commands. + +=cut +sub notifySystemCommandListeners() { + if (%runningChildren) { + my $currenttime = time; + if ($currenttime>=$lastListenerCheck+1) { + $lastListenerCheck = $currenttime; + while (my ($pid,$data) = each(%runningChildren)) { + my $kid = waitpid($pid, WNOHANG); + if ($kid>0) { + delete $runningChildren{"$pid"}; + if (($data->{'listener'})&&($data->{'listener'}->can('onSystemCommandTerminaison'))) { + $data->{'listener'}->onSystemCommandTerminaison($data->{'commmand'},$kid); + } + } + } + } + } +} + +=pod + +=item B<waitForSystemCommandTerminaison()> + +Wait for the termination of asynchronous commands. + +=cut +sub waitForSystemCommandTerminaison() { + if (%runningChildren) { + printDbg(_T("Waiting for system command sub-processes")); + printDbgIndent(); + while (my ($pid,$data) = each(%runningChildren)) { + if ($runningChildren{"$pid"}{'command'}) { + printDbg(@{$runningChildren{"$pid"}{'command'}}); + } + my $kid = waitpid($pid, 0); + delete $runningChildren{"$pid"}; + delete $launchedSubProcesses{$pid}; + } + printDbgUnindent(); + } + 1; +} + +=pod + +=item B<exitDbg(@)> + +Print the content of the parameters and exit. + +=cut +sub exitDbg(@) { + confess(Dumper(@_)); +} + + +=pod + +=item B<addSlashes($)> + +Protect the special characters \\, ' and " with backslashes. + +=cut +sub addSlashes($) { + my $text = shift; + my $term = "$text"; + $term =~ s/([\\\'\"])/\\$1/gi; + return $term; +} + +=pod + +=item B<str2language($)> + +Protect the characters with backslashes in the string to obtain a string that may be put in a source code. + +=cut +sub str2language($) { + my $text = shift; + my $term = "$text"; + $term =~ s/([\\\'\"\0-\31])/\\$1/gi; + return $term; +} + +=pod + +=item B<readFileLines($)> + +Read a file and replies the array of the lines (if called in array context), +or all the lines inside a single string (if called in scalar context). + +=cut +sub readFileLines($) { + local *FILE; + if (wantarray) { + my @lines = (); + open(*FILE, "<".$_[0]) or printErr("$_[0]: $!"); + while (my $line = <FILE>) { + push @lines, $line; + } + close(*FILE); + return @lines; + } + else { + my $lines = ''; + open(*FILE, "<".$_[0]) or printErr("$_[0]: $!"); + while (my $line = <FILE>) { + $lines .= $line; + } + close(*FILE); + return $lines; + } +} + +=pod + +=item B<writeFileLines($@)> + +Write the lines in the array inside the specified file. + +=over 4 + +=item I<file> is the name of the file to write. + +=item the rest of the parameters are the lines to write. + +=back + +=cut +sub writeFileLines($@) { + my $file = shift; + local *FILE; + open(*FILE, ">$file") or printErr("$file: $!"); + foreach my $l (@_) { + confess('undefined value') unless (defined($l)); + print FILE $l; + } + close(*FILE); +} + +=pod + +=item B<removePathPrefix($$)> + +Remove the given prefix from a path. + +=over 4 + +=item I<prefix> is the path to remove. + +=item I<path> is the path from which the prefix should be removed. + +=back + +=cut +sub removePathPrefix($$) { + my $prefix = shift; + my $path = shift; + my @dir1 = File::Spec->splitdir($prefix); + my @dir2 = File::Spec->splitdir($path); + while (@dir1 && @dir2 && $dir1[0] eq $dir2[0]) { + shift @dir1; + shift @dir2; + } + return File::Spec->catdir(@dir2); +} + +=pod + +=item B<trim($)> + +Remove the trailing spaces (including white spaces, tabulations, carriage-returns, new-lines...). + +=over 4 + +=item I<str> the string to parse. + +=back + +=cut +sub trim($) { + my $str = $_[0] || ''; + my $s = "$str"; + $s =~ s/^\s+//s; + $s =~ s/\s+$//s; + return $s; +} + +=pod + +=item B<trim_ws($)> + +Remove the trailing white spaces (and only the white spaces). + +=over 4 + +=item I<str> the string to parse. + +=back + +=cut +sub trim_ws($) { + my $str = $_[0] || ''; + my $s = "$str"; + $s =~ s/^ //s; + $s =~ s/ $//s; + return $s; +} + +=pod + +=item B<formatText($@)> + +Replies the string after substitutions. + +The substrings C<$0>, C<$1>, C<$2>... will be substituted by +the corresponding values passed in parameters after the message id. + +The substrings C<${0}>, C<${1}>, C<${2}>... will be substituted by +the corresponding values passed in parameters after the message id. + +The substrings C<#0>, C<#1>, C<#2>... will be substituted by +the corresponding values passed in parameters after the message id. + +The substrings C<#{0}>, C<#{1}>, C<#{2}>... will be substituted by +the corresponding values passed in parameters after the message id. + +The substrings C<{}> will be replaced by the value passed in parameters +that corresponds to the C<{}>, e.g. the first C<{}> will be replaced by the +first value, the second C<{}> by the second value... + +=over 4 + +=item the id of the string + +=item the list of substitution values. + +=back + +I<Returns:> the localized string. + +=cut +sub formatText($@) { + my $msg = shift; + if (@_) { + for(my $i=0; $i<@_; $i++) { + $msg =~ s/[\$\#]\Q{$i}\E/$_[$i]/g; + $msg =~ s/[\$\#]\Q$i\E/$_[$i]/g; + } + my $i=0; + $msg =~ s/\Q{}\E/my $v;if ($i<@_) {$v=$_[$i]||'';$i++;} else {$v="{}";}"$v";/eg; + } + return $msg; +} + +=pod + +=item B<secure_unlink(@)> + +Remove the specifiec files or the directories. +This function invokes remove_tree or unlink according +to the type of the file to remove. + +=cut +sub secure_unlink(@) { + foreach my $file (@_) { + if (-d "$file") { + remove_tree("$file"); + } + else { + unlink("$file"); + } + } +} + +=pod + +=item B<countLinesIn($)> + +Count the lines in the given text. + +=cut +sub countLinesIn($) { + my $c = 1; + if ($_[0]) { + while ($_[0] =~ /[\n\r]/sg) { + $c++; + } + } + return $c; +} + + +=pod + +=item B<killSubProcesses()> + +Kill all the subprocesses launched by one of the running functions above. + +=cut +sub killSubProcesses() { + my @pids = keys %launchedSubProcesses; + %launchedSubProcesses = (); + kill 9, @pids; +} + +=pod + +=item B<isIgnorableDirectory($)> + +Replies if the given directory name is for directories to ignore. + +=cut +sub isIgnorableDirectory($) { + my $file = shift || return 1; + return $file eq File::Spec->curdir() || $file eq File::Spec->updir() + || $file eq ".git" || $file eq ".svn" || $file eq ".cvs"; +} + + + +END { + waitForSystemCommandTerminaison(); +} + +1; +__END__ +=back + +=head1 BUG REPORT AND FEEDBACK + +To report bugs, provide feedback, suggest new features, etc. visit the AutoLaTeX Project management page at <http://www.arakhne.org/autolatex/> or send email to the author at L<galland@arakhne.org>. + +=head1 LICENSE + +S<GNU Public License (GPL)> + +=head1 COPYRIGHT + +S<Copyright (c) 1998-15 Stéphane Galland E<lt>galland@arakhne.orgE<gt>> + +=head1 SEE ALSO + +L<autolatex-dev> |