Env::Modulecmd - Interface to modulecmd from Perl

  # 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');

  use Env::Modulecmd ('bazola/1.0', 'ztesch/1.0',
                      { load => 'oogle/1.0',
                        unload => [qw(foogle/1.0 boogle/1.0)],
                      }
                     );

  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');

  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

# $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__