<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;"># autolatex - OS.pm
# Copyright (C) 1998-13  Stephane Galland &lt;galland@arakhne.org&gt;
#
# 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&lt;use AutoLaTeX::Core::OS;&gt;.

=head1 FUNCTIONS

The provided functions are:

=over 4

=cut
package AutoLaTeX::Core::OS;

$VERSION = '5.0';
@ISA = ('Exporter');
@EXPORT = qw( &amp;getPathListSeparator &amp;getOperatingSystem &amp;getSupportedOperatingSystems &amp;which
	      &amp;touch &amp;readlink_osindep &amp;parseCLI &amp;parseCLIWithExceptions &amp;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   =&gt; 'Mac',
              MSWin32 =&gt; 'Win32',
              os2     =&gt; 'OS2',
              VMS     =&gt; 'VMS',
              epoc    =&gt; 'Epoc',
              NetWare =&gt; 'Win32',
              symbian =&gt; 'Win32',
              dos     =&gt; 'OS2',
              cygwin  =&gt; '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' =&gt; 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&lt;getPathListSeparator()&gt;

Replies the separator of paths inside a path list.

I&lt;Returns:&gt; the separator.

=cut
sub getPathListSeparator() {
	return $Config{'path_sep'} || ':';
}

=pod

=item B&lt;getOperatingSystem()&gt;

Replies the name of the current operating system.

I&lt;Returns:&gt; the name.

=cut
sub getOperatingSystem() {
	return $operatingsystem{$^O} || 'Unix';
}

=pod

=item B&lt;getSupportedOperatingSystems()&gt;

Replies all the names of the supported operating systems.

I&lt;Returns:&gt; 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-&gt;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-&gt;split($ENV{'HOME'});
				pop @p;
				$e = File::Spec-&gt;catdir(@p);
			}
		}
		$t = File::Spec-&gt;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&lt;expandShellChars($)&gt;

Expand the specified value with the Shell metacommands.

I&lt;Parameters:&gt;

=over 8

=item * the string to expand.

=back

I&lt;Returns:&gt; 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&lt;which(@)&gt;

Replies the paths to executable programs on systems under which the `which' program wasn't implemented in the shell.

C&lt;which()&gt; searches the directories of the user's C&lt;PATH&gt; (as returned by
C&lt;File::Spec-E&lt;gt&gt;path()&gt;), looking for executable files having the name specified
as a parameter to C&lt;which()&gt;. Under Win32 systems, which do not have a notion of
directly executable files, but uses special extensions such as C&lt;.exe&gt; and
C&lt;.bat&gt; to identify them, C&lt;which()&gt; takes extra steps to assure that you
will find the correct file (so for example, you might be searching for C&lt;perl&gt;,
it'll try C&lt;perl.exe&gt;, C&lt;perl.bat&gt;, etc.)

If it finds an executable with the name you specified, C&lt;which()&gt; will return
the absolute path leading to this executable (for example, C&lt;/usr/bin/perl&gt; or
C&lt;C:\Perl\Bin\perl.exe&gt;).

If it does I&lt;not&gt; find the executable, it returns C&lt;undef&gt;.

If C&lt;which()&gt; is called in list context, it will return I&lt;all&gt; the
matches.

=over 4

=item C&lt;short_exe_name&gt; is the name used in the shell to call the program (for example, C&lt;perl&gt;).

=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-&gt;path();
	unshift @path, File::Spec-&gt;curdir if $Is_DOSish or $Is_VMS or $Is_MacOS;

	for my $base (map { File::Spec-&gt;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&lt;touch(@)&gt;

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, "&gt; $f") or die("$f: $!\n");
			close(*FILE);
		}
	}
}

=pod

=item B&lt;readlink_osindep(@)&gt;

Try to dereference symbolic links.

=cut
sub _readlink($) {
	my $f = shift;
	while ( $f &amp;&amp; -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&lt;parseCLI(@)&gt;

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&lt;Note:&gt; Every paramerter that is an associative array is assumed to be an
environment of variables that should be used prior to C&lt;@ENV&gt; 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&lt;Parameters:&gt;

=over 8

=item * c&lt;c&gt; are the strings to parse.

=back

I&lt;Returns:&gt; 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 (@_&gt;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 (@_&gt;0 &amp;&amp; !_ishash($_[0])) {
		@r = _parseCLI($_[0],\%e,$addenv);
	}
	return @r;
}

=pod

=item B&lt;parseCLI(@)&gt;

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&lt;Note:&gt; Every paramerter that is an associative array is assumed to be an
environment of variables that should be used prior to C&lt;@ENV&gt; 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&lt;Parameters:&gt;

=over 8

=item * c&lt;exceptions&gt; are the names of the environment variables to not expand.

=item * c&lt;c&gt; are the strings to parse.

=back

I&lt;Returns:&gt; 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 (@_&gt;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 (@_&gt;0 &amp;&amp; !_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 &amp;&amp; $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-&gt;{"$varname"}) {
						$value .= $sep;
					}
					elsif ($addenv &amp;&amp; exists $addenv-&gt;{$varname}) {
						$value .= ($addenv-&gt;{$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&lt;lastFileChange($)&gt;

Replies the date of the last change for the specified file.
If the file does not exist, C&lt;undef&gt; is replied.

=cut
sub lastFileChange($) {
	my $file = shift;
	return undef unless ($file);
	my $stats = stat("$file");
	return undef unless ($stats);
	return ($stats-&gt;mtime &gt; $stats-&gt;ctime) ? $stats-&gt;mtime : $stats-&gt;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 &lt;http://www.arakhne.org/autolatex/&gt; or send email to the author at L&lt;galland@arakhne.org&gt;.

=head1 LICENSE

S&lt;GNU Public License (GPL)&gt;

=head1 COPYRIGHT

S&lt;Copyright (c) 1998-13 StÃ©phane Galland E&lt;lt&gt;galland@arakhne.orgE&lt;gt&gt;&gt;

=head1 SEE ALSO

L&lt;autolatex-dev&gt;
</pre></body></html>