File Coverage

blib/lib/Math/GAP.pm

Criterion	Covered	Total	%
statement	32	104	30.7
branch	2	28	7.1
condition	2	6	33.3
subroutine	10	16	62.5
pod	6	8	75.0
total	52	162	32.1

package Math::GAP;

use 5.008000;
use strict;
use warnings;

use IO::Handle;
use Exporter;

use Scalar::Util qw(refaddr);

use Carp;
use Socket;


our $VERSION = '0.03';

my $GAP_path  = '' ; #set at installation
my @GAP_com_op= qw/-b/ ; #command line option for starting GAP

my $PROMPT    = 'gap>' ;
my $ENDLINE   = ':_ENDCOM_:' ;

my %reader_of;
my %writer_of;
my %log_of;
my %pending_of;
my %cpid_of;


sub set_GAP{
    my $class=shift;
    $GAP_path=shift;
    @GAP_com_op = @_ || @GAP_com_op;

    (my $gap_path = $GAP_path) =~ s{/sage\s+-.+}{/sage};

    croak "Non executable GAP Interpreter"
	unless (-f $gap_path && -x $gap_path);
    return;
}


sub get_GAP{
    my $class=shift;
    if (wantarray) {
	return ($GAP_path, @GAP_com_op);
    }
    return $GAP_path;
}



sub start_GAP{
    my $self =shift;
    my $self_id = refaddr($self);

    socketpair(my $child,my $parent, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
	or  croak "socketpair: $!";
    $child->autoflush(1);
    $parent->autoflush(1);

    my $pid;

    if ($pid=fork){
	close $parent;
    } else {

	if(!defined($pid)) {croak "Cannot fork to start GAP";}

	close $child;

	open(STDIN,"<&",$parent) or croak "$!";
	open(STDOUT,">&",$parent) or croak "$!";
	open(STDERR,">",'/dev/null');

	my $command = join(" ", $GAP_path,@GAP_com_op);

	exec ($command)
	    or croak   q{Problem with exec of '}
                     . $command
		     . q{'};
	#exec failure: send signal to father would be better
    }

    $cpid_of{$self_id} =$pid;
    $reader_of{$self_id}=$child;
    $writer_of{$self_id}=$child;
    return;
}


sub code{
    my ($self, $command, $hashref)=@_;
    my $self_id = refaddr($self);

    if (defined($hashref->{discard})) {
	my $bkp=$self->get();
	$log_of{$self_id}.=$bkp;
	#	print STDERR "backing up log (\n--\n$bkp\n--)\n";
    }

    print {$writer_of{$self_id}} q{Display("");} ;
    print {$writer_of{$self_id}} $command ;
    print {$writer_of{$self_id}}
           q{Display("");}
          .q{Display("} . $ENDLINE . q{");}
          .qq{\n} ;


    $pending_of{$self_id}++;


    if (defined($hashref->{discard})) {
	my $wiped=$self->get({last=>1});
	#	print STDERR "wiping out output (\n--\n$wiped\n--)\n";
    }
}

sub get{
    my ($self, $hashref)=@_;
    my $self_id = refaddr($self);


    my $output='';
    while ($pending_of{$self_id} > 0){
    	while (my $line=readline($reader_of{$self_id}))
    	{

	    $line =~ s/^($PROMPT\s*)+//ogix;

	    $output.= $line;
	    last if $line =~ m/^$ENDLINE$/o;
    	}

	$pending_of{$self_id}--;

    }

    if (!defined($hashref->{keep})) {#$starter_of{$self_id}
	$output =~ s/(^\n)?$ENDLINE\n//gm;
    }
    if (defined($hashref->{last})){return $output;}
    my $copy=$log_of{$self_id}.$output;
    $log_of{$self_id}='';
    return $copy;
}

sub load {
    my ($self,$toload,$hashref)= @_;

    if (-r $toload) {
	$self->code("Read(\"$toload\");",$hashref);
    } else {
	$self->code("LoadPackage(\"$toload\");;",{discard=>1});
    }
}

sub new {
    my $class = shift;
    my $obj= bless \do{my $anon_scalar}, $class;;
    my $obj_id = refaddr($obj);


    $log_of{$obj_id}='';
    $pending_of{$obj_id}=0;

    $obj->start_GAP();
    $obj->code("\n",{discard=>1});


    return $obj;
}

sub DEMOLISH {
    my $self = shift;
    my $self_id = refaddr($self);

    $self->code('quit;');

    delete $log_of{$self_id};
    delete $pending_of{$self_id};
    delete $reader_of{$self_id};
    delete $writer_of{$self_id};
}


1;
__END__