[Bio] / FigKernelPackages / Subsystem.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/Subsystem.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.11, Thu Jun 10 13:40:07 2004 UTC revision 1.12, Mon Jun 14 22:04:35 2004 UTC
# Line 6  Line 6 
6  use FIGAttributes;  use FIGAttributes;
7  use base 'FIGAttributes';  use base 'FIGAttributes';
8    
9    use POSIX;
10  use DirHandle;  use DirHandle;
11  use Data::Dumper;  use Data::Dumper;
12  use File::Spec;  use File::Spec;
13    use IPC::Open2;
14    
15  use strict;  use strict;
16    
# Line 644  Line 646 
646          warn "Cannot find col for $colstr\n";          warn "Cannot find col for $colstr\n";
647          return undef;          return undef;
648      }      }
   
649      my $cell = $self->get_cell($row, $col);      my $cell = $self->get_cell($row, $col);
650    
651      if ($cell)      if ($cell)
652      {      {
653          return @$cell;          return @$cell;
# Line 678  Line 680 
680      return $dir;      return $dir;
681  }  }
682    
683    #
684    # Code for dealing with Bill McCune's prolog code for extending subsystems.
685    #
686    # The code here is a reconstruction of Bill's "go" script in perl with
687    # data pulled from the local SEED configuration.
688    #
689    
690    sub extend_with_billogix
691    {
692        my($self, $muser) = @_;
693        my($isMaster, $user);
694    
695        my $now = time();
696    
697        my $job_id = strftime("%m-%d-%y:%H:%M:%S", localtime($now));
698    
699        if ($muser =~ /master:(.*)/)
700        {
701            $isMaster = 1;
702            $user = $1;
703        }
704        else
705        {
706            $isMaster = 0;
707            $user = $muser;
708        }
709    
710        #
711        # Find the executable.
712        #
713    
714        my $exe = "$FIG_Config::bin/billogix";
715    
716        if (! -x $exe)
717        {
718            warn "Cannot find billogix exe at $exe\n";
719            return;
720        }
721    
722        my $ss_name = $self->{name};
723        my $ss_dir = $self->{dir};
724        my $assign_dir = "$FIG_Config::data/Assginments/$user";
725        &FIG::verify_dir($assign_dir);
726    
727        my $seed = &FIG::cgi_url() . "/";
728    
729        #
730        # Have the prereq stuff, now start up the app.
731        #
732    
733        $ENV{LOCALSZ} = "80000";
734        $ENV{GLOBALSZ} = "80000";
735        $ENV{TRAILSZ} = "30000";
736        $ENV{BILLOGIX} = "/Users/olson/FIGdisk/dist/releases/dev/Billogix";
737    
738        my $app_input = <<EOINP;
739    ['\$BILLOGIX/top'].
740    loadup.
741    asserta(url_default_seed('$seed')).
742    asserta(ss_directory('$ss_dir')).
743    asserta(assign_directory('$assign_dir')).
744    asserta(job_id('$job_id')).
745    extend_test3('$ss_name').
746    EOINP
747    
748        print STDERR <<EOF;
749    Starting app
750    
751    ss_name = $ss_name
752    ss_dir = $ss_dir
753    user = $user
754    assign_dir = $assign_dir
755    exe = $exe
756    
757    App input
758    $app_input
759    EOF
760    # feh, put in a block to reset perlmode indentation.
761    {
762        my($app_read, $app_write, $log);
763    
764        open($log, ">$ss_dir/extension.log");
765    
766        my $pid = open2($app_read, $app_write, $exe);
767    
768        if (!$pid)
769        {
770            warn "open2 $exe failed: $!\n";
771            print $log "open2 $exe failed: $!\n";
772            return;
773        }
774    
775        print $app_write $app_input;
776        close($app_write);
777    
778        #
779        # Set autoflush on the logfile.
780        #
781    
782        my $old = select($log);
783        $| = 1;
784        select(STDERR);
785        $| = 1;
786        select($old);
787    
788        warn "Starting $exe with pid $pid\n";
789        print $log "Starting $exe with pid $pid\n";
790    
791        while (<$app_read>)
792        {
793            print STDERR $_;
794            print $log $_;
795        }
796    
797        print STDERR "App done\n";
798        print $log "App done\n";
799    
800        close($app_read);
801    
802        my $ret = waitpid($pid, 0);
803        my $stat = $?;
804        print STDERR "Return status is $?\n";
805        print $log "Return status is $?\n";
806    }
807    }
808    
809  package Subsystem::Diagram;  package Subsystem::Diagram;
810    
811  sub new  sub new

Legend:
Removed from v.1.11  
changed lines
  Added in v.1.12

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3