summaryrefslogtreecommitdiff
path: root/support/autolatex/pm/AutoLaTeX/Core/OS.pm
diff options
context:
space:
mode:
Diffstat (limited to 'support/autolatex/pm/AutoLaTeX/Core/OS.pm')
-rw-r--r--support/autolatex/pm/AutoLaTeX/Core/OS.pm555
1 files changed, 555 insertions, 0 deletions
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>