# $Id: Modulecmd.pm,v 4.1 2004/05/07 15:42:15 ronisaac Exp $
# Copyright (c) 2001-2004, Morgan Stanley Dean Witter and Co.
# Distributed under the terms of the GNU General Public License.
# Please see the copyright notice at the end of this file for more information.
package Env::Modulecmd;
BEGIN {
# defaults: if Env::Modulecmd is built using perl5.005 or later, the
# magic strings below are replaced with values supplied to 'make' at
# build time
my $modulecmd = '@@DEFAULT_PERL_MODULECMD@@';
my $modulepath = '@@DEFAULT_MODULEPATH@@';
$ENV{PERL_MODULECMD} ||= $modulecmd unless ($modulecmd =~ /^\@\@/);
$ENV{MODULEPATH} ||= $modulepath unless ($modulepath =~ /^\@\@/);
}
use strict;
use Carp;
use vars qw($VERSION $AUTOLOAD);
use IPC::Open3;
use IO::Handle;
$VERSION = 1.2;
my $modulecmd = $ENV{'PERL_MODULECMD'} || 'modulecmd';
sub import {
my @args = @_;
shift @args;
# import just dispatches commands to _modulecmd
foreach my $arg (@args) {
if (ref ($arg) eq "HASH") {
my %hash = %{$arg};
foreach my $key (keys %hash) {
my $val = $hash{$key};
if (ref ($val) eq "ARRAY") {
_modulecmd ($key, $_) for @{$val};
} else {
_modulecmd ($key, $val);
}
}
} else {
_modulecmd ('load', $arg);
}
}
}
sub AUTOLOAD {
my @modules = @_;
# AUTOLOAD, like import, calls _modulecmd with the requested function
my $fun = $AUTOLOAD;
$fun =~ s/^.*:://;
_modulecmd ($fun, $_) for @modules;
}
sub _indent {
my ($str) = @_;
$str =~ s/\n$//;
$str =~ s/\n/\n -> /g;
$str = " -> $str\n";
return ($str);
}
sub _modulecmd {
my ($fun, $module) = @_;
# here's where the actual work gets done. first we build a command
# string and send it to open3 for execution. we're not sending any
# input, but we want to catch both its standard output and standard
# error, so a simple piped open won't work.
my @cmd = ($modulecmd, "perl", $fun, $module);
my $cmd = join (" ", @cmd);
my $pid = 0;
my $out = '';
my $err = '';
{
# need to turn off all warnings here, or else we get a double
# error from open3 if the exec fails
local $^W = 0;
my $IN = IO::Handle->new;
my $OUT = IO::Handle->new;
my $ERR = IO::Handle->new;
$pid = open3 ($IN, $OUT, $ERR, @cmd);
# slurp all output
undef local $/;
$out = <$OUT>;
$err = <$ERR>;
}
waitpid ($pid, 0);
my $retcode = $? >> 8;
# if the process sent anything to standard error, or if it exited
# with a non-zero return code, it may have "failed"
if ($err || $retcode) {
my $croak = 0;
# attempt to guess whether the stderr output is a real error
# generated by modulecmd, or just an informational message output
# by the module itself. error messages from modulecmd (like
# "Couldn't find modulefile ... in MODULEPATH") fall into two
# categories: they either (a) start with "ERROR:", or (b) start
# and end with a row of dashes, and contain the message shown
# below. (note that "occurred" is misspelled as "occured" in the
# modulecmd source.)
my $error_from_modulecmd =
(($err =~ /^ERROR:/) or
($err =~ /^-----/ and $err =~ /-----\s*$/ and
$err =~ /An error occur*ed while processing your module command/));
$croak = 1
if $error_from_modulecmd;
# now check for an exec failure. open3 obviously doesn't attempt
# to exec modulecmd until after it forks; if the exec fails, it
# croaks from the child process. we could check the STDERR output
# for "open3: exec of ... failed", except that on win32, the exec
# NEVER fails. (this is because exec's on win32 are done via
# system(), which uses cmd.exe, and the running cmd.exe always
# succeeds, leaving the child process to print an error message,
# with no indication whether the error came from cmd.exe or from
# modulecmd itself.)
#
# a non-zero return code is the best way to detect an exec
# failure, and modulecmd itself will hardly ever exit with a
# non-zero return code. however, there are two cases where it
# will: (a) invalid syntax, like "modulecmd no-such-shell list";
# and (b) "modulecmd perl load /no/such/directory". in these
# cases, we attempt to determine, using the pattern above, whether
# this is an error message from modulecmd. if not, we assume it's
# a message about a failure to exec modulecmd in the first place.
if ($retcode) {
$croak = 1;
unless ($error_from_modulecmd) {
# if we're on win32, we'll actually get a semi-useful error
# message from cmd.exe, such as "The system cannot find the
# path specified." on unix, it's just "open3: exec of ...
# failed at Modulecmd.pm line 123"; there's no detailed
# reason, and the line number in Modulecmd.pm doesn't help
# anybody. so if the error output begins with "open3:", we
# assume that it's useless and build our own message.
croak "Unable to execute '$cmd'" .
($err =~ /^open3:/ ? "\n" : ":\n" . _indent ($err)) .
"Error loading module $module";
}
}
# now, if $croak is set, it's a fatal error, so croak on it.
# otherwise, issue a warning, but only if -w is in effect.
if ($croak) {
croak
("Errors from '$cmd':\n" .
_indent ($err) .
"Error loading module $module");
} else {
carp
("Messages from '$cmd':\n" .
_indent ($err) .
"Possible error loading module $module")
if $^W;
}
}
# if we got here, then the command didn't fail. if it did generate
# output, then we have something to eval.
if ($out) {
# what if we try to eval something that's not valid perl? in this
# case, eval will die, with a message indicating what went wrong.
# we want to catch this and nicely print out the error.
eval $out;
croak
("'$cmd' generated output:\n" .
_indent ($out) .
"Error evaluating:\n" .
_indent ($@) .
"Error loading module $module")
if $@;
}
}
1;
__END__
=head1 NAME
Env::Modulecmd - Interface to modulecmd from Perl
=head1 SYNOPSIS
# import bootstraps, executed at compile-time
# explicit operations
use Env::Modulecmd { load => 'foo/1.0',
unload => ['bar/1.0', 'baz/1.0'],
};
# implied loading
use Env::Modulecmd qw(quux/1.0 quuux/1.0);
# hybrid
use Env::Modulecmd ('bazola/1.0', 'ztesch/1.0',
{ load => 'oogle/1.0',
unload => [qw(foogle/1.0 boogle/1.0)],
}
);
# implicit functions, executed at run-time
Env::Modulecmd::load (qw(fred/1.0 jim/1.0 sheila/barney/1.0));
Env::Modulecmd::unload ('corge/grault/1.0', 'flarp/1.0');
Env::Modulecmd::pippo ('pluto/paperino/1.0');
=head1 DESCRIPTION
C<Env::Modulecmd> provides an automated interface to C<modulecmd> from
Perl. The most straightforward use of Env::Modulecmd is for loading
and unloading modules at compile time, although many other uses are
provided.
=head2 modulecmd Interface
In general, C<Env::Modulecmd> works by making a system call to
'C<modulecmd perl [cmd] [module]>', under the assumption that
C<modulecmd> is in your PATH. If you set the environment variable
C<PERL_MODULECMD>, C<Env::Modulecmd> will use that value in place of
C<modulecmd>. If C<modulecmd> is not found, the shell will return an
error and the script will die.
I<Note: a default path to C<modulecmd>, and a default setting for
C<MODULEPATH>, can be built into C<Env::Modulecmd> when it's
installed. See the C<README> file in the source tree for more
information.>
Modules may, by convention, output warnings and informational
messages; C<modulecmd> directs these to standard error. If
C<modulecmd> outputs anything to standard error, C<Env::Modulecmd>
inspects that output and attempts to determine whether it represents a
fatal error. If the output begins with "ERROR:", or if it matches
C<modulecmd>'s typical error message format, C<Env::Modulecmd> fails.
Otherwise, C<Env::Modulecmd> emits that output as a warning, but only
if Perl warnings are enabled (C<-w>, or C<use warnings>).
If there were no fatal errors, C<modulecmd>'s output (if any) is
C<eval>'ed. If the C<eval> operation fails, C<Env::Modulecmd> will
fail.
If you attempt to load a module which has already been loaded, or
perform some other benign operation, C<modulecmd> will generate
neither output nor error; this condition is silently ignored.
=head2 Compile-Time Usage
You can specify compile-time arguments to C<Env::Modulecmd> on the
C<use> line, as follows:
use Env::Modulecmd ('bazola/1.0', 'ztesch/1.0',
{ load => 'oogle/1.0',
unload => [qw(foogle/1.0 boogle/1.0)],
}
);
Each argument is assumed to be either a scalar or a hashref. If it's a
scalar, C<Env::Modulecmd> assumes it's the name of a module you want
to load. If it's a hashref, then each key is the name of a modulecmd
operation (ie: C<load>, C<unload>) and each value is either a scalar
(operate on one module) or an arrayref (operate on several modules).
In the example given above, C<bazola/1.0> and C<ztesch/1.0> will be
loaded by implicit usage. C<oogle/1.0> will be loaded explicitly, and
C<foogle/1.0> and C<boogle/1.0> will be unloaded.
=head2 Run-Time Usage
Additional module operations can be performed at run-time by using
implicit functions. For example:
Env::Modulecmd::load (qw(fred/1.0 jim/1.0 sheila/barney/1.0));
Env::Modulecmd::unload ('corge/grault/1.0', 'flarp/1.0');
Env::Modulecmd::pippo ('pluto/paperino/1.0');
Each function name is passed as a command name to C<modulecmd>, and
each call can include one or more modules to be processed. The example
above will generate the following six calls to C<modulecmd>:
modulecmd perl load fred/1.0
modulecmd perl load jim/1.0
modulecmd perl load sheila/barney/1.0
modulecmd perl unload corge/grault/1.0
modulecmd perl unload flarp/1.0
modulecmd perl pippo pluto/paperino/1.0
=head1 SEE ALSO
For more information about modules, see the F<module(1)> manpage or
F<http://www.modules.org>.
=head1 BUGS
If you find any bugs, or if you have any suggestions for improvement,
please contact the author.
=head1 AUTHOR
Ron Isaacson <F<Ron.Isaacson@morganstanley.com>>
=head1 COPYRIGHT
Copyright (c) 2001-2004, Morgan Stanley Dean Witter and Co.
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.
A copy of the GNU General Public License was distributed with this
program in a file called LICENSE. For additional copies, write to the
Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
02111-1307, USA.
=cut