# Maple.pm -- Perl interface to Maple

# Copyright (c) 1997-2013 Vincent Lefevre <vincent@vinc17.net>.

# History:  Some code was written in 1997 during my PhD thesis at LIP,
# ENS-Lyon, France.  In 2006, the code was completed with support for
# ptys (necessary for Maple 9.5) and unified into this module, as part
# my work in the SPACES project at LORIA / INRIA Lorraine.  Some minor
# changes in 2008, 2011, 2012, and 2013.

# This program is free software; you may redistribute it
# and/or modify it under the same terms as Perl itself.

# No documentation is provided yet, except the comments in this module;
# the code itself is easy to understand and may give more information.

# TODO: implement clean timeout mechanisms (timers for pty and poll for
# open2), and let the user choose between the current timeout mechanism
# (using alarm) and the cleaner ones.

package Maple;
require 5.000;

use strict;
use Carp;
use IO::Handle;
use POSIX qw(strftime);

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(&maplepid &maple_wr &maple_rd &maple_eval
                 &startmaple &quitmaple);
our @EXPORT_OK = qw($wrlog $timeout &getipc &setipc);

########################################################################
# Global variables
########################################################################

our ($VERSION) = '$Id: Maple.pm 60055 2013-04-30 11:15:33Z vinc17/xvii $'
  =~ / (\d{4}-\d\d-\d\d \d\d:\d\d:\d\d)Z/;
our $debug;  # debug level
our $gmt;    # set it to use GMT (UTC) time in debug messages
our $wrlog = $ENV{'MAPLEPM_WRLOG'};  # file name to log data sent to Maple
our $timeout = $ENV{'MAPLEPM_TIMEOUT'} || 0;  # timeout for maple_rd

########################################################################
# File-private variables
########################################################################

my @maple = ($ENV{'MAPLE'} || 'maple', '-q', '-s');
my ($pid,$pty,$ptyin,$ptyout);

# Interprocess communication mode
my $ipc = "pipe";

########################################################################
# Functions
########################################################################

sub VERSION
  { croak "Maple version $_[1] required -- this is only version $VERSION"
      if $_[1] gt $VERSION }

sub outdbg($$)
  { $debug >= $_[1] and warn sprintf "[%s] Maple: %s\n",
      strftime("%Y-%m-%d %T", $gmt ? gmtime : localtime), $_[0] }

# Return the interprocess communication mode.
sub getipc()
  { return $ipc }

# Set the interprocess communication mode.
# Return 1 if the interprocess communication mode could successfully
# be set; otherwise return 0.
sub setipc($)
  {
    return 0 if $pid || ($_[0] ne "pipe" && $_[0] ne "pty");
    $ipc = $_[0];
    outdbg("IPC set to '$ipc'", 1);
    $pty = $ipc eq "pty";
    return 1;
  }

# Return the Maple PID (undef if none).
sub maplepid()
  { return $pid }

# Send data to Maple.
sub maple_wr($)
  {
    my $data = $_[0];
    chomp $data;
    if ($wrlog ne '')
      { print WRLOG "$data\n" or croak "Maple: can't write to $wrlog" }
    # Replace newline characters by spaces, because when a pty is used,
    # lines may be echoed out of order!
    $data =~ tr/\n/ /;
    outdbg("maple_wr { $data }", 2);
    if ($pty)
      {
        $ptyin = "StartOfInput: $data EndOfInput:\n";
        pump $pty while length $ptyin;
      }
    else
      {
        local $SIG{'PIPE'} = sub { croak "Maple: broken pipe" };
        print WR "$data\n" or croak "Maple: can't write to the pipe";
      }
  }

# Read data from Maple.
sub maple_rd()
  {
    my $line;
    eval
      {
        local $SIG{__DIE__} = 'DEFAULT';
        local $SIG{'ALRM'} = sub { die "alarm" };
        alarm $timeout;
        outdbg("maple_rd (timeout = $timeout seconds)", 2);
        if ($pty)
          {
            pump $pty while
              ($ptyout =~ s/StartOfInput:.*?EndOfInput:\s*//gs,
               $ptyout =~ /StartOfInput:/s ||
               $ptyout !~ s/^\s*(\S.*?)\s*\n//);
            $line = $1;
          }
        else
          {
            ($line) = <RD> =~ /^\s*(.*?)\s*$/;
          }
        alarm 0;
      };
    $@ eq '' or croak "Maple: $@";
    croak "Maple: $line" if
      ($line =~ /fatal error, lost connection to kernel/ ||
       $line =~ /Unhandled signal caught/ ||
       $line =~ /Pipe closed unexpectedly/ ||
       $line =~ /Execution stopped: Bus Error/);
    outdbg("maple_rd -> $line", 2);
    return $line;
  }

sub maple_eval($)
  {
    maple_wr("$_[0];");
    return maple_rd;
  }

# Start Maple.
# If an argument is given and is greater than 0, then try again in case of
# initialization error (e.g. because the license server isn't reachable),
# after sleeping for a time given by this argument.
# Warning! This module cannot set up a SIGCHLD handler as it may conflict
# with the main program, which may have other children; it is not possible
# to detect whether a specific child has died without a race condition.
# The subroutine may fail with "croak", but if $pid is still defined, the
# command may still be running. This will normally make the main program
# die, and the command should terminate as a consequence (broken pipe),
# but if the main program calls startmaple in an "eval", it is up to it
# to make the command quit with "maplepid and quitmaple" or "quitmaple".
sub startmaple(;$)
  {
    outdbg("startmaple (\@maple = @maple)", 1);
    if ($pty)
      {
        require IPC::Run;
        $pty = IPC::Run::start(\@maple, '<pty<', \$ptyin, '1>pty>', \$ptyout);
        $pid = ${$pty->{'KIDS'}}[0]->{'PID'};
      }
    else
      {
        eval
          {
            require IPC::Open2;
            $pid = IPC::Open2::open2(\*RD, \*WR, "exec @maple 2>&1");
            # Note that with the form above, IPC::Open2::open2 executes
            # a shell, thus will generally succeed even if the "maple"
            # command does not exist or is not executable.
          };
        if ($@ ne '')
          {
            # Will generally not occur (see above)...
            undef $pid;
            croak "$@\nMaple: startmaple failed in open2";
          }
      }
    outdbg("startmaple command started, pid = $pid", 1);
    if ($wrlog ne '')
      {
        open WRLOG, ">$wrlog" or croak "Maple: can't create $wrlog ($!)";
        WRLOG->autoflush(1);
      }
    my $z = maple_eval("interface(prettyprint=0,screenwidth=infinity): 0");
    while ($z eq 'No licenses available, queueing request...')
      {
        outdbg($z, 1);
        $z = maple_rd;
      }
    if ($z =~ /Maple initialization error/)
      {
        $_[0] > 0 or croak "Maple: startmaple failed ($z)";
        &quitmaple;
        outdbg("$z", 1);
        outdbg("Let's sleep for $_[0] seconds and try again...", 1);
        sleep $_[0];
        goto &startmaple;
      }
    $z eq '0' or croak "Maple: startmaple failed (got '$z' instead of '0')";
    outdbg("Maple correctly started", 1);
  }

# Quit Maple.
sub quitmaple()
  {
    outdbg("quitmaple", 1);
    $pid or return;
    if ($pty)
      {
        local $SIG{__DIE__} = 'DEFAULT';  # Necessary due to the "finish"
        $ptyin = "quit\n";
        finish $pty;
      }
    else
      {
        # The following close's should make Maple quit if this is really
        # a Maple process and Maple isn't frozen (a freeze has never been
        # seen in practice). It is cleaner not to force a "kill", which
        # may prevent clean-up or may kill a wrong process in case of the
        # main program has already reaped the dead child and a new child
        # with the same PID has started. It the latter case, this module
        # may freeze in waitpid. Resetting the CHLD handler to 'DEFAULT'
        # locally may avoid a race condition, but it is better to let the
        # main program deal with side effects it introduces.
        close WR or croak "Maple: can't close WR ($!)";
        close RD or croak "Maple: can't close RD ($!)";
        waitpid $pid, 0;
      }
    undef $pid;
    outdbg("quitmaple OK", 1);
    return 1;
  }

########################################################################
# End of the package, return 1.
########################################################################

1;

# End of Maple.pm