#!/bin/sh
########################################################
# This is a shell archive  --- shark 0.1.1 ---         #
# Please remove any lines before this header and       #
# run     sh this-file-name     to extract all files.  #
# 1994 (C) Fernando J G Pereira - fjp@minerva.inesc.pt #
########################################################
echo unsharking Modules.sh
cat > Modules.sh << '\\__END__OF__Modules.sh__FILE\\'
#!/bin/sh
########################################################
# This is a shell archive  --- shark 0.1.1 ---         #
# Please remove any lines before this header and       #
# run     sh this-file-name     to extract all files.  #
# 1994 (C) Fernando J G Pereira - fjp@minerva.inesc.pt #
########################################################
echo unsharking BLIPcard.pm
cat > BLIPcard.pm << '\\__END__OF__BLIPcard.pm__FILE\\'
#! /usr/local/bin/perl 

package BLIPcard; 
#
#		BLIPcard.pm
#
#	INHERITS FROM:  ElecModule
#	CONTAINS:  Control, DAC
#
#	Contains commands for setting and reading back the digital DACs and 
#	controls on the BLIP card.  Also contains routines for printing the
#	card settings.
#

require 5.002;
require ElecModule;

use Digital;
use Control;
use DAC;

@ISA = qw( ElecModule );

my %fields = ( 
  box             => undef,
  module          => undef,
  data            => undef,
  address         => undef,
  Mux             => undef,
  jumpers         => undef,
  IBAPACAP        => undef,
  Phonon2         => undef,
  QLED            => undef,
  Phonon1         => undef,
  Lockin          => undef,
  filename        => undef,
  muxNames        => {},
  qo              => undef,
  qi              => undef,
  implant         => undef,
  led             => undef,
  ci              => undef,
  co              => undef,
  ps2             => undef,
  ps1             => undef,
  outfile         => undef,
  Controls        => {},
  DACs            => {},
  scriptonly      => undef,
  class           => undef,
  Accumulate      => undef,
);
#
#                             Basic Functions
#
#--------------------------------------------------------------- BLIPcard::new
sub new{
  my $this = shift;
  my $class = ref($this) || $this;
  my $self = ElecModule->new($_[0],$_[1],$_[2]);
  $self->{_permitted} = \%fields;
  bless $self,$class;

  $self->class("BLIPcard");

  $self->IBAPACAP(new Control(9,"ciPulse","ciRange","coPulse","coRange","pPulse","pRange","pHeat","trigDelay"));
  $self->IBAPACAP->setData("0");
  $self->Phonon2(new Control(10,"ref","filter","var","div","gnd"));
  $self->Phonon2->setGroupSize("ref",2);
  $self->Phonon2->setData("3f");
  $self->QLED(new Control(11,"Qignd","Qpol","QiImon","QoImon","Qognd","polarity","pulse","on"));
  $self->QLED->setData("fd");
  $self->Phonon1(new Control(12,"ref","filter","var","div","gnd"));
  $self->Phonon1->setGroupSize("ref",2);
  $self->Phonon1->setData("3f");
  $self->Lockin(new Control(13,"bypass1","ext1","","vampFast","bypass2","ext2","","azfast"));
  $self->Lockin->setData("88");
  $self->Mux(new Control(14,"mux1","","mux2"));
  $self->Mux->setGroupSize("mux1",4);
  $self->Mux->setGroupSize("",4);
  $self->Mux->setGroupSize("mux2",4);

  $self->{muxNames}->{vamp1}   = 0;
  $self->{muxNames}->{vamp2}   = 1;
  $self->{muxNames}->{qoimon}  = 2;
  $self->{muxNames}->{qovmon}  = 3;
  $self->{muxNames}->{qiimon}  = 4;
  $self->{muxNames}->{qivmon}  = 5;
  $self->{muxNames}->{ledv}    = 6;
  $self->{muxNames}->{ledi}    = 7;
  $self->{muxNames}->{ps1bias} = 8;
  $self->{muxNames}->{ps2bias} = 9;
  $self->{muxNames}->{tsense}  = 10;
  $self->{muxNames}->{fethtr}  = 11;
  $self->qo      (new DAC(1,12,-10,10));
  $self->qi      (new DAC(2,12,-10,10));
  $self->implant (new DAC(3,12,0,10));
  $self->led     (new DAC(4,12,0,10));
  $self->ci      (new DAC(5,12,0,10));
  $self->co      (new DAC(6,12,0,10));
  $self->ps2     (new DAC(7,12,0,10));
  $self->ps1     (new DAC(8,12,0,10));
 
  $self->{Controls}->{QLED}        = $self->QLED;
  $self->{Controls}->{Lockin}      = $self->Lockin;
  $self->{Controls}->{Phonon1}     = $self->Phonon1;
  $self->{Controls}->{Phonon2}     = $self->Phonon2;
  $self->{Controls}->{IBAPACAP}    = $self->IBAPACAP;
  $self->{Controls}->{Mux}         = $self->Mux;
  $self->{DACs}->{Qouter}          = $self->qo;
  $self->{DACs}->{Qinner}          = $self->qi;
  $self->{DACs}->{Implant}         = $self->implant;
  $self->{DACs}->{LED}             = $self->led;
  $self->{DACs}->{Ci}              = $self->ci;
  $self->{DACs}->{Co}              = $self->co;
  $self->{DACs}->{PS1}             = $self->ps1;
  $self->{DACs}->{PS2}             = $self->ps2;

  my %dacs = %{$self->DACs};

  foreach $key (sort keys %dacs) {
      $dacs{$key}->setValue(0);
  }
  
  my $host = $self->box->host;

  if (($self->scriptonly) == 1) {
      $host = "script";
  }

  my $module  = $self->module; 
  my $subrack  = $self->box->subrack; 
  
  $self->filename("/tmp/$host-$class-$subrack-$module.out");
  $self->fromFile($self->filename);
  return $self;
}
#--------------------------------------------------------- BLIPcard::init
sub init{   #help: init resets registers to power-up states.
  my $self = shift;
  my $class = ref($self) || $self;
  my $module  = $self->module; 

  $self->QLED->setData("fd");
  $self->Lockin->setData("88");
  $self->Phonon1->setData("3f");
  $self->Phonon2->setData("3f");
  $self->IBAPACAP->setData("0");
  $self->qo->setValue(10);
  $self->qi->setValue(10);
  $self->implant->setValue(10);
  $self->led->setValue(10);
  $self->ci->setValue(10);
  $self->co->setValue(10);
  $self->ps2->setValue(10);
  $self->ps1->setValue(10);
  $self->Mux1("vamp1");
  $self->Mux2("vamp1");
  $self->toFile($self->filename);
}
#
#                                   Multiplexers.
#
#--------------------------------------------------------------- BLIPcard::Mux1
#help: Mux1,Mux2    Return the index of current channel on Mux1,2
#help: Mux1,2(which) Set Mux1,2 to the string "which". Possiblitites are vamp1,vamp2,QiImon,QiVmon,QoImon,QoVmon,LEDV,LEDI,PS1Bias,PS2Bias,TSense, or FETHtr
sub Mux1 {
  my $self = shift;
  my $i=0,$which=1;
  if ($#_ > -1) {
    my ($value,$which) = @_;
    $value = lc $value;
    if (!(exists $self->muxNames->{$value} )) {
      warn "Can't access `$value' field in object of muxNames \n";
      return;
    }
    $which = 1 if $which !=2;
    my $num = $self->muxNames->{$value};
    $self->Mux->setGroup("mux$which",$num);
    my $comment = "BLIP mux$which to $num";
    $self->writeControl($self->Mux,$comment);
  } else {
    return $self->mux1 if $which == 1;
    return $self->mux2 if $which == 2;
  }
}
#--------------------------------------------------------------- BLIPcard::Mux2
sub Mux2 {
  my $self = shift;
  return $self->Mux1(@_,2);
}
#
#                           Write the DAC's
#
#--------------------------------------------------------------- BLIPcard::QODAC
#help: QODAC(v)    set Qouter DAC to v Volts
sub QODAC {
  my $self = shift;
  my ($val) = @_;
  my $comment = "BLIP QouterDAC to $val volts";
  $self->qo->setValue($val);
  $self->writeControl($self->qo,$comment);
}
#--------------------------------------------------------------- BLIPcard::QIDAC
#help: QIDAC(v)    set Qinner DAC to v Volts
sub QIDAC {
  my $self = shift;
  my ($val) = @_;
  my $comment = "BLIP QinnerDAC to $val volts";
  $self->qi->setValue($val);
  $self->writeControl($self->qi,$comment);
}
#--------------------------------------------------------------- BLIPcard::ImplantDAC
#help: ImplantDAC(v)    set Implant DAC (IBAPACAP) to v Volts
sub ImplantDAC {
  my $self = shift;
  my ($val) = @_;
  my $comment = "BLIP ImplantDAC to $val volts";
  $self->implant->setValue($val);
  $self->writeControl($self->implant,$comment);
}
#--------------------------------------------------------------- BLIPcard::LEDDAC
#help: LEDDAC(v) set LED DAC to v Volts
sub LEDDAC {
  my $self = shift;
  my ($val) = @_;
  my $comment = "BLIP LEDDAC to $val volts";
  $self->led->setValue($val);
  $self->writeControl($self->led,$comment);
}
#--------------------------------------------------------------- BLIPcard::ciDAC
#help: ciDAC(v)  set Cinner (IBAPACAP) DAC to v Volts
sub CinnerDAC {
  my $self = shift;
  my ($val) = @_;
  my $comment = "BLIP CinnerDAC to $val volts";
  $self->ci->setValue($val);
  $self->writeControl($self->ci,$comment);
}
#--------------------------------------------------------------- BLIPcard::coDAC
#help: coDAC(v)    set Couter (IBAPACAP) DAC to v Volts
sub CouterDAC {
  my $self = shift;
  my ($val) = @_;
  my $comment = "BLIP CouterDAC to $val volts";
  $self->co->setValue($val);
  $self->writeControl($self->co,$comment);
}
#--------------------------------------------------------------- BLIPcard::PS2DAC
#help: PS2DAC(v)    set Phonon Sensor 2 DAC to v Volts
sub PS2DAC {
  my $self = shift;
  my ($val) = @_;
  my $comment = "BLIP PS2DAC to $val volts";
  $self->ps2->setValue($val);
  $self->writeControl($self->ps2,$comment);
}
#--------------------------------------------------------------- BLIPcard::PS1DAC
#help: PS1DAC(v)    set Phonon Sensor 1 DAC to v Volts
sub PS1DAC {
  my $self = shift;
  my ($val) = @_;
  my $comment = " BLIP PS1DAC to $val volts";
  $self->ps1->setValue($val);
  $self->writeControl($self->ps1,$comment);
}
#
#                               write the Control registers.
#
#--------------------------------------------------------------- BLIPcard::LEDOn
sub LEDOn {   # default true, val = 0, false.
  my $self = shift;
  my $val=0;
  my $comment = undef;
  if ($#_>-1) {
    ($val) = @_;
    if ($val > 0) {$val=0;} else {$val=1;}
  }
  if ($val == 0) {
      $comment = "BLIP LED On";
  } else {
      $comment = "BLIP LED Off";
  }
  $self->QLED->fromFile($self->filename);
  $self->QLED->setGroup("on",$val);
  $self->writeControl($self->QLED,$comment);
}
#---------------------------------------------------------- BLIPcard::LEDpulse
#help: LEDpulse(times=1)  Pulse the selected LED times times.
sub LEDpulse {   # default true, val = 0, false.
  my $self=shift;
  my $ntimes=1;
  my $i;
  if ($#_>-1){
    ($ntimes) = @_;
  }
  for ($i=0;$i<$ntimes;$i++) {
    $self->setLEDpulse($i%2);
  }
}
#--------------------------------------------------------------- BLIPcard::LEDOff
#help: LEDOff  turn off the LED.
sub LEDOff {
  my $self = shift;
  $self->LEDOn(0);
}
#---------------------------------------------------------- BLIPcard::setLEDpulse
sub setLEDpulse {   # default true, val = 0, false.
  my $self = shift;
  my $val;
  my $comment = undef;
  $val = 0;
  if ($#_>-1) {
    ($val) = @_;
    if ($val > 0) {$val=0;} else {$val=1;}
  }
  if ($val == 0) {
      $comment = "BLIP Pulse LED";
  } else {
      $comment = "BLIP Unpulse LED";
  }
  $self->QLED->fromFile($self->filename);
  $self->QLED->setGroup("pulse",$val);
  $self->writeControl($self->QLED,$comment);
}

#--------------------------------------------------------- BLIPcard::LEDminus
#help: LEDminus Select the negative LED leg.
sub LEDminus {   # default true, val = 0, false.
  my $self = shift;
  $self->LEDplus(0);
}
#--------------------------------------------------------------- BLIPcard::LEDplus
#help: LEDplus Select the positive LED leg.
sub LEDplus {   # default true, val = 0, false.
  my $self = shift;
  my $val;
  my $comment = undef;
  $val = 1;
  if ($#_>-1) {
    ($val) = @_;
  }
  if ($val > 0) {
     $val=1;
     $comment = "BLIP LEDplus";
  } else {
     $val=0;
     $comment = "BLIP LEDminus";
  }
  $self->QLED->fromFile($self->filename);
  $self->QLED->setGroup("polarity",$val);
  $self->writeControl($self->QLED,$comment);
}
#--------------------------------------------------------------- BLIPcard::QoImon
#help: QoImon Monitor current of outer Charge channel. Turn off by giving 0 as an argument.
sub QoImon {
  my $self = shift;
  my $comment = "BLIP QoImon";
  $self->QLED->fromFile($self->filename);
  $self->QLED->setGroup("QoImon",1);
  $self->writeControl($self->QLED,$comment);
}
#--------------------------------------------------------------- BLIPcard::QiImon
sub QiImon {
  my $self = shift;
  my $comment = "BLIP QiImon";
  $self->QLED->fromFile($self->filename);
  $self->QLED->setGroup("QiImon",1);
  $self->writeControl($self->QLED,$comment);
}
#--------------------------------------------------------------- BLIPcard::QiVmon
#help: QiVmon Monitor Voltage of inner Charge channel. Turn off by giving 0 as an argument.
sub QiVmon {
  my $self = shift;
  my $comment = "BLIP QiVmon";
  $self->QLED->fromFile($self->filename);
  $self->QLED->setGroup("QiImon",0);
  $self->writeControl($self->QLED,$comment);
}
#--------------------------------------------------------------- BLIPcard::QoVmon
#help: QoVmon  Monitor Voltage of outer Charge channel.
sub QoVmon {
  my $self = shift;
  my $comment = "BLIP QoVmon";
  $self->QLED->fromFile($self->filename);
  $self->QLED->setGroup("QoVmon",0);
  $self->writeControl($self->QLED,$comment);
}
#--------------------------------------------------------------- BLIPcard::Qpol
#help: Qpol(pol=0)  sets the polarity of the QAmps. Default=0 (positive).
sub Qpol {   # default true, val = 0, false.
  my $self = shift;
  my $val=0;
  if ($#_>-1) {
    ($val) = @_;
  }
  my $comment = "BLIP Qpolarity to $val";
  $self->QLED->fromFile($self->filename);
  $self->QLED->setGroup("Qpol",$val);
  $self->writeControl($self->QLED,$comment);
}
#--------------------------------------------------------------- BLIPcard::gndQI
#help: gndQI(state=1) ground/unground Qi bias (state=1 grounds it)
#help: gndQO(state=1) ground/unground Qo bias (state=1 grounds it)
sub gndQI {   # default true, val = 0, false.
  my $self = shift;
  my $val;
  my $comment = undef;
  $val = 1;
  if ($#_>-1) {
    ($val) = @_;
  }
  if ($val == 1) {
     $comment = "BLIP ground Qi bias";
  } else {
     $comment = "BLIP unground Qi bias";
  }
  $self->QLED->fromFile($self->filename);
  $self->QLED->setGroup("Qignd",$val);
  $self->writeControl($self->QLED,$comment);
}
#--------------------------------------------------------------- BLIPcard::gndQO
sub gndQO {   # default true, val = 0, false.
  my $self = shift;
  my $val;
  my $comment = undef;
  $val = 1;
  if ($#_>-1) {
    ($val) = @_;
  }
  if ($val == 1) {
     $comment = "BLIP ground Qo bias";
  } else {
     $comment = "BLIP unground Qo bias";
  }
  $self->QLED->fromFile($self->filename);
  $self->QLED->setGroup("Qognd",$val);
  $self->writeControl($self->QLED,$comment);
}
#--------------------------------------------------------------- BLIPcard::vampFast
#help: vampFast/Slow  set the fast/slow V amp setting
sub vampFast {   # default true, val = 0, false.
  my $self = shift;
  my $val;
  my $comment = undef;
  $val = 1;
  if ($#_>-1) {
    ($val) = @_;
  }
  if ($val == 1) {
      $comment = "BLIP fast V amp";
  } else {
      $comment = "BLIP slow V amp";
  }
  $self->Lockin->fromFile($self->filename);
  $self->Lockin->setGroup("vampFast",$val);
  $self->writeControl($self->Lockin,$comment);
}
#--------------------------------------------------------------- BLIPcard::vampSlow
sub vampSlow { my $self=shift; $self->vampFast(0);}
#--------------------------------------------------------------- BLIPcard::gndPS1
#help: gndPS1(state=1)  ground/unground PS 1 bias
sub gndPS1 {   # default true, val = 0, false.
  my $self = shift;
  my $val;
  my $comment = undef;
  $val = 1;
  if ($#_>-1){
    ($val) = @_;
  }
  if ($val == 1) {
     $comment = "BLIP ground PS1 bias";
  } else {
     $comment = "BLIP unground PS1 bias";
  }
  $self->Phonon1->fromFile($self->filename);
  $self->Phonon1->setGroup("gnd",$val);
  $self->writeControl($self->Phonon1,$comment);
}
#--------------------------------------------------------------- BLIPcard::gndPS2
#help: gndPS2(state=1)  ground/unground PS 2 bias
sub gndPS2 {   # default true, val = 0, false.
  my $self = shift;
  my $val;
  my $comment = undef;
  $val = 1;
  if ($#_>-1) {
    ($val) = @_;
  }
  if ($val == 1) {
     $comment = "BLIP ground PS2 bias";
  } else {
     $comment = "BLIP unground PS2 bias";
  }
  $self->Phonon2->fromFile($self->filename);
  $self->Phonon2->setGroup("gnd",$val);
  $self->writeControl($self->Phonon2,$comment);
}
#--------------------------------------------------------------- BLIPcard::extref
#help: extref(state=1)  ground/unground PS 2 bias
sub extref {   # default true, val = 0, false.
  my $self = shift;
  my $val;
  my $comment = undef;
  $val = 1;
  if ($#_>-1) {
    ($val) = @_;
  }
  if ($val == 1) {
     $comment = "BLIP external reference bias";
  } else {
     $comment = "BLIP signal reference";
  }
  $self->Lockin->fromFile($self->filename);
  $self->Lockin->setGroup("ext1",$val);
  $self->Lockin->setGroup("ext2",$val);
  $self->writeControl($self->Lockin,$comment);
}
#--------------------------------------------------------------- BLIPcard::varPS1
#help: varPS1/2(variable=0)  select/deselect variable input in PS 1/2
sub varPS1 {   # default true, val = 0, false.
  my $self = shift;
  my $val;
  $val = 0;
  if ($#_>-1) {
    ($val) = @_;
  }
  my $comment = "BLIP varPS1 $val";
  $self->Phonon1->fromFile($self->filename);
  $self->Phonon1->setGroup("var",$val);
  $self->writeControl($self->Phonon1,$comment);
}
#--------------------------------------------------------------- BLIPcard::varPS2
sub varPS2 {   #  use the variable signal? default true, val = 0, false.
  my $self = shift;
  my $val;
  $val = 0;
  if ($#_>-1) {
    ($val) = @_;
  }
  my $comment = "BLIP varPS2 $val";
  $self->Phonon2->fromFile($self->filename);
  $self->Phonon2->setGroup("var",$val);
  $self->writeControl($self->Phonon2,$comment);
}
#--------------------------------------------------------------- BLIPcard::divPS1
#help: divPS1/2(variable=0)  select/deselect divider in PS 1/2. (0 does NOT divide) 
sub divPS1 {   #  use the variable signal? default true, val = 0, false.
  my $self = shift;
  my $val = 1;
  my $comment = undef;
  if ($#_>-1) {
    ($val) = @_;
  }
  if ($val == 1) {
     $comment = "BLIP divide PS1";
  } else {
     $comment = "BLIP undivide PS1";
  }
  $self->Phonon1->fromFile($self->filename);
  $self->Phonon1->setGroup("div",$val);
  $self->writeControl($self->Phonon1,$comment);
}
#--------------------------------------------------------------- BLIPcard::divPS2
sub divPS2 {   #  use the variable signal? default true, val = 0, false.
  my $self = shift;
  my $val;
  my $comment = undef;
  $val = 1;
  if ($#_>-1) {
    ($val) = @_;
  }
  if ($val == 1) {
     $comment = "BLIP divide PS2";
  } else {
     $comment = "BLIP undivide PS2";
  }
  $self->Phonon2->fromFile($self->filename);
  $self->Phonon2->setGroup("div",$val);
  $self->writeControl($self->Phonon2,$comment);
}
#--------------------------------------------------------------- BLIPcard::filterPS1
#help: filterPS1/2(select=0)  select/deselect filter in PS 1/2. (default 0)
sub filterPS1 {   # Select the sin wave filter.
  my $self = shift;
  my $val;
  my $comment = undef;
  $val = 1;
  if ($#_>-1) {
    ($val) = @_;
  }
  if ($val == 1) {
     $comment = "BLIP filterPS1 on";
  } else {
     $comment = "BLIP undivide PS1";
  }
  $self->Phonon1->fromFile($self->filename);
  $self->Phonon1->setGroup("filter",$val);
  $self->writeControl($self->Phonon1,$comment);
}
#--------------------------------------------------------------- BLIPcard::filterPS2
sub filterPS2 {   # Select the sin wave filter.
  my $self = shift;
  my $val;
  $val = 1;
  if ($#_>-1) {
    ($val) = @_;
  }
  my $comment = "BLIP filterPS2 $val";
  $self->Phonon2->fromFile($self->filename);
  $self->Phonon2->setGroup("filter",$val);
  $self->writeControl($self->Phonon2,$comment);
}
#--------------------------------------------------------------- BLIPcard::tenHz
#help:  tenHz  select the 10Hz reference in PS 1 and 2
sub tenHz {
  my $self = shift;
  $self->filterPS1; $self->filterPS2;         # both sin filters on.
  $self->refPS1(1); $self->refPS2(1);
}
#--------------------------------------------------------------- BLIPcard::kHz
#help:  kHz  select the 1kHz reference in PS 1 and 2
sub kHz {
  my $self = shift;
  $self->filterPS1; $self->filterPS2;         # both sin filters on.
  $self->refPS1(0); $self->refPS2(0);
}
#           Lockin Controls
#--------------------------------------------------------------- BLIPcard::bypass
#help:  bypass(bp=1) if bp=1, bypass the lockins. bp=0, don't
sub bypass {
  my $self = shift;
  my $val;
  my $comment = undef;
  $val = 1;       # 1 is to select filter (good).
  if ($#_>-1) {
    ($val) = @_;
  }
  if ($val == 1) {
     $comment = "BLIP bypass lockins";
  } else {
     $comment = "BLIP don't bypass lockins";
  }
  $self->Lockin->fromFile($self->filename);
  $self->Lockin->setGroup("bypass1",$val);
  $self->Lockin->setGroup("bypass2",$val);
  $self->writeControl($self->Lockin,$comment);
}
#--------------------------------------------------------------- BLIPcard::azFast
#help:  azFast/Slow set the fast/slow autoZero setting
sub azFast {
  my $self = shift;
  my $val;
  my $comment = undef;
  $val = 1;       # 1 is to select filter (good).
  if ($#_>-1) {
    ($val) = @_;
  }
  if ($val == 1) {
     $comment = "BLIP fast autoZero";
  } else {
     $comment = "BLIP slow autoZero";
  }
  $self->Lockin->fromFile($self->filename);
  $self->Lockin->setGroup("azfast",$val);
  $self->writeControl($self->Lockin,$comment);
}
#--------------------------------------------------------------- BLIPcard::azSlow
sub azSlow {my $self = shift; $self->azFast(0);}
#--------------------------------------------------------------- BLIPcard::refPS1
#help: refPS1/2(which=1) select lockin reference in PS 1/2. (default 1)
sub refPS1 {   # set which reference the PS1 bias will use
#              # this should decode a number from 0 to 3 into bits A,B.
  my $self = shift;
  my $which = "1";
  if ($#_>-1) {
    ($which) = @_; shift
  }
  my $comment = "BLIP refPS1 to $which";
  $self->Phonon1->fromFile($self->filename);
  $self->Phonon1->setGroup("ref",$which);
  $self->writeControl($self->Phonon1,$comment);
}
#--------------------------------------------------------------- BLIPcard::refPS2
sub refPS2 {   # set which reference the PS1 bias will use
#              # this should decode a number from 0 to 3 into bits A,B.
  my $self = shift;
  my $which = "1";
  if ($#_>-1) {
    ($which) = @_; shift
  }
  my $comment = "BLIP refPS2 to $which";
  $self->Phonon2->fromFile($self->filename);
  $self->Phonon2->setGroup("ref",$which);
  $self->writeControl($self->Phonon2,$comment);
}
# ---------------------------
#        IBAPACAP
#----------------------------
#--------------------------------------------------------------- BLIPcard::ciPulse
#help: ciPulse Pulse inner charge on IBAPACAP
sub ciPulse {   
  my $self = shift;
  my $which = "1";
  if ($#_>-1) {
    ($which) = @_; shift
  }
  my $comment = "BLIP ciPulse $which";
  $self->IBAPACAP->fromFile($self->filename);
  $self->IBAPACAP->setGroup("ciPulse",$which);
  $self->writeControl($self->IBAPACAP,$comment);
}
#--------------------------------------------------------------- BLIPcard::ciRange
#help: ciRange Set inner charge range on IBAPACAP
sub ciRange {   
  my $self = shift;
  my $which = "1";
  if ($#_>-1) {
    ($which) = @_; shift
  }
  my $comment = "BLIP ciRange $which";
  $self->IBAPACAP->fromFile($self->filename);
  $self->IBAPACAP->setGroup("ciRange",$which);
  $self->writeControl($self->IBAPACAP,$comment);
}
#--------------------------------------------------------------- BLIPcard::coPulse
#help: coPulse Pulse outer charge on IBAPACAP
sub coPulse {   
  my $self = shift;
  my $which = "1";
  if ($#_>-1) {
    ($which) = @_; shift
  }
  my $comment = "BLIP coPulse $which";
  $self->IBAPACAP->fromFile($self->filename);
  $self->IBAPACAP->setGroup("coPulse",$which);
  $self->writeControl($self->IBAPACAP,$comment);
}
#--------------------------------------------------------------- BLIPcard::coRange
#help: coRange Set outer charge range on IBAPACAP
sub coRange {   
  my $self = shift;
  my $which = "1";
  if ($#_>-1) {
    ($which) = @_; shift
  }
  my $comment = "BLIP coRange $which";
  $self->IBAPACAP->fromFile($self->filename);
  $self->IBAPACAP->setGroup("coRange",$which);
  $self->writeControl($self->IBAPACAP,$comment);
}
#--------------------------------------------------------------- BLIPcard::pPulse
#help: pPulse Pulse phonon on IBAPACAP
sub pPulse {   
  my $self = shift;
  my $which = "1";
  if ($#_>-1) {
    ($which) = @_; shift
  }
  my $comment = "BLIP pPulse $which";
  $self->IBAPACAP->fromFile($self->filename);
  $self->IBAPACAP->setGroup("pPulse",$which);
  $self->writeControl($self->IBAPACAP,$comment);
}
#--------------------------------------------------------------- BLIPcard::pHeat
#help: pHeat Phonon heat on IBAPACAP
sub pHeat {   
  my $self = shift;
  my $which = "1";
  if ($#_>-1) {
    ($which) = @_; shift
  }
  my $comment = "BLIP pHeat $which";
  $self->IBAPACAP->fromFile($self->filename);
  $self->IBAPACAP->setGroup("pHeat",$which);
  $self->writeControl($self->IBAPACAP,$comment);
}
#--------------------------------------------------------------- BLIPcard::pRange
#help: pRange Phonon range on IBAPACAP
sub pRange {   
  my $self = shift;
  my $which = "1";
  if ($#_>-1) {
    ($which) = @_; shift
  }
  my $comment = "BLIP pRange $which";
  $self->IBAPACAP->fromFile($self->filename);
  $self->IBAPACAP->setGroup("pRange",$which);
  $self->writeControl($self->IBAPACAP,$comment);
}
#--------------------------------------------------------------- BLIPcard::trigDelay
#help: trigDelay Phonon delay on IBAPACAP
sub trigDelay {   
  my $self = shift;
  my $which = "1";
  if ($#_>-1) {
    ($which) = @_; shift
  }
  my $comment = "BLIP trigDelay $which";
  $self->IBAPACAP->fromFile($self->filename);
  $self->IBAPACAP->setGroup("trigDelay",$which);
  $self->writeControl($self->IBAPACAP,$comment);
}





\\__END__OF__BLIPcard.pm__FILE\\
chmod 664 BLIPcard.pm
echo unsharking ClientConnection.pm
cat > ClientConnection.pm << '\\__END__OF__ClientConnection.pm__FILE\\'
#! /usr/local/bin/perl -w 

package ClientConnection;
#
#               ClientConnection.pm
#
#       INHERITS FROM:  Connection
#       CONTAINS:  None
#
#	This package handles all of the communication for sending/receiving
#	ints and strings from a TCP/IP connection.  It contains routines for opening and 
#	closing the socket connection, sending the datastrings to the server
#	and for reading datastrings from the server.
#

require 5.002;
require object;
require Connection;

use Socket;
use Carp;

@ISA = qw( Connection );

my %fields = (
  host => undef,
  port => undef,
  sock => undef,
);
#-------------------------------------------------------------------- ClientConnection::new
sub new{
  my $this = shift;
  my $class = ref($this) || $this;
  my $self = Connection->new(@_);
  $self->{_permitted} = \%fields;
  bless $self,$class;

  $self->host("ppdm06.fnal.gov");
  $self->port(2345);

  my ($arg) = @_;
  my @hp = split /:/,$arg;
  $self->host($hp[0]);
  if ($hp[1]>0) {
    $self->port($hp[1]);
  }
  return $self;
}

#-------------------------------------------------------------------- ClientConnection::print
#help: print(void) prints selected information about connection
sub print{
  my $self = shift;
  print "Remote host: ",$self->host,"\n";
  print "Remote port: ",$self->port,"\n";
}
#----------------------------------------------------------------- ClientConnection::openSocket
#help: openSocket(void) opens socket connection for a Client.
sub openSocket{
  my $self = shift;
  my ($host,$port,$iaddr,$paddr,$proto);
  $host = $self->host; 
  $port = $self->port;
  my $tryagain = 0; my $attempts = 0; my $maxAttempts = 20;

  if ($port =~ /\D/) {$port = getservbyname($port, 'tcp') }
  die "No port" unless $port;
  $iaddr  = inet_aton($host)               or warn "no host: $host";
  $paddr  = sockaddr_in($port,$iaddr)      or warn "no paddr: $paddr";
  $proto  = getprotobyname('tcp');

  if (socket(SOCK, PF_INET, SOCK_STREAM, $proto)) { 
    connect(SOCK,$paddr)                       or $tryagain=1;
  } else { 
    $tryagain = 1;
  }
TRY:
  while ($tryagain && $attempts++<$maxAttempts){
    $tryagain =0;
    my $rnd = int(rand(3e4)*$attempts);
    my $i = 0;
    for ($i=0;$i<$rnd;$i++) {;}          # cheesy delay
    $iaddr  = inet_aton($host)               or warn "no host: $host";
    $paddr  = sockaddr_in($port,$iaddr)      or warn "no paddr: $paddr";
    $proto  = getprotobyname('tcp');

     socket(SOCK, PF_INET, SOCK_STREAM, $proto) or next TRY; 
     connect(SOCK,$paddr) or $tryagain=1;
  }  
#  print "$attempts attempts\n";
  if ($attempts >= $maxAttempts) { die "openSocket: $!\n"; }
  $self->sock(\*SOCK);
}
#-------------------------------------------------------------------- ClientConnection::setHost
#help: setHost(host) sets host to host
sub setHost{
  my $self = shift;
  my ($arg) = @_;
  my @hp = split /:/,$arg;
  $self->host($hp[0]);
  if ($hp[1]>0) {
    $self->port($hp[1]);
  }
}
\\__END__OF__ClientConnection.pm__FILE\\
chmod 664 ClientConnection.pm
echo unsharking Connection.pm
cat > Connection.pm << '\\__END__OF__Connection.pm__FILE\\'
#! /usr/local/bin/perl -w

package Connection;
#
#               Connection.pm
#
#       INHERITS FROM:  object
#       CONTAINS:  None
#
#	This package handles all of the communication for sending/receiving
#	ints and strings from a TCP/IP connection.  
#       It is inherited by the ServerConnection and the ClientConnection classes.
#

require 5.002;
require object;

use Socket;
use Carp;

@ISA = qw( object );

my %fields = (
  port => undef,
  sock => undef,
);

#-------------------------------------------------------------------- Connection::new
sub new{
  my $this = shift;
  my $class = ref($this) || $this;
  my $self = object->new;
  $self->{_permitted} = \%fields;
  bless $self,$class;
  return $self;
}

#-------------------------------------------------------------------- Connection::print
#help: print(void) prints selected information about connection
sub print{
  my $self = shift;
  print "Remote port: ",$self->port,"\n";
}
#----------------------------------------------------------------- Connection::closeSocket
#help: closeSocket(void) closes socket connection
sub closeSocket{
  my $self = shift;
  if (defined($self->sock)){
    close ($self->sock);
  }
}
#----------------------------------------------------------------- Connection::close
#help: close(void) closes socket connection
sub close{
  my $self = shift;
  $self->closeSocket();
}
#----------------------------------------------------------------- Connection::readInt
#help: readInt() reads an int from a remote socket.
sub readInt{
  my $self = shift;
  my $len = 4;
  my $number;
  recv $self->sock,$number,$len,0;
  $number = unpack("N",$number);
#  $self->dbgmess("readInt $number, $len");
  return $number;
}
#----------------------------------------------------------------- Connection::readLine
sub readLine{
  my $self = shift;
  my $String="";
  my $char="";
  while ($char ne "\n") {
    recv $self->sock,$char,1,0;
    $String = join "",$String,$char;
  }
#  $self->dbgmess("readLine $String");
  return $String;
}
#----------------------------------------------------------------- Connection::readString
#help: readString(lengthtoread) reads a string of specified length from internet
sub readString{
  my $self = shift;
  my ($lentoRead) = @_;
  if ($lentoRead == 0) {return "";}
  my $String="";
  recv $self->sock,$String,$lentoRead,0;
  if ($String<0) {die "Error reading from socket \n"};
#  $self->dbgmess("readString String is $String, length $lentoRead");
  return $String;
}
#----------------------------------------------------------------- Connection::sendInt
#help: sendInt() send an int to a remote socket.
sub sendInt{
  my $self = shift;
  my ($number) = @_;
  my $tosend = pack ("N","$number");
  my $bytessent = send $self->sock,$tosend,0;
#  $self->dbgmess("sendInt $number");
  return $bytessent;
}
#----------------------------------------------------------------- Connection::sendString
#help: sendString(string) sends given string over net
sub sendString{
  my $self = shift;
  my ($String) = @_;
  if (length($String) == 0) { return 0;}
  my $bytessent = send $self->sock,$String,0;
  if ($bytessent<0) {die "Error sending $String to socket \n"};
#  $self->dbgmess("sendString $String");
  return $bytessent;
}
#-------------------------------------------------------------------- Connection::setPort
#help: setPort(port) sets port
sub setPort{
  my $self = shift;
  my ($port) = @_;
  $self->port($port);
}
\\__END__OF__Connection.pm__FILE\\
chmod 664 Connection.pm
echo unsharking Control.pm
cat > Control.pm << '\\__END__OF__Control.pm__FILE\\'
#! /usr/local/bin/perl5.003

package Control;
#
#               Control.pm
#
#       INHERITS FROM:  Digital    
#       CONTAINS:  None        
#
#	This package contains routines for initializing a control register and
#	for translating the user's command into the appropriate hex code for
#	the CSR.
#

require Digital;
@ISA = qw( Digital );

my %group = ();
my %groupSize = ();
my @name = [];
my %fields = (
  group     => \%group,
  groupSize => \%groupSize,
  name      => \@name,
  data      => undef,
  address   => undef,
  size      => undef,
  ngroups   => undef,
  filename  => undef,
);

#----------------------------------------------------------------- Control::new
sub new{    # arguments: Address of command, name1,name2,name3....
  my $this = shift;
  my $class = ref($this) || $this;
  my $self = {};
  $self->{_permitted} = \%fields;
  bless $self,$class;

  $self->setAddress($_[0]);
  if ($#_ > 16) { print "Too many initial values in new Control\n"; }
  for ($i=1;$i<=$#_;$i++){
    $self->{name}->[$i-1] = $_[$i];
    $self->{group}->{$_[$i]} = 0;
    $self->{groupSize}->{$_[$i]} = 1;
  } 
  $self->size($#_);
  $self->ngroups($#_);
  return $self; 
}
#---------------------------------------------------------------- Control::setGroup
sub setGroup{
  my $self  = shift;
  my ($groupname,$val) = @_;
  if (!defined ($self->{group}->{$groupname})){print "No group $groupname\n";return;}
  my $mxbits = $self->{groupSize}->{$groupname};
  if ($val >= 1<<$mxbits) 
    {warn "ERROR $val needs too many bits for for $groupname (max: $mxbits bits)\n"; 
     warn "No action taken\n";
    return;}
  $self->{group}->{$groupname} = $val;
}
#---------------------------------------------------------------- Control::setAllGroupSize
sub setAllGroupSize{
  my $self  = shift;
  my ($val) = @_;
  my $i=0;

#  loop over groups, set the names to $groupname
  for ($i=0;$i<$self->ngroups;$i++){
    my $newsize = $self->size + $val-1;
    my $groupname = $self->{name}->[$i];
    $self->{groupSize}->{$groupname} = $val;
    $self->setControlSize($newsize);
  }
}
#---------------------------------------------------------------- Control::setGroupSize
sub setGroupSize{
  my $self  = shift;
  my ($groupname,$val) = @_;
  if (!defined ($self->{group}->{$groupname})){print "No group $groupname\n";return;}
  my $newsize = $self->size + $val-1;
  $self->{groupSize}->{$groupname} = $val;
  $self->setControlSize($newsize);
}
#---------------------------------------------------------------- Control::setControlSize
sub setControlSize{
  my $self = shift;
  my ($sz) = @_;
  if ($sz > 16) {warn "Warning: more than 16 bits ($sz) in Control";}
  $self->size($sz);
} 
#---------------------------------------------------------------- Control::dataWord
sub dataWord{              # turn the bits into a data word.
  my $self  = shift;
  my $word  = 0;
  my $val,$name;
  for ($ngroup=($self->ngroups)-1;$ngroup>=0;$ngroup--){
    $name = $self->getName($ngroup);
    $val = $self->{group}->{$name};
    $word = ($word << $self->{groupSize}->{$name}) | $val;
  }
  return (sprintf "%04x",$word);
}
#------------------------------------------------------------ Control::setData
sub setData{              # set the bits.
  my $self  = shift;
  my ($word) = @_;
  $word =~ s/ //;
  my $val,$name;
  $word = hex $word;
  my $beginning = 0,$mask;
  for ($ngroup=0; $ngroup<$self->ngroups; $ngroup++){
    $mask = 0;
    $name = $self->getName($ngroup);
    for ($nbit = 0; $nbit<$self->{groupSize}->{$name};$nbit++){
      $mask = $mask | (1<< $nbit);
    } 
    $mask = $mask << $beginning; 
    $val = ($word & $mask) >> $beginning;
    $self->setGroup($name,$val);
    $beginning += ($self->{groupSize}->{$name});
  }
} 
#------------------------------------------------------------ Control::print
sub print{
  my $self = shift;
  print "Address : ",$self->address,"\n";
  print " id,     name, value, capacity(bits)\n";
  for ($i=0;$i<$self->ngroups;$i++){
    my $name = $self->{name}->[$i];
    my $group  = $self->{group}->{$name};
    my $gsz    = $self->{groupSize}->{$name};
    printf "%2d %10s %4d %8d\n",$i,$name,$group,$gsz;
  }
  print "Data Word ",$self->dataWord,"\n";
  my $sz     = $self->size;
  print "Control Size $sz\n";
}
#------------------------------------------------------------ Control::getName
sub getName{
  my $self  = shift;
  my ($ngroup)= @_;
  return ($self->{name}->[$ngroup]);
}
\\__END__OF__Control.pm__FILE\\
chmod 664 Control.pm
echo unsharking DAC.pm
cat > DAC.pm << '\\__END__OF__DAC.pm__FILE\\'
#! /usr/local/bin/perl5.003

package DAC;
#
#               DAC.pm
#
#       INHERITS FROM:  Digital    
#       CONTAINS:  None        
#
#	This package contains routines for initializing a DAC and for translating
#	the user's command into the appropriate hex codes for the DAC.
#

require Digital;
@ISA = qw( Digital );

my %fields = (
  address   => undef,
  bits      => undef,
  dataWord  => undef,
  min       => undef,
  max1      => undef,
  max       => undef,
  value     => undef,
  filename  => undef,
);

#-------------------------------------------------------------------- DAC::new
sub new{    # arguments: Address of command, size (in bits), min, max.
  my $this = shift;
  my $class = ref($this) || $this;
  my $self = Digital->new;
  $self->{_permitted} = \%fields;
  bless $self,$class;

#  print "In DAC new...class is $class\n";
  $self->address($_[0]);
  $self->value("undef");
  $self->bits($_[1]);
  $self->min($_[2]);
  $self->max1($_[3]);
  my $tmp = ($self->max1)-((($self->max1)-($self->min))/((2**$self->bits)-1));
  $self->max($tmp);
  return $self; 
}
#----------------------------------------------------------- DAC::setData
sub setData{                   #help: setData(dataWord) set the bits in the DataWord.
  my $self = shift;
  my ($val) = @_;
  if ($val>2**$self->bits-1){ print "ERROR: DAC value $val exceeds max (",
                              $self->bits," bits)\n";return;}
  if ($val<0)        { print "ERROR: illegal DAC bit setting. \n";return;}
  $self->dataWord($val);
  $self->decode;
}
#-------------------------------------------------------------- DAC::decode
sub decode{                     #help: decode(bits) transform bit pattern to value.
  my $self = shift;
  my $val  = $self->dataWord;
  $val =~ s/ //g;
  $val = hex ($val);
  if ($val>(2**$self->bits-1)){ print "ERROR, $val > Maximum of DAC ($max)"; return;} 
  my $ratio = $val/(2**$self->bits-1);
  $self->value($self->min+$ratio*($self->max-$self->min)); 
#  my $string = sprintf "value is %f, bits %s val %d ratio %f",$self->value,$self->dataWord,$val,$ratio;
#  $self->dbgmess($string);
}
#-------------------------------------------------------------- DAC::setValue
sub setValue{                   #help: setValue(val) transform value to bits.
  my $self = shift;
  my ($val) = @_;
  my $max1 = $self->max1;
  my $max = $self->max;
  my $min = $self->min;
  if ($val>$max1){ 
      print "ERROR, $val > Maximum output of DAC ($max)\n"; 
      return;
  }
  if ($val<$min){ 
      print "ERROR, $val < Minimum output of DAC ($min)\n"; 
      return;
  }
  if ($val>$max) {
      print "Setting to max of DAC, $max\n";
      $val = $max;
  }
  $self->value($val);
  my $range = (2**$self->bits)-1;
  my $dval = $range*($val-$min)/($max-$min);
  $self->dataWord(sprintf "%4x",$dval);
  $hval = $self->dataWord;
#  print "dac = $val, or $hval\n";
} 
#---------------------------------------------------------------- DAC::print
sub print{
  my $self = shift;
  print "Address : ",$self->address,"\n";
  print "Bits    : ",$self->bits,"\n";
  print "Data    : ",$self->dataWord,"\n";
  print "Value   : ",$self->value,"\n";
  print "Min     : ",$self->min,"\n";
  print "Max     : ",$self->max,"\n";
}
\\__END__OF__DAC.pm__FILE\\
chmod 664 DAC.pm
echo unsharking Digital.pm
cat > Digital.pm << '\\__END__OF__Digital.pm__FILE\\'
#! /usr/local/bin/perl5.003

package Digital;
#
#               Digital.pm
#
#       INHERITS FROM:  object
#       CONTAINS:  None
#
#	Contains routines common to all digital objects on an electronic 
#	card.  All of these routines handle the persistence mechanism for 
#	each digitol object.
#

require 5.002;
require object;

@ISA = qw( object );

my %fields = (
  filename => undef,
);

#-------------------------------------------------------------- Digital::new
sub new{    # 
  my $this = shift;
  my $class = ref($this) || $this;
  my $self = object->new;
  $self->{_permitted} = \%fields;
  bless $self,$class;

#  print "in new Digital...$class is $class\n";
  return $self; 
}
#--------------------------------------------------------- Digital::setAddress
sub setAddress{
  my $self = shift;
  my ($val) = @_;
  $self->address($val);
}
#------------------------------------------------------- Digital::setFilename
sub setFilename{   #help: setFilename(filename) sets filename for storing Digital object.
  my $self = shift;
  if ($#_ > -1) {
    my ($filename) = @_;
    $self->filename($filename);
  }
}
#------------------------------------------------------- Digital::fromFile
sub fromFile{   #help: fromFile(filename) read settings of card from file
  my $self = shift;
  $self->setFilename(@_);
  my $hexval=0,$mask=0xff;
  my $filename = $self->filename;
  open (FILE,"<$filename") || return;
  my $dispose = <FILE>;
  while (<FILE>) {
    @Fld = split(' ',$_,9999);
    $hexval = hex $Fld[1];
    if (($hexval & $mask) == $self->address){
#     print "Address read is $Fld[1], which is ",$self->address,"\n";
      $self->setData($Fld[2]);
      return;
    }
  }
}
#------------------------------------------------------------ Digital::toFile
sub toFile{   #help: toFile(file,subrack,slot) save Control settings to a file
  my $self = shift;
  my ($filename,$subrack,$slot,$class) = @_;
  my $eol = $\;
  $\ = "";
  open (FILE,">>$filename") || warn "Can't write to $filename\n";
  my $hexline = sprintf "\n%04x %02x%02x %s %04x",
    $subrack,$slot,$self->address,$self->dataWord,0;
  print FILE "$hexline % $class";
  close FILE;
  $\ = $eol;
}

\\__END__OF__Digital.pm__FILE\\
chmod 664 Digital.pm
echo unsharking ElecModule.pm
cat > ElecModule.pm << '\\__END__OF__ElecModule.pm__FILE\\'
#! /usr/local/bin/perl

package ElecModule;
#
#		ElecModule.pm
#
#	INHERITS FROM:  object
#	CONTAINS:  Savescript, GPIBbox
#
#	ElecModule contains routines common to all electronics cards.  These fall
#	into four general categories:  routines for sending messages to (and
#	receiving messages from) the GPIB box, commands for saving scripts and
#	for enabling or disabling communications with the server, routines
#	for retrieving basic information from the card (such as the module type
#	and serial number), and routines for card persistence).
#

require 5.002;
require object;

use GPIBbox;
use Savescript;

@ISA = qw ( object );

my %fields = (
	      box        => undef,
	      module     => undef,
	      address    => undef,
	      data       => undef,
	      outfile    => undef,
	      jumpers    => undef,
	      Controls   => {},
	      DACs       => {},
	      filename   => undef,
	      scriptonly => undef,
	      class      => undef,
	      Accumulate => undef,
	      );
#
#
#------------------------------------------------------------ElecModule::new
sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my $self = object->new;
    $self->{_permitted} = \%fields;
    bless $self,$class;

    my @Fld = @_;
    split @Fld;
    $self->box(new GPIBbox($Fld[0]));
    $self->module($Fld[1]);
    $self->scriptonly($Fld[2]);

    return $self;
}
#
#          Routines for sending messages to GPIB box
#
#------------------------------------------------------------ElecModule::setAddress
sub setAddress {
    my $self = shift;
    my ($value) = @_;
    # bitwise or the module with bits 8-12, and the value at bits 0-3
    my $Val = sprintf "%4x",$self->module() << 8 | $value;
    $self->address($Val);
}
#------------------------------------------------------------ElecModule::writeControl
sub writeControl {
    my $self = shift;
    my ($control) = $_[0];
    my $comment = $_[1];
    $self->setAddress($control->address);
    $self->data($control->dataWord());
    $self->toBox($comment);
}
#------------------------------------------------------------ElecModule::toBox
sub toBox {
    my $self = shift;
    my $comment = $_[0];
    my $subrack = $self->box->subrack;
    my $address = $self->address;
    my $data = $self->data;
    print "Address: ",$self->address," Data: ",$self->data,"\n";
    print "$comment\n";
    if (defined($self->outfile)) {
        print "adding line to ",$self->outfile->filename,"\n";
	$self->outfile->AddLine($subrack,$address,$data,0,$comment);
    }
    $self->toFile($self->filename);
    if ($self->scriptonly != 1) {
	if ($self->Accumulate eq "accumulate") {
	    $self->box->GPIBconn->addAddress($self->box->current,$address,
					     $subrack);
	    $self->box->GPIBconn->addData($self->box->current,$data,
					  $subrack);
	} else {
	    $self->box->writeAddress($self->address);
	    $self->box->writeData($self->data);
	}
    } 
}
#------------------------------------------------------------ElecModule::readControl
sub readControl {
    my $self = shift;
    my $control = $_[0];
    my $comment = $_[1];
    $self->setAddress($control->address);
    return ($self->fromBox($comment));
}
#------------------------------------------------------------ElecModule::fromBox
sub fromBox {
    my $self = shift;
    my $comment = $_[0];
    my $dataWord = undef;
    if ($self->scriptonly != 1) {
	print "Reading data now\n";
	$dataWord = ($self->box->readData($self->address));
	print "$dataWord\n";
    }
    my $pattern = sprintf "%4x",$dataWord;
    $self->data($pattern);
    $self->toFile($self->filename);
    print "Address: ",$self->address," Read Data: ",$pattern,"\n";
    print "$comment\n";
    if (defined($self->outfile)) {
	$subrack = $self->box->subrack;
	$address = $self->address;
	$data = $self->data;
	$self->outfile->AddLine($subrack,$address,$data,1,$comment);
    }
    return $pattern;
}
#------------------------------------------------------------ElecModule::accumulate
#help: accumulate(void) holds off sending commands to GPIB box until an execute command is given
sub accumulate {
    my $self = shift;
    $self->Accumulate("accumulate");
    my $class = $self->class;
    my $subrack = $self->box->subrack;
    my $module = $self->module;
    $self->filename("/tmp/accum-$class-$subrack-$module.out");
    $self->toFile($self->filename);
}
#------------------------------------------------------------ElecModule::unaccumulate
#help: unaccumulate(void) turns off accumulation feature
sub unaccumulate {
    my $self = shift;
    $self->Accumulate(undef);
    my $class = $self->class;
    my $subrack = $self->box->subrack;
    my $module = $self->module;
    my $host = $self->box->host;
    $self->filename("/tmp/$host-$class-$subrack-$module.out");
    $self->fromFile($self->filename);
}
#------------------------------------------------------------ElecModule::execute
#help: execute(void) executes all stored up commands for GPIB box
sub execute {
    my $self = shift;
    $self->box->GPIBconn->execute();
    my $class = $self->class;
    my $subrack = $self->box->subrack;
    my $module = $self->module;
    my $host = $self->box->host;
    $self->toFile("/tmp/$host-$class-$subrack-$module.out");
}
#
#           Script saving section
#
#------------------------------------------------------------ElecModule::saveScript
#help: saveScript("filename",#)  Saves hex output to filename.
sub saveScript {
    my $self = shift;
    my $savefile = $_[0];
    my $answer = $_[1];
    my $class = $self->class;
    $self->outfile( new Savescript($savefile));
    $self->outfile->openFile($answer,$class);
}
#------------------------------------------------------------ElecModule::endScript 
#help: endScript() Ends save to script.
sub endScript {
    my $self = shift;
    $self->outfile->CloseFile();
}
#------------------------------------------------------------ElecModule::enableBox
#help: enableBox(value) unless input value is 400, enables output to GPIBbox
sub enableBox {
    my $self = shift;
    my $scriptonly = $_[0];
    my $host = $self->box->host;
    my $class = $self->class;
    my $subrack = $self->box->subrack;
    my $module = $self->module;
    my $filename = undef;
    if ($scriptonly == 400) {
	$scriptonly = 1;
	$self->scriptonly($scriptonly);
	$host = "script";
	$self->filename("/tmp/$host-$class-$subrack-$module.out");
	$self->fromFile($self->filename);
    } else {
	$scriptonly = undef;
	$self->scriptonly($scriptonly);
	$self->filename("/tmp/$host-$class-$subrack-$module.out");
	$self->fromFile($self->filename);
    }
}
#------------------------------------------------------------ElecModule::disableBox
#help disableBox() disables output to GPIBbox
sub disableBox {
    my $self = shift;
    $self->enableBox(400);
}
#
#          Card information section - routines to display info about
#          current card.
#
#------------------------------------------------------------ElecModule::serial
sub readser {
    my $self = shift;
    $self->setAddress(0);
    $self->jumpers($self->box->readData($self->address));
}
#------------------------------------------------------------ElecModule::card
sub card {
    my $self = shift;
    $self->readser;
    my $card = $self->jumpers >> 12;
    $card = $card & 0xF;
    print "Card: $card   ";
    if ($card == 1) {
	print "(BLIP card)\n";
    } elsif ($card == 2) {
	print "(RTF card)\n";
    } elsif ($card == 3) {
	print "(Monitor card)\n";
    } else {
	print "(Unknown card type)\n";
    }
    return $card;
}
#------------------------------------------------------------ElecModule::version
sub version {
    my $self = shift;
    $self->readser;
    my $ver = $self->jumpers >> 8;
    $ver = $ver & 0xF;
    print "Version:  $ver\n";
    return $ver;
}
#------------------------------------------------------------ElecModule::serial
sub serial {
    my $self = shift;
    $self->readser;
    my $ser = $self->jumpers;
    $ser = $ser & 0x00FF;
    print "Serial number:  $ser\n";
    return $ser;
}
#------------------------------------------------------------ElecModule::cardinfo
#help cardinfo returns card type, version number, and serial number of card
sub cardinfo {
    my $self = shift;
    $self->card;
    $self->version;
    $self->serial;
}
#------------------------------------------------------------ElecModule::print
#help: print(void) prints information about calling card
sub print {
    my $self = shift;
    my $valref = undef;
    my %controls = %{$self->Controls};
    my %dacs = %{$self->DACs};
    $self->fromFile($self->filename);
    $self->box->print;
    print ">> Module:      ",$self->module(),"\n";
    print ">> Address: 0x",$self->address(),"\n";
    print ">> Data:    0x",$self->data(),"\n";
    foreach $key (sort keys %controls) {
	print ">> $key Control\n"; $controls{$key}->print;
    }
    print "\nDACs:\n\n";
    foreach $key (sort keys %dacs) {
	print ">> $key DAC \n"; $dacs{$key}->print;
    }
}
#------------------------------------------------------------ElecModule::cardtype
#help: cardtype(void) returns card type from class variable
sub cardtype {
    my $self = shift;
    $class = $self->class;
    print "Card is of type $class\n";
}
#
#       Persistence and resets.  Note that init is placed in each card section
#       because it requires specific values.
#
#------------------------------------------------------------ElecModule::powerUp
#help: powerUp resets registers to what they were before the last power switch
sub powerup {
    my $self = shift;
    $self->powerUp(@_);
}
sub powerUp {
    my $self = shift;
    $self->fromFile($self->filename);
    my %controls = %{$self->Controls};
    my %dacs = %{$self->DACs};
    my $class = $self->class;
    my $comment = "$class";
    $self->fromFile($self->filename);
    foreach $key (sort keys %controls) {
	$self->writeControl($controls{$key},$class);
    }
    foreach $key (sort keys %dacs) {
	$self->writeControl($dacs{$key},$class);
    }
}
#------------------------------------------------------------ElecModule::toFile
#help: toFile(filename) save settings of card to filename
sub toFile {
    my $self = shift;
    my ($filename) = $_[0];
    my $module = $self->module();
    my $subrack = $self->box->subrack;
    my $class = $self->class;
    $class =~ s/card//;
    my %controls = %{$self->Controls};
    my %dacs = %{$self->DACs};
    unlink("$filename");   # this should remove the file.
    if (-e "$filename") {
      die "$filename still exists \n";
    }
    foreach $key (sort keys %controls) {
	$controls{$key}->toFile($filename,$subrack,$module,$class);
    }
    foreach $key (sort keys %dacs) {
	$dacs{$key}->toFile($filename,$subrack,$module,$class);
    }
    chmod(0666,"$filename");
}
#------------------------------------------------------------ElecModule::fromFile
#help: fromFile(filename) read settings of card from file
sub fromFile {
    my $self = shift;
    my $filename;
    if ($#_<0) {
	$filename = $self->filename;
    } else {
	$filename = $_[0];
    }
    my %controls = %{$self->Controls};
    my %dacs = %{$self->DACs};
    foreach $key (sort keys %controls) {
	$controls{$key}->fromFile($filename);
    }
    foreach $key (sort keys %dacs) {
	$dacs{$key}->fromFile($filename);
    }
}
#------------------------------------------------------------ElecModule::updateFile
#help: updateFile(filename) read settings of card from card and update persistence file accordingly
sub updateFile {
    my $self = shift;
    my $filename;
    if ($#_<0) {
	$filename = $self->filename;
    } else {
	$filename = $_[0];
    }
    my %controls = %{$self->Controls};
    my %dacs = %{$self->DACs};
    foreach $key (sort keys %controls) {
	my $bits = $self->readControl($controls{$key});
	$controls{$key}->setData($bits);
    }
    foreach $key (sort keys %dacs) {
	my $bits = $self->readControl($dacs{$key});
	if ($bits == "ffff") {
	    $bits = "800";
	}
	$dacs{$key}->setData($bits);
    }
    $self->toFile($filename);
}


    


\\__END__OF__ElecModule.pm__FILE\\
chmod 664 ElecModule.pm
echo unsharking FLIP3UDriver.pm
cat > FLIP3UDriver.pm << '\\__END__OF__FLIP3UDriver.pm__FILE\\'
#! /usr/local/bin/perl 

package FLIP3UDriver; 
#
#		FLIP3UDriver.pm
#
#	INHERITS FROM:  ElecModule
#	CONTAINS:  Control, DAC
#
#	Contains commands fro setting and reading back the digital DACs and
#	controls on the FLIP3U Driver card.
#

require 5.002;
require ElecModule;

use GPIBbox;
use Control;
use DAC; 

@ISA = qw( ElecModule );

my @offset = [];
my %fields = ( 
  box             => undef,
  module          => undef,
  data            => undef,
  address         => undef,
  gains1          => undef,
  gains2          => undef,
  offset          => \@offset,
  Controls        => {},
  DACs            => {},
  scriptonly      => undef,
  filename        => undef,
  outfile         => undef,
  class           => undef,
  Accumulate      => undef,
);
#
#                             Basic Functions
#
#--------------------------------------------------------------- FLIP3UDriver::new
sub new{
  my $this = shift;
  my $class = ref($this) || $this;
  my $self = ElecModule->new($_[0],$_[1],$_[2]);
  $self->{_permitted} = \%fields;
  bless $self,$class;

  $self->class("FLIP3UDriver");

  $self->gains1(new Control(3,"ch0","","ch1","","ch2","","p0","p1","p2"));
  $self->gains1->setGroupSize("ch0",3);
  $self->gains1->setGroupSize("ch1",3);
  $self->gains1->setGroupSize("ch2",3);
  $self->gains2(new Control(7,"ch3","","ch4","","ch5","","p3","p4","p5","reset"));
  $self->gains2->setGroupSize("ch3",3);
  $self->gains2->setGroupSize("ch4",3);
  $self->gains2->setGroupSize("ch5",3);

  my $i=0;
  for ($i=0;$i<6;$i++){                        # setup the 6 DAC's
    my $j=$i;
    if ($j>=3) { $j++;}
    $self->{offset}->[$i] = new DAC($j,12,-5,5);
  }

  $self->{Controls}->{Gains1}    = $self->gains1;
  $self->{Controls}->{Gains2}    = $self->gains2;
  $self->{DACs}->{Offset0}       = $self->{offset}->[0];
  $self->{DACs}->{Offset1}       = $self->{offset}->[1];
  $self->{DACs}->{Offset2}       = $self->{offset}->[2];
  $self->{DACs}->{Offset3}       = $self->{offset}->[3];
  $self->{DACs}->{Offset4}       = $self->{offset}->[4];
  $self->{DACs}->{Offset5}       = $self->{offset}->[5];
 
  my $host = $self->box->host;

 if (($self->scriptonly) == 1) {
      $host = "script";
  }
 
  my $module = $self->module;
  my $subrack = $self->box->subrack;

  $self->filename("/tmp/$host-$class-$subrack-$module.out");
  $self->fromFile($self->filename);

  return $self;
}
#--------------------------------------------------------------- FLIP3UDriver::init
#help: init(void) returns computer memory to power up state of card
sub init {
    my $self = shift;
    $self->gains1->setData("0");
    $self->gains2->setData("0");
    my $i = 0;
    for ($i=0;$i<6;$i++) {
	$self->{offset}->[$i]->setValue(0);
    }
}
#--------------------------------------------------------------- FLIP3UDriver::readCard
#help: readCard  Reads the offsets and Gains from the card, and updates variables.
sub readCard {
  my $self = shift;
  my $channel=0;
  for ($channel=0;$channel<6;$channel++){
    $self->readOffset($channel);
  }
  $self->readGains;
}
#--------------------------------------------------------------- FLIP3UDriver::getOffset
#help: getOffset(channel)  Returns the offset DAC on channel.
sub getOffset {
  my $self = shift;
  my ($channel) = @_;
  if (($channel>5) || ($channel <0)) { 
      print "No such DAC\n" ;
      return; 
  }
  my $val = $self->{offset}->[$channel]->value;
  print "FLIP3UDriver Offset$channel is  set to $val\n";
}
#--------------------------------------------------------------- FLIP3UDriver::readOffset
#help: readOffset(channel)  Reads the offset DAC on channel and updates variable.
sub readOffset {
  my $self = shift;
  my ($channel) = @_;
  unless (defined($channel)) {
      for ($i=0;$i<6;$i++) {
	  $self->readOffset($i);
      }
      return;
  }
  if (($channel>5) || ($channel <0)) { 
      print "No such DAC\n" ;
      return; 
  }
  my $comment = "FLIP3UDriver Read Offset$channel";
  my $bits = $self->readControl($self->{offset}->[$channel],$comment);
  if ($bits == "ffff") {
      $bits = "800";
  }
  $self->{offset}->[$channel]->setData($bits);
}
#--------------------------------------------------------------- FLIP3UDriver::setOffset
#help: setOffset(channel,value)  Sets the offset DAC on channel to value.
sub setOffset {
  my $self = shift;
  my $channel = undef;
  my $val = undef;
  if ($#_ == 1) {
      ($channel,$val) = @_;
  } elsif ($#_ == 0) {
      $val = $_[0];
      for ($i=0;$i<6;$i++) {
	  $self->setOffset($i,$val);
      }
      return;
  }
  my $comment = "FLIP3UDriver Offset$channel to $val";
  if (($channel > 5) || ($channel < 0)) { 
      print "No such DAC\n";
      return; 
  }
  $self->{offset}->[$channel]->setValue($val);
  $self->writeControl($self->{offset}->[$channel],$comment);
}
#--------------------------------------------------------------- FLIP3UDriver::gainIndex
# #  help: gainIndex(channel,index)  set gain on channel to index 0-7
sub gainIndex {
  my $self = shift;
  my $channel = undef;
  my $index = undef;
  if ($#_ == 1) {
      ($channel,$index) = @_;
  } elsif ($#_ == 0) {
      $index = $_[0];
      for ($i=0;$i<6;$i++) {
	  $self->gainIndex($i,$index);
      }
      return;
  }
  my @gains = ( 1,1.43,2,5,10,14.3,20,50);
  my $comment = "FLIP3UDriver gain on ch$channel to $gains[$index], index $index";
  if ($channel<3) {
    $self->gains1->setGroup("ch$channel",$index);
    $self->writeControl($self->gains1,$comment);
  } 
  elsif ($channel<6) {
    $self->gains2->setGroup("ch$channel",$index);
    $self->writeControl($self->gains2,$comment);
  }
  else {
      return;
  }
}
#--------------------------------------------------------------- FLIP3UDriver::polarity
# #  help: polarity(channel,value)  set polarity on channel to pos or neg
sub polarity {
  my $self = shift;
  my $channel = undef;
  my $val = undef;
  if ($#_ == 1) {
      ($channel,$val) = @_;
  } elsif ($#_ == 0) {
      $val = $_[0];
      for ($i=0;$i<6;$i++) {
	  $self->polarity($i,$val);
      }
      return;
  }
  my $comment = "FLIP3UDriver Polarity ch$channel to $val";
  if ($val>0) {
      $val=1;
  } else {
      $val=0;
  }
  if ($channel<3) {
    $self->gains1->setGroup("p$channel",$val);
    $self->writeControl($self->gains1,$comment);
  } elsif ($channel<6){
    $self->gains2->setGroup("p$channel",$val);
    $self->writeControl($self->gains2,$comment);
  } 
}
#--------------------------------------------------------------- FLIP3UDriver::reset
#help: reset  reset module
sub reset {
  my $self = shift;
  my $comment = "FLIP3UDriver reset card";
  $self->gains2->setGroup("reset",1);
  $self->writeControl($self->gains2,$comment);
  $self->init;
  $self->setGain(1);
}
#--------------------------------------------------------------- FLIP3UDriver::readGains
#help: readGains reads the gains from the card (using the readback feature).
sub readGains {
  my $self=shift;
  my $comment = "FLIP3UDriver read Gains1";
  my $bits1 = $self->readControl($self->gains1,$comment);
  $comment = "FLIP3UDriver read Gains2";
  my $bits2 = $self->readControl($self->gains2,$comment);
  $self->gains1->setData($bits1);
  $self->gains2->setData($bits2);
}
#--------------------------------------------------------------- FLIP3UDriver::setGain
#help: setGain(channel,gain)  set channel to the nearest gain possible to gain.t Gain can be positive or negative.
sub setGain {
  my $self=shift;
  my $channel = undef;
  my $gain = undef;
  if ($#_ == 1) {
      ($channel,$gain) = @_;
  } elsif ($#_ == 0) {
      $gain = $_[0];
      for ($i=0;$i<6;$i++) {
	  $self->setGain($i,$gain);
      }
      return;
  }
  my $i=0;
  my $newGain=0;
  my @gainValues = ( 1,1.43,2,5,10,14.3,20,50);
#  $self->readGains;       # first set the variables to what the card says.
  for ($i=0;$i<=$#gainValues;$i++){
    if (abs($gain)>=$gainValues[$i]) {
      $newIndex = $i; 
    }
  }
  $self->gainIndex($channel,$newIndex);
  if ($gain<0) {
    $self->polarity($channel,1);
  } else {
    $self->polarity($channel,0);
  }
}





\\__END__OF__FLIP3UDriver.pm__FILE\\
chmod 664 FLIP3UDriver.pm
echo unsharking FLIP3UQBias.pm
cat > FLIP3UQBias.pm << '\\__END__OF__FLIP3UQBias.pm__FILE\\'
#! /usr/local/bin/perl 

package FLIP3UQBias; 
#
#		FLIP3UQBias.pm
#
#	INHERITS FROM:  ElecModule
#	CONTAINS:  Control, DAC
#
#	Contains commands for setting and reading back the digital controls
#	and DACs on the FLIP3U QBias card.
#

require 5.002;
require object;
require ElecModule;

use Control;
use DAC; 

@ISA = qw( ElecModule );

my %fields = ( 
  box             => undef,
  module          => undef,
  data            => undef,
  address         => undef,
  firstLED        => undef,
  secondLED       => undef,
  bias            => undef,
  Qibias          => undef,
  Qobias          => undef,
  LED1bias        => undef,
  LED2bias        => undef,
  filename        => undef,
  outfile         => undef,
  Controls        => {},
  DACs            => {},
  jumpers         => undef,
  scriptonly      => undef,
  class           => undef,
  Accumulate      => undef,
);
#
#                             Basic Functions
#
#--------------------------------------------------------------- FLIP3UQBias::new
sub new{
  my $this = shift;
  my $class = ref($this) || $this;
  my $self = ElecModule->new($_[0],$_[1],$_[2]);
  $self->{_permitted} = \%fields;
  bless $self,$class;

  $self->class("FLIP3UQBias");

  $self->firstLED(new Control(4,"LED1on","LED1cont","LED1rep","LED1long",
			      "LED2on","LED2cont","LED2rep","LED2long",
			      "Vignd","Vognd","","","LED1fire",
			      "LED2fire","","reset"));
  $self->secondLED(new Control(5,"LED1width","LED1rate",
			       "LED2width","LED2rate"));
  $self->secondLED->setAllGroupSize(4);

  $self->Qibias(new DAC(0,12,-5,5));
  $self->Qobias(new DAC(1,12,-5,5));
  $self->LED1bias(new DAC(2,12,-5,5));
  $self->LED2bias(new DAC(3,12,-5,5));

  $self->{Controls}->{FirstLED}       = $self->firstLED;
  $self->{Controls}->{SecondLED}      = $self->secondLED;
  $self->{DACs}->{Qibias}             = $self->Qibias;
  $self->{DACs}->{Qobias}             = $self->Qobias;
  $self->{DACs}->{LED1bias}           = $self->LED1bias;
  $self->{DACs}->{LED2bias}           = $self->LED2bias;

  my $host = $self->box->host;

  if (($self->scriptonly) == 1) {
      $host = "script";
  }

  my $subrack = $self->box->subrack;
  my $module = $self->module;

  $self->filename("/tmp/$host-$class-$subrack-$module.out");
  $self->fromFile($self->filename);

  return $self;
}
#--------------------------------------------------------------- FLIP3UQBias::init
#help:  init(void) returns card (and memory) to card's power up states
sub init {
    my $self = shift;
    $self->firstLED->setData("0");
    $self->secondLED->setData("0");
    $self->Qibias->setValue(0);
    $self->Qobias->setValue(0);
    $self->LED1bias->setValue(0);
    $self->LED2bias->setValue(0);
    $self->toFile($self->filename);
}
#                  Write the Control Registers
#
#--------------------------------------------------------------- FLIP3UQBias::LEDOn
#help LEDOn(LEDnumber,value) turns LEDnumber on if value = 1.  LEDnumber = 3 turns both on.  Omitting value turns to on.
sub LEDOn {
    my $self = shift;
    my $number = undef;
    my $val = undef;
    if ($#_ == 1) {
	($number, $val) = @_;
    } elsif ($#_ == 0) {
	$number = $_[0];
	$val = 1;
    } else {
	print "Incorrect number of arguments\n";
	return;
    }
    if ($number == 3) {
	$self->LEDOn(1,$val);
	$self->LEDOn(2,$val);
    }

    if ($val == 1) {
	$val = 1;
	$comment = "FLIP 3UDriver LED $number On";
    } else {
	$val=0;
	$comment = "FLIP 3UDriver LED $number Off";
    }
    if ($number == 1) {
	$self->firstLED->fromFile($self->filename);
	$self->firstLED->setGroup("LED1on",$val);
	$self->writeControl($self->firstLED,$comment);
    } elsif ($number == 2) {
	$self->firstLED->fromFile($self->filename);
	$self->firstLED->setGroup("LED2on",$val);
	$self->writeControl($self->firstLED,$comment);
    }
}    
#--------------------------------------------------------------- FLIP#UQBias::LEDOff
#help: LEDOff(LEDnumber) turn LED number off, defaults to turning both off
sub LEDOff {
    my $self = shift;
    if ($#_ > -1) {
	my $number = $_[0];
	$self->LEDOn($number,0);
    } else {
	$self->LEDOn(3,0);
    }
}
#--------------------------------------------------------- FLIP3UQBias::LEDWidthIndex
sub LEDWidthIndex {
    my $self = shift;
    my $index = undef;
    my $number = undef;
    my $comment = undef;
    my $unit = 100;                           # units for width
    if ($#_ == 0) {
	$index = $_[0];
	$self->LEDWidthIndex(1,$index);
	$self->LEDWidthIndex(2,$index);
	return;
    } elsif ($#_ == 1) {
	($number,$index) = @_;
    } else {
	print "Incorrect number of arguments\n";
	return;
    }
    if ($number == 3) {
	$self->LEDWidthIndex(1,$index);
	$self->LEDWidthIndex(2,$index);
	return;
    }
    $comment = "FLIP3UQBias LED$number width bits to $index";
    $self->secondLED->fromFile($self->filename);
    $self->secondLED->setGroup("LED${number}width",$index);
    $self->writeControl($self->secondLED,$comment);
}
#---------------------------------------------------------- FLIP3UQBias::LEDWidth
#help: LEDWidth(number,width) sets LEDnumber width to closest possible value of width, less than input value.  If number = 3, sets both LEDs to index
sub LEDWidth {
    my $self = shift;
    my $index = undef;
    my $number = width;
    my $unit = undef;                           #units for width
    my $width = undef;
    if ($#_ == 0) {
	$width = $_[0];
	$self->LEDWidth(3,$width);
	return;
    } elsif ($#_ == 1) {
	($number,$width) = @_;
    } else {
	print "Incorrect number of arguments\n";
	return;
    }
    if ($width >= 200) {
	$unit = 200;
	$self->LEDLongPulse($number);
	$index = (int($width/$unit) - 1);
    } else {
	$unit = 5;
	$self->LEDShortPulse($number);
	$index = (int($width/$unit) - 1);
    }
    if ($index > 15) {
	print "Exceeded max index, setting to index 15\n";
	$index = 15;
    } elsif ($index < 0) {
	print "Below min index, setting to index 0\n";
	$index = 0;
    }
    $self->LEDWidthIndex($number,$index);

}
#-----------------------------------------------------------FLIP3UQBias::LEDPeriodIndex
sub LEDPeriodIndex {
    my $self = shift;
    my $rate = undef;
    my $index = undef;
    my $number = undef;
    my $comment = undef;
    my $unit = 100;
    if ($#_ == 0) {
	$index = $_[0];
	$self->LEDPeriodIndex(3,$index);
	return;
    } elsif ($#_ == 1) {
	($number,$index) = @_;
    } else {
	print "Incorrect number of arguments\n";
	return;
    }
    if ($number == 3) {
	$self->LEDPeriodIndex(1,$index);
	$self->LEDPeriodIndex(2,$index);
	return;
    }
    $rate = ($index + 1) * $unit;
    $comment = "FLIP3UQBias LED$number rate to $rate, bits to $index";
    $self->secondLED->fromFile($self->filename);
    $self->secondLED->setGroup("LED${number}rate",$index);
    $self->writeControl($self->secondLED,$comment);
}
#---------------------------------------------------------- FLIP3UQBias::LEDPeriod
#help: LEDPeriod(number,period) sets LEDnumber rate to closest possible period, less than input value.  If number = 3, sets both LEDs to period
sub LEDPeriod {
    my $self = shift;
    my $index = undef;
    my $number = undef;;
    my $unit = 100;                           # units for period
    my $rate = undef;
    if ($#_ == 0) {
	$rate = $_[0];
	$self->LEDPeriod(3,$rate);
	return;
    } elsif ($#_ == 1) {
	($number,$rate) = @_;
    } else {
	print "Incorrect number of arguments\n";
	return;
    }
    $index = (int($rate/$unit) - 1);
    if ($index > 15) {
	print "Max rate is 1600 ms, setting to that\n";
	$index = 15;
    } elsif ($index <0) {
	print "Min rate is 100 ms, setting to that\n";
	$index = 0;
    }
    $self->LEDPeriodIndex($number,$index);

}
#------------------------------------------------------------FLIP3UQBias::gndVI
#help: gndVI(state=1) ground/unground Vi bias (state=1 grounds it)
#help: gndVO(state=1) ground/unground Vo bias (state=1 grounds it)
sub gndVI {   # default true, val = 0, false.
  my $self = shift;
  my $val;
  my $comment = undef;
  $val = 1;
  if ($#_>-1) {
    ($val) = @_;
  }
  if ($val == 1) {
     $comment = "FLIP3UQBias ground Vi bias";
  } else {
     $comment = "FLIP3UQBias unground Vi bias";
  }
  $self->firstLED->fromFile($self->filename);
  $self->firstLED->setGroup("Vignd",$val);
  $self->writeControl($self->firstLED,$comment);
}
#--------------------------------------------------------------- FLIP3UBias::gndVO
sub gndVO {   # default true, val = 0, false.
  my $self = shift;
  my $val;
  my $comment = undef;
  $val = 1;
  if ($#_>-1) {
    ($val) = @_;
  }
  if ($val == 1) {
     $comment = "FLIP 3UDriver ground Vo bias";
  } else {
     $comment = "FLIP 3UDriver unground Vo bias";
  }
  $self->firstLED->fromFile($self->filename);
  $self->firstLED->setGroup("Vognd",$val);
  $self->writeControl($self->firstLED,$comment);
}
#--------------------------------------------------------------- FLIP3UQBias::reset
#help: reset  reset module
sub reset {
  my $self = shift;
  my $comment = "FLIP3UQBias reset card";
  $self->firstLED->setGroup("reset",1);
  $self->writeControl($self->firstLED,$comment);
  $self->init;
}
#--------------------------------------------------------------FLIP3UQBias::LEDShortPulse
#help: LEDShortPulse(number,value) sets LEDnumber to 0 = short, 1 = long.  If number = 3, sets both LEDs to value. If value is omitted, sets to short
sub LEDShortPulse {
    my $self = shift;
    my $val = undef;
    my $number = undef;
    my $comment = undef;
    if ($#_ == 0) {
	($number) = @_;
	$val = 0;
    } elsif ($#_ == 1) {
	($number,$val) = @_;
    } else {
	print "Incorrect number of arguments\n";
	return;
    }
    if ($number == 3) {
	$self->LEDShortPulse(1,$val);
	$self->LEDShortPulse(2,$val);
	return;
    }
    if ($val == 1) {
	$comment = "FLIP3UQBias LED$number long";
    } elsif ($val == 0) {
	$comment = "FLIP3UQBias LED$number short";
    }
    $self->firstLED->fromFile($self->filename);
    $self->firstLED->setGroup("LED${number}long",$val);
    $self->writeControl($self->firstLED,$comment);
}
#-------------------------------------------------------------- FLIP3UQBias::LEDLongPulse
#help: LEDLongPulse(number) sets LEDnumber to long.  If number = 3, sets both to long
sub LEDLongPulse {
    my $self = shift;
    my $number = 0;
    if ($#_ > -1) {
	$number = $_[0];
	$self->LEDShortPulse($number,1);
    } else {
	$self->LEDShortPulse(3,1);
    }
}
#----------------------------------------------------------------- FLIP3UQBias::LEDRepMode
#help: LEDRepMode(number) sets LEDnumber to repetitive mode.  If number = 3, sets both LEDs to rep.
sub LEDRepMode {
    my $self = shift;
    my $val = 1;
    my $number = $_[0];
    my $comment = undef;
    if ($number == 3) {
	$self->LEDRepMode(1);
	$self->LEDRepMode(2);
	return;
    }
    $comment = "FLIP3UQBias LED$number to repetitive mode";
    $self->firstLED->fromFile($self->filename);
    $self->firstLED->setGroup("LED${number}rep",$val);
    $self->writeControl($self->firstLED,$comment);
}
#----------------------------------------------------------------- FLIP3UQBias::LEDSingleMode
#help: LEDSingleMode(number) sets LEDnumber to single fire mode.  If number = 3, sets both to single
sub LEDSingleMode {
    my $self = shift;
    my $number = $_[0];
    my $val = 0;
    my $comment = undef;
    if ($number == 3) {
	$self->LEDSingleMode(1);
	$self->LEDSingleMode(2);
	return;
    }
    $comment = "FLIP3UQBias LED$number to single mode";
    $self->firstLED->fromFile($self->filename);
    $self->firstLED->setGroup("LED${number}rep",$val);
    $self->writeControl($self->firstLED,$comment);
}
#----------------------------------------------------------------- FLIP3UQBias::LEDPulseMode
#help: LEDPulseMode(number,value) sets LEDnumber to 0 = pulse, 1 = cont.  If number = 3, sets both LEDs to value. If value is omitted, sets to short
sub LEDPulseMode {
    my $self = shift;
    my $val = undef;
    my $number = undef;
    my $comment = undef;
    if ($#_ == 0) {
	($number) = @_;
	$val = 0;
    } elsif ($#_ == 1) {
	($number,$val) = @_;
    } else {
	print "Incorrect number of arguments\n";
	return;
    }
    if ($number == 3) {
	$self->LEDPulseMode(1,$val);
	$self->LEDPulseMode(2,$val);
	return;
    }
    if ($val == 1) {
	$comment = "FLIP3UQBias LED$number continuous";
    } elsif ($val == 0) {
	$comment = "FLIP3UQBias LED$number pulse";
    }
    $self->firstLED->fromFile($self->filename);
    $self->firstLED->setGroup("LED${number}cont",$val);
    $self->writeControl($self->firstLED,$comment);
}
#----------------------------------------------------------------- FLIP3UQBias::LEDContMode
#help: LEDContMode(number) sets LEDnumber to continuous.  If number = 3, sets both to long
sub LEDContMode {
    my $self = shift;
    my $number = 0;
    if ($#_ > -1) {
	$number = $_[0];
	$self->LEDPulseMode($number,1);
    } else {
	$self->LEDPulseMode(3,1);
    }
}
#----------------------------------------------------------------- FLIP3UQBias::LEDFire
#help: LEDFire(number) fires LEDnumber, and then resets CSR bit.  If number = 3, fires both LEDs to value.
sub LEDFire {
    my $self = shift;
    my $val = 1;
    my $number = $_[0];
    my $comment = undef;
    if ($number == 3) {
	$self->LEDFire(1);
	$self->LEDFire(2);
	return;
    }
    $comment = "Checking if in single fire mode";
    my $bits = undef;
    $bits = $self->readControl($self->firstLED,$comment);
    $bits =~ s/ //;
    my @test = undef;
    $test[1] = hex($bits) & 4;
    $test[2] = hex($bits) & 64;
    if ($test[$number] != 0) {
	print "LED $number needs to be in single fire mode\n";
	return;
    }
    $comment = "FLIP3UQBias fire LED$number";
    $self->firstLED->fromFile($self->filename);
    $self->firstLED->setGroup("LED${number}single",$val);
    $self->writeControl($self->firstLED,$comment);
    $val = 0;
    $self->firstLED->setGroup("LED${number}fire",$val);
    $self->writeControl($self->firstLED,$comment);
}

#----------------------------------------------------------------- FLIP3UQBias::readLEDModeStatus
#help: readLEDModeStatus(void) reads back first CSR on QBias section
sub readLEDModeStatus {
    my $self = shift;
    my $bits = undef;
    my $comment = "FLIP3UQBias read first LED CSR";
    $bits = $self->readControl($self->firstLED,$comment);
    $self->firstLED->setData($bits);
    $self->toFile($self->filename);
    return $self->firstLED->data;
}
#----------------------------------------------------------------- FLIP3UQBias::readLEDWPStatus
#help: readLEDWPStatus(void) reads back first CSR on QBias section
sub readLEDWPStatus {
    my $self = shift;
    my $bits = undef;
    my $comment = "FLIP3UQBias read second LED CSR";
    $bits = $self->readControl($self->secondLED,$comment);
    $self->secondLED->setData($bits);
    $self->toFile($self->filename);
    return $self->secondLED->data;
}
#----------------------------------------------------------------- FLIP3UQBias::readQBiasCSR
#help: readQBiasCSR(void) reads back CSRs on QBias section
sub readQBiasCSR {
    my $self = shift;
    $self->readLEDModeStatus;
    $self->readLEDWPStatus;
}
#----------------------------------------------------------------- FLIP3UQBias::readQBias
#help: readQBias(void) reads back CSRs and DACs on QBias section
sub readQBias {
    my $self = shift;
    $self->readQBiasCSR;
    $self->readQBiasDAC;
}
#
#                  Write the DACs.
#
#--------------------------------------------------------------- FLIP3UQBias::setQIDAC
#help: setQIDAC(value) set Qi bias voltage to V volts
sub setQIDAC {
    my $self = shift;
    my $val = $_[0];
    my $comment = "FLIP3UQBias Qinner DAC to $val volts";
    $self->Qibias->setValue($val);
    $self->writeControl($self->Qibias,$comment);
}
#--------------------------------------------------------------- FLIP3UQBias::setQODAC
#help: setQODAC(value) set Qo bias voltage to V volts
sub setQODAC {
    my $self = shift;
    my $val = $_[0];
    my $comment = "FLIP3UQBias Qouter DAC to $val volts";
    $self->Qobias->setValue($val);
    $self->writeControl($self->Qobias,$comment);
}
#--------------------------------------------------------------- FLIP3UQBias::setLED1DAC
#help: setLED1DAC(value) set first LED bias voltage to V volts
sub setLED1DAC {
    my $self = shift;
    my $val = $_[0];
    my $comment = "FLIP3UQBias first LED DAC to $val volts";
    $self->LED1bias->setValue($val);
    $self->writeControl($self->LED1bias,$comment);
}
#--------------------------------------------------------------- FLIP3UQBias::setLED2DAC
#help: setLED2DAC(value) set second LED bias voltage to V volts
sub setLED2DAC {
    my $self = shift;
    my $val = $_[0];
    my $comment = "FLIP3UQBias second LED DAC to $val volts";
    $self->LED2bias->setValue($val);
    $self->writeControl($self->LED2bias,$comment);
}
#
#                 Read the DACs
#
#--------------------------------------------------------------- FLIP3UBias::readQIDAC
#help: readQIDAC(void) read Qinner bias voltage to V volts
sub readQIDAC {
    my $self = shift;
    my $comment = "FLIP3UQBias read QIDAC";
    my $bits = $self->readControl($self->Qibias,$comment);
    $self->Qibias->setData($bits);
    $self->toFile($self->filename);
    return $self->Qibias->value;
}
#--------------------------------------------------------------- FLIP3UBias::readQODAC
#help: readQODAC(void) read Qouter bias voltage to V volts
sub readQODAC {
    my $self = shift;
    my $comment = "FLIP3UQBias read QODAC";
    my $bits = $self->readControl($self->Qobias,$comment);
    $self->Qobias->setData($bits);
    $self->toFile($self->filename);
    return $self->Qobias->value;
}
#--------------------------------------------------------------- FLIP3UBias::readLED1DAC
#help: readLED1DAC(void) read LED1 bias voltage to V volts
sub readLED1DAC {
    my $self = shift;
    my $comment = "FLIP3UQBias read LED1 DAC";
    my $bits = $self->readControl($self->LED1bias,$comment);
    $self->LED1bias->setData($bits);
    $self->toFile($self->filename);
    return $self->LED1bias->value;
}
#--------------------------------------------------------------- FLIP3UBias::readLED2DAC
#help: readLED2DAC(void) read LED2 bias voltage to V volts
sub readLED2DAC {
    my $self = shift;
    my $comment = "FLIP3UQBias read LED2DAC";
    my $bits = $self->readControl($self->LED2bias,$comment);
    $self->LED2bias->setData($bits);
    $self->toFile($self->filename);
    return $self->LED2bias->value;
}
#--------------------------------------------------------------- FLIP3UQBias::readQBiasDAC
#help: readQBiasDAC(void) reads all DACs
sub readQBiasDAC {
    my $self = shift;
    $self->readQIDAC;
    $self->readQODAC;
    $self->readLED1DAC;
    $self->readLED2DAC;
}


\\__END__OF__FLIP3UQBias.pm__FILE\\
chmod 664 FLIP3UQBias.pm
echo unsharking FLIP3UQet.pm
cat > FLIP3UQet.pm << '\\__END__OF__FLIP3UQet.pm__FILE\\'
#! /usr/local/bin/perl 

package FLIP3UQet; 
#
#		FLIP3UQet.pm
#
#	INHERITS FROM:  ElecModule
#	CONTAINS:  Control, DAC
#
#	Contains commands for setting and reading back the digital DACs and 
#	controls on the FLIP3U QET card.
#

require 5.002;
require object;

use Control;
use DAC; 

@ISA = qw( ElecModule );

my @offset = [];
my %fields = ( 
	      filename     => undef,
	      bias         => {},
	      heater       => undef,
	      Reset        => undef,
	      heaterpulse  => undef,
	      Controls     => {},
	      DACs         => {},
	      box          => undef,
	      module       => undef,
	      data         => undef,
	      address      => undef,
	      filename     => undef,
	      outfile      => undef,
	      scriptonly   => undef,
	      jumpers      => undef,
	      class        => undef,
	      Accumulate   => undef,
	      );
#
#                             Basic Functions
#
#----------------------------------------------------------------- FLIP3UQet::new
sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my $self = ElecModule->new($_[0],$_[1],$_[2]);
    $self->{_permitted} = \%fields;
    bless $self,$class;

    my $host = $self->box->host;
    my $subrack = $self->box->subrack;
    my $module = $self->module;
    
    if (($self->scriptonly) == 1) {
	$host = "script";
    }

    $self->filename("/tmp/$host-$class-$subrack-$module.out");
    $self->class("FLIP3UQet");

    $self->{bias}->{a} = new DAC (0,12,-5,5);
    $self->{bias}->{b} = new DAC (1,12,-5,5);
    $self->{bias}->{c} = new DAC (2,12,-5,5);
    $self->{bias}->{d} = new DAC (3,12,-5,5);
    $self->Reset( new DAC (6,2,0,1));
    $self->heaterpulse( new DAC (7,2,0,1));

    $self->heater( new Control (4,"phicala","phicalb","phicalc",
				"phicald","heatwidth","enableheata",
				"enableheatb","enableheatc","enableheatd","",
				"","",""));
    $self->heater->setGroupSize("heatwidth",4);

    $self->{Controls}->{heater}            = $self->heater;
    $self->{DACs}->{biasa}                 = $self->{bias}->{a};
    $self->{DACs}->{biasb}                 = $self->{bias}->{b};
    $self->{DACs}->{biasc}                 = $self->{bias}->{c};
    $self->{DACs}->{biasd}                 = $self->{bias}->{d};

    $self->fromFile($self->filename);

    return $self;
}
#----------------------------------------------------------------- ZIP::init
#help: init(void) resets memory to startup state of card
sub init {
    my $self = shift;
    my %controls = %{$self->Controls};
    my %dacs = %{$self->DACs};
    foreach $key (sort keys %controls) {
	$controls{$key}->setData(0);
    }
    foreach $key (sort keys %dacs) {
	$dacs{$key}->setValue(0);
    }
    $self->toFile($self->filename);
}
#
#                              QET Control Registers
#
#----------------------------------------------------------------- FLIP3UQet::IVMode
#help: IVMode(channel) set PHi channel to calibration mode.  If channel is omitted sets all channels to calibrate
sub IVMode {
    my $self = shift;
    my @channel = undef;
    my $val = 1;
    if ($#_ < 0) {
	@channel = (a,b,c,d);
    } else {
	@channel = @_;
    }
    my $comment = "FLIP3UQet IV mode on";
    $self->heater->fromFile($self->filename);
    for ($i=0;$i<=$#channel;$i++) {
	$comment = $comment . " $channel[$i]";
	$self->heater->setGroup("phical$channel[$i]",$val);
    }
    $self->writeControl($self->heater,$comment);
}
#----------------------------------------------------------------- FLIP3UQet::BiasMode
#help: BiasMode(channel) set PHi channel to measure mode.  If channel is omitted sets all channels to measure
sub BiasMode {
    my $self = shift;
    my @channel = undef;
    my $val = 0;
    if ($#_ < 0) {
	@channel = (a,b,c,d);
    } else {
	@channel = @_;
    }
    my $comment = "FLIP3UQet bias mode on"; 
    $self->heater->fromFile($self->filename);
    for ($i=0;$i<=$#channel;$i++) {
	$comment = $comment . " $channel[$i]";
	$self->heater->setGroup("phical$channel[$i]",$val);
    }
    $self->writeControl($self->heater,$comment);
}
#----------------------------------------------------------------- FLIP3UQet::EnableHeat
#help: EnableHeat(channels) enables heater channel. Channels are "a","b","c","d".  If channel is omitted, enables all heaters.
sub EnableHeat {
    my $self = shift;
    my @name = @_;
    my $val = 1;
    my $comment = "FLIP3UQet Enable Heater";
    if ($#_ < 0) {
	@name = (a,b,c,d);
    } 
    $self->heater->fromFile($self->filename);
    for ($i=0;$i<=$#name;$i++) {
	$self->heater->setGroup("enableheat$name[$i]",$val);
	$comment = "$comment" . " $name[$i]";
    }
    $self->writeControl($self->heater,$comment);
}
#----------------------------------------------------------------- FLIP3UQet::DisableHeat
#help: DisableHeat(channels) disables heater channel. Channels are "a","b","c","d".  If channel is omitted, disables all heaters.
sub DisableHeat {
    my $self = shift;
    my @name = @_;
    my $val = 0;
    my $comment = "FLIP3UQet Disable Heater";
    if ($#_ < 0) {
	@name = (a,b,c,d);
    } 
    $self->heater->fromFile($self->filename);
    for ($i=0;$i<=$#name;$i++) {
	$self->heater->setGroup("enableheat$name[$i]",$val);
	$comment = "$comment" . " $name[$i]";
    }
    $self->writeControl($self->heater,$comment);
}
#----------------------------------------------------------------- FLIP3UQet::HeaterWidthIndex
sub HeaterWidthIndex {
    my $self = shift;
    my $index = $_[0];
    my $unit = 100;                           # units for heater width
    my $width = ($index + 1)* $unit;
    my $comment = "FLIP3UQet Heater index to $index, width to $width";
    $self->heater->fromFile($self->filename);
    $self->heater->setGroup("heatwidth",$index);
    $self->writeControl($self->heater,$comment);
}
#----------------------------------------------------------------- FLIP3UQet::HeaterWidth
#help: HeaterWidth(width) sets qet heater width to nearest possible value to width that is less than input value
sub HeaterWidth {
    my $self = shift;
    my $width = $_[0];
    my $unit = 100;                           # units for heater width
    my $index = (int($width/$unit) - 1);
    if ($index > 15) {
	print "Max heater width is 1600 ms, setting to that\n";
	$index = 15;
    } elsif ($index < 0) {
	print "Min heater width is 100 ms, setting to that\n";
	$index = 0;
    }
    $self->HeaterWidthIndex($index);
}
#----------------------------------------------------------------- FLIP3UQet::readHeater
#help: readHeater(void) reads back CSR on QET section and updates memory
sub readHeater {
    my $self = shift;
    my $bits = undef;
    my $comment = "FLIP3UQet read heater CSR";
    $bits = $self->readControl($self->heater,$comment);
    $self->heater->setData($bits);
    $self->toFile($self->filename);
    return $self->heater->data;
}
#----------------------------------------------------------------- FLIP3UQet::readQET
#help: readQET(void) reads back CSR and DACs on QET section and updates memory
sub readQET {
    my $self = shift;
    $self->readQETBias;
    $self->readHeater;
}
#
#                              QET DACs
#
#----------------------------------------------------------------- FLIP3UQet::setQETBias
#help: setQETBias(channel,value) sets bias on QET channel to value in volts.  If channel is omitted, sets all four channels.  Channels are "a","b","c","d".
sub setQETBias {
    my $self = shift;
    my $channel = 0;
    my $val = 0;
    if ($#_ == 1) {
	$channel = $_[0];
	$val = $_[1];
    } elsif ($#_ == 0) {
	$val = $_[0];
	$self->setQETBias("a",$val);
	$self->setQETBias("b",$val);
	$self->setQETBias("c",$val);
	$self->setQETBias("d",$val);
	return;
    }
    my $comment = "FLIP3UQet set QET $channel bias to $val";
    $self->{bias}->{$channel}->setValue($val);
    $self->writeControl($self->{bias}->{$channel},$comment);
}
#----------------------------------------------------------------- FLIP3UQet::reset
#help: reset resets card
sub reset {
    my $self = shift;
    my $val = 0.5;
    my $comment = "FLIP3UQet reset";
    $self->Reset->setValue($val);
    $self->writeControl($self->Reset,$comment);
    $self->init;
}
#----------------------------------------------------------------- FLIP3UQet::pulseheater
#help: pulseheater Pulses heater
sub pulseheater {
    my $self = shift;
    my $val = 0.5;
    my $comment = "FLIP3UQet pulse heater";
    $self->heaterpulse->setValue($val);
    $self->writeControl($self->heaterpulse,$comment);
}
#----------------------------------------------------------------- FLIP3UQet::readQETBias
#help: readQETBias(channel) reads bias on QET channel.  If channel is omitted, reads all four channels.  Channels are "a","b","c","d".
sub readQETBias {
    my $self = shift;
    my @channel = undef;
    my $comment = undef;
    my $bits = undef;
    my $ret = undef;
    if ($#_ < 0) {
	@channel = ("a","b","c","d");
    } else {
	@channel = @_;
    }
    for ($i=0;$i<=$#channel;$i++) {
	$comment = "FLIP3UQet read QET $channel[$i] bias";
	$bits = $self->readControl($self->{bias}->{$channel[$i]},
				  $comment);
	$self->{bias}->{$channel[$i]}->setData($bits);
	$ret = $i;
    }
    $self->toFile($self->filename);
    return $self->{bias}->{$channel[$ret]}->value;

}



\\__END__OF__FLIP3UQet.pm__FILE\\
chmod 664 FLIP3UQet.pm
echo unsharking FLIP3USquid.pm
cat > FLIP3USquid.pm << '\\__END__OF__FLIP3USquid.pm__FILE\\'
#! /usr/local/bin/perl

package FLIP3USquid;
#
#		FLIP3USquid.pm
#
#	INHERITS FROM:  ElecModule
#	CONTAINS:  Control, DAC
#
#	Contains commands for setting and reading back the digital DACs and
#	controls on the FLIP3U SQUID card.
#

require 5.002;
require ElecModule;

use Control;
use DAC;

@ISA =qw( ElecModule );

my %fields = (
	      filename     => undef,
	      gain         => undef,
	      bias         => undef,
	      offset       => undef,
	      lockpt       => undef,
	      zapper       => undef,
	      armer        => undef,
	      disarmer     => undef,
	      Reset        => undef,
	      Controls     => {},
	      DACs         => {},
	      box          => undef,
	      module       => undef,
	      data         => undef,
	      address      => undef,
	      filename     => undef,
	      outfile      => undef,
	      scriptonly   => undef,
	      jumpers      => undef,
	      Controls     => {},
	      DACs         => {},
	      class        => undef,
	      Accumulate   => undef,
	      );
#
#                         Basic Functions
#
#------------------------------------------------------- FLIP3USquid::new
sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my $self = ElecModule->new($_[0],$_[1],$_[2]);
    $self->{_permitted} = \%fields;
    bless $self,$class;

    my $host = $self->box->host;
    my $subrack = $self->box->subrack;
    my $module = $self->module;
    
    if (($self->scriptonly) == 1) {
	$host = "script";
    }

    $self->filename("/tmp/$host-$class-$subrack-$module.out");
    $self->class("FLIP3USquid");

    $self->bias( new DAC(0,12,-5,5));
    $self->gain( new DAC(1,12,-5,5));
    $self->offset( new DAC(3,12,-5,5));
    $self->lockpt( new DAC(2,12,-5,5));
    $self->armer( new DAC(5,2,0,1));
    $self->disarmer( new DAC(6,2,0,1));
    $self->Reset( new DAC(7,2,0,1));

    $self->zapper( new Control(4,"cal","mode","zapvoltage","zapwidth",
			       "armed","polpos","polneg","","","",""));
    $self->zapper->setGroupSize("zapwidth",4);
    $self->zapper->setGroupSize("zapvoltage",2);

    $self->{Controls}->{ZapControl}    = $self->zapper;

    $self->{DACs}->{bias}              = $self->bias;
    $self->{DACs}->{gain}              = $self->gain;
    $self->{DACs}->{offset}            = $self->offset;
    $self->{DACs}->{lockpt}            = $self->lockpt;

    $self->fromFile($self->filename);

    if ((hex($self->zapper->data) & 512) == 1) {
	$self->polnegSQUID;
    }

    return $self;
}
#----------------------------------------------------------------- FLIP3USquid::init
#help: init(void) resets memory to startup state of card
sub init {
    my $self = shift;
    my %controls = %{$self->Controls};
    my %dacs = %{$self->DACs};
    foreach $key (sort keys %controls) {
	$controls{$key}->setData(0);
    }
    foreach $key (sort keys %dacs) {
	$dacs{$key}->setValue(0);
    }
    $self->toFile($self->filename);
    $self->zapper->setGroup("mode",1);
    $self->zapper->setGroup("armed",1);
    $self->zapper->setGroup("cal",1);
    $self->toFile($self->filename);
}
#
#                              Squid Control Registers
#
#----------------------------------------------------------------- FLIP3USquid::openfb
#help: openfb sets squid to calibration mode. 
sub openfb {
    my $self = shift;
    my $val = 1;
    my $comment = undef;
    $comment = "FLIP3USquid Squid open feedback";
    if (($self->scriptonly) != 1) {
	$self->readSQUIDZapper();
    } else {
	$self->zapper->fromFile($self->filename);
    }
    $self->zapper->setGroup("cal",$val);
    $self->writeControl($self->zapper,$comment);
}
#----------------------------------------------------------------- FLIP3USquid::closefb
#help: closefb sets squid to measure mode. 
sub closefb {
    my $self = shift;
    my $val = 0;
    my $comment = undef;
    $comment = "FLIP3USquid Squid close feedback";
    if (($self->scriptonly) != 1) {
        $self->readSQUIDZapper();
    } else {
	$self->zapper->fromFile($self->filename);
    }
    $self->zapper->setGroup("cal",$val);
    $self->writeControl($self->zapper,$comment);
}
#----------------------------------------------------------------- FLIP3USquid::SynchZapMode
#help: SynchZapMode sets squid to synchronous mode. 
sub SynchZapMode {
    my $self = shift;
    my $val = 1;
    my $comment = undef;
    $comment = "FLIP3USquid Squid synch mode";
    if (($self->scriptonly) != 1) {
	$self->readSQUIDZapper();
    } else {
	$self->zapper->fromFile($self->filename);
    }
    $self->zapper->setGroup("mode",$val);
    $self->writeControl($self->zapper,$comment);
}
#----------------------------------------------------------------- FLIP3USquid::ASynchZapMode
#help: ASynchZapMode sets squid to asynchronous mode. 
sub ASynchZapMode {
    my $self = shift;
    my $val = 0;
    my $comment = undef;
    $comment = "FLIP3USquid Squid asynch mode";
    if (($self->scriptonly) != 1) {
 	$self->readSQUIDZapper();
    } else {
	$self->zapper->fromFile($self->filename);
    }
    $self->zapper->setGroup("mode",$val);
    $self->writeControl($self->zapper,$comment);
}
#----------------------------------------------------------------- FLIP3USquid::ZapWidthIndex
sub ZapWidthIndex {
    my $self = shift;
    my $index = undef;
    $index = $_[0];
    my $unit = 100;                               # unit of width
    my $val = $unit * ($index + 1);
    my $comment = "FLIP3USquid width bits to $index, value to $val";
    if (($self->scriptonly) != 1) {
 	$self->readSQUIDZapper();
    } else {
	$self->fromFile($self->filename);
    }
    $self->zapper->setGroup("zapwidth",$index);
    $self->writeControl($self->zapper,$comment);
}    
#----------------------------------------------------------------- FLIP3USquid::ZapWidth
#help: ZapWidth(value) sets width for ZAP to nearest possible width that is smaller than input value (in units of ms). 
sub ZapWidth {
    my $self = shift;
    my $index = undef;
    my $unit = 100;                          #set units of width
    my $val = undef;
    $val = $_[0];
    $index = (int($val/$unit) - 1);
    if ($index > 15) {
	print "Max value is 1600 ms, setting to that\n";
	$index = 15;
    } elsif ($index < 0) {
	print "Min value is 100 ms, setting to that\n";
	$index = 0;
    }
    $self->ZapWidthIndex($index);
}
#----------------------------------------------------------------- FLIP3USquid::armzap
#help: armzap() arms squid.
sub armZapSQUID {
    my $self = shift;
    $self->armzap(@_);
}
sub armzap {
    my $self = shift;
    my $val = 0.5;
    my $comment = undef;
    $comment = "FLIP3USquid arm";
    if (($self->scriptonly) != 1) {
 	$self->readSQUIDZapper();
    } else {
	$self->zapper->fromFile($self->filename);
    }
    $self->armer->setValue($val);
    $self->zapper->setGroup("armed",0);
    $self->disarmer->setValue(0);
    $self->writeControl($self->armer,$comment);
    $self->toFile($self->filename);
}
#----------------------------------------------------------------- FLIP3USquid::disarmzap
#help: disarmzap() disarms squid.
sub disarmZapSQUID {
    my $self = shift;
    $self->disarmzap(@_);
}
sub disarmzap {
    my $self = shift;
    my $val = 0.5;
    my $comment = undef;
    $comment = "FLIP3USquid disarm";
    if (($self->scriptonly) != 1) {
	$self->readSQUIDZapper();
    } else {
        $self->zapper->fromFile($self->filename);
    }
    $self->disarmer->setValue($val);
    $self->zapper->setGroup("armed",1);
    $self->armer->setValue(0);
    $self->writeControl($self->disarmer,$comment);
    $self->toFile($self->filename);
}
#----------------------------------------------------------------- FLIP3USquid::armed
#help: armed() reads zapper CSR and tells whether the ZAP is armed; updates variables.  
sub armed {
    my $self = shift;
    my $val = undef;
    my $comment = undef;
    my $bits = undef;
    my $test = undef;
    $comment = "FLIP3USquid armed";
    $self->zapper->fromFile($self->filename);
    $bits = $self->readControl($self->zapper,$comment);
    $self->zapper->setData($bits[$i]);
    $bits =~ s/ //;
    $test = hex($bits) & 256;
    print "test is $test, bits are $bits\n";
    if ($test > 0) {
        print "ZAP disarmed\n";
    } else {
        print "ZAP armed\n";
    }
}
#----------------------------------------------------------------- FLIP3USquid::polpos
#help: polpos puts squid to positive polarity. 
sub polposSQUID {
    my $self = shift;
    $self->polpos(@_);
}
sub polpos {
    my $self = shift;
    my $val = 1;
    my $comment = undef;
    $comment = "FLIP3USquid polarity to positive";
    if (($self->scriptonly) != 1) {
        $self->readSQUIDZapper();
    } else {
        $self->zapper->fromFile($self->filename);
    }
    $self->zapper->setGroup("polpos",1);
    $self->zapper->setGroup("polneg",0);
    $self->readControl($self->disarmer,$comment);
    $self->toFile($self->filename);
}
#----------------------------------------------------------------- FLIP3USquid::polneg
#help: polneg puts squid to negative polarity. 
sub polnegSQUID {
    my $self = shift;
    $self->polneg(@_);
}
sub polneg {
    my $self = shift;
    my $val = 1;
    my $comment = undef;
    $comment = "FLIP3USquid polarity to negative";
    if (($self->scriptonly) != 1) {
         $self->readSQUIDZapper();
    } else {
        $self->zapper->fromFile($self->filename);
    }
    $self->zapper->setGroup("polneg",1);
    $self->zapper->setGroup("polpos",0);
    $self->readControl($self->armer,$comment);
    $self->toFile($self->filename);
}
#----------------------------------------------------------------- FLIP3USquid::Zeropol
#help Zeropol zeros both polarity bits on Squid
sub Zeropol {
    my $self = shift;
    my $val = 0;
    my $comment = undef;
    $comment = "FLIP3USquid zero polarity";
    if (($self->scriptonly) != 1) {
         $self->readSQUIDZapper();
    } else {
        $self->zapper->fromFile($self->filename);
    }
    $self->zapper->setGroup("polpos",$val);
    $self->zapper->setGroup("polneg",$val);
    $self->writeControl($self->zapper,$comment);
}
#----------------------------------------------------------------- FLIP3USquid::ZapVolt
#help: ZapVolt(voltage) sets ZAP voltage.  Possible voltages are 0, 1.25, 2.5, 3.75 sets to closest lower value
sub ZapVolt {
    my $self = shift;
    my $val = undef;
    my $newindex;
    my @volts = (0,1.25,2.5,3.75);
    $val = $_[0];
    for ($i=0;$i<=$#volts;$i++) {
	if ($val>=$volts[$i]) {
	    $newindex = $i;
	}
    }
    $self->ZapVoltIndex($newindex);
}
#----------------------------------------------------------------- FLIP3USquid::ZapVoltIndex
sub ZapVoltIndex {
    my $self = shift;
    my $index = undef;
    my @volts = (0,1.25,2.5,3.75);
    $index = $_[0];
    my $comment = "FLIP3USquid set ZAP voltage to $volts[$index]";
    if (($self->scriptonly) != 1) {
	$self->readSQUIDZapper();
    } else {
	$self->zapper->fromFile($self->filename);
    }
    $self->zapper->setGroup("zapvoltage",$index);
    $self->writeControl($self->zapper,$comment);
}
#----------------------------------------------------------------- FLIP3USquid::reset
#help: reset resets card bits
sub reset {
    my $self = shift;
    my $val = 0.5;
    my $comment = "FLIP3USquid reset card";
    $self->Reset->setValue($val);
    $self->writeControl($self->Reset,$comment);
    $self->init;
}
#----------------------------------------------------------------- FLIP3USquid::readzapper
#help: readzapper reads the Zapper CSR on squid 
sub readSQUIDZapper {
    my $self = shift;
    $self->readzapper(@_);
}
sub readzapper {
    my $self = shift;
    my $comment = undef;
    my $bits = undef;
    $comment = "FLIP3USquid read Zapper";
    $bits = $self->readControl($self->zapper,$comment);
    print "$bits\n";
    $self->zapper->setData($bits);
    $self->toFile($self->filename);
}
#----------------------------------------------------------------- FLIP3USquid::readSQUID
#help: readSQUID reads all DACs and CSRs for squid.  
sub readSQUID {
    my $self = shift;
    $self->readSQUIDZapper();
    $self->readSQUIDDAC();
}
#
#                              Squid DACs
#
#----------------------------------------------------------------- FLIP3USquid::setbias
#help: setbias(value) sets bias on squid to value in volts.  
sub setSQUIDbias {
    my $self = shift;
    $self->setbias(@_);
}
sub setbias {
    my $self = shift;
    my $val = 0;
    $val = $_[0];
    my $comment = "FLIP3USquid set bias to $val";
    $self->bias->setValue($val);
    $self->writeControl($self->bias,$comment);
}
#----------------------------------------------------------------- FLIP3USquid::setgain
#help: setgain(value) sets gain on squid to value in volts.  
sub setgain {
    my $self = shift;
    my $val = 0;
    $val = $_[0];
    my $comment = "FLIP3USquid set squid olgain to $val";
    $self->gain->setValue($val);
    $self->writeControl($self->gain,$comment);
}
# help: setSQUIDolgain(value) sets gain on squid to value in volts.  
sub setSQUIDolgain {
    my $self = shift;
    return ($self->setgain(@_));
}
#----------------------------------------------------------------- FLIP3USquid::setlockpoint
#help: setlockpoint(value) sets lock point on squid to value in volts.  
sub setlockpoint {
    my $self = shift;
    my $val = 0;
    $val = $_[0];
    my $comment = "FLIP3USquid set lock point to $val";
    $self->lockpt->setValue($val);
    $self->writeControl($self->lockpt,$comment);
}
# help: setLockPoint(value) sets lock point on squid to value in volts.  
sub setLockPoint {
    my $self = shift;
    return $self->setlockpoint(@_);
}
#----------------------------------------------------------------- FLIP3USquid::setampoffset
#help: setampoffset(value) sets pre-amp offset, in units of mV (+/- 50)
sub setAmpOffset {
    my $self = shift;
    $self->setampoffset(@_);
}
sub setampoffset {
    my $self = shift;
    my $val = $_[0];
    my $volts = $val/10;
    my $comment = "FLIP3USquid set pre-amp offset to $val";
    $self->offset->setValue($volts);
    $self->writeControl($self->offset,$comment);
}
#----------------------------------------------------------------- FLIP3USquid::readbias
#help: readbias() reads bias on squid.  
sub readSQUIDbias {
    my $self = shift;
    $self->readbias(@_);
}
sub readbias {
    my $self = shift;
    my $comment = undef;
    my $bits = undef;
    my $value = undef;
    $comment = "FLIP3USquid read bias";
    $bits = $self->readControl($self->bias,$comment);
    $self->bias->setData($bits);
    $self->toFile($self->filename);				  
    return $self->bias->value;
}
#----------------------------------------------------------------- FLIP3USquid::readolgain
#help: readolgain() reads gain on squid.  
sub readSQUIDolgain {
    my $self = shift;
    $self->readolgain(@_);
}
sub readolgain {
    my $self = shift;
    my $comment = undef;
    my $bits = undef;
    $comment = "FLIP3USquid read gain";
    $bits = $self->readControl($self->gain,$comment);
    $self->gain->setData($bits);
    $self->toFile($self->filename);
    return $self->gain->value;
}
#----------------------------------------------------------------- FLIP3USquid::readLockPoint
#help: readLockPoint() reads offset on squid.  
sub readLockPoint {
    my $self = shift;
    my $comment = undef;
    my $bits = undef;
    $comment = "FLIP3USquid read offset";
    $bits = $self->readControl($self->lockpt,$comment);
    $self->lockpt->setData($bits);
    $self->toFile($self->filename);
    return $self->lockpt->value;
}
#----------------------------------------------------------------- FLIP3USquid::readAmpOffset
#help: readAmpOffset() reads pre-amp offset on squid.  
sub readAmpOffset {
    my $self = shift;
    my $comment = undef;
    my $bits = undef;
    $comment = "FLIP3USquid read pre-amp offset";
    $bits = $self->readControl($self->offset,$comment);
    $self->offset->setData($bits);
    $self->toFile($self->filename);
    return $self->offset->value;
}
#----------------------------------------------------------------- FLIP3USquid::readDAC
#help: readdac(channel) reads all DACs for squid channel.  If channel is omitted, reads all channels.
sub readSQUIDDAC {
    my $self = shift;
    $self->readdac(@_);
}
sub readdac {
    my $self = shift;
    $self->readSQUIDbias();
    $self->readSQUIDolgain();
    $self->readLockPoint();
    $self->readAmpOffset();
}    
#





\\__END__OF__FLIP3USquid.pm__FILE\\
chmod 664 FLIP3USquid.pm
echo unsharking GPIBbox.pm
cat > GPIBbox.pm << '\\__END__OF__GPIBbox.pm__FILE\\'
#! /usr/local/bin/perl -w

package GPIBbox;
#
#               GPIBbox.pm
#
#       INHERITS FROM:  object
#       CONTAINS:  GPIBconnection, GPIBinstr   
#
#	This represents the GPIB box for a particular subrack.  It contains
#	initialization and help routines in addition to routines for setting
#	up the GPIBinstr and GPIBconnection to send the hex code through the
#	server to the physical GPIB box.
#

require 5.002;
require object;

use Socket;
use GPIBconnection;
use GPIBinstr;
use Carp;

@ISA = qw( object );

my %fields = (
  instrs => [],     # this should be an array of refs to class instruction.
  file => undef,
  host => undef,
  port => undef,
  subrack => undef,
  address => undef,
  data => undef,
  current => undef,
  GPIBaddress => undef,
  GPIBhead  => undef,
  GPIBtail  => undef,
  GPIBconn  => undef,
);

#-------------------------------------------------------------------- GPIBbox::new
sub new{
  my $this = shift;
  my $class = ref($this) || $this;
  my $self = object->new;
  $self->{_permitted} = \%fields;
  bless $self,$class;

  my ($arg,$logfile) = @_;
  if ($#_<0){ return $self; }
  if (length($logfile)==0 && $arg!~/:/){  # copy ctor
    my $b1 = $arg; 
    $self->instrs($b1->instrs()); 
    $self->file($b1->file()); 
    $self->host($b1->host()); 
    $self->port($b1->port()); 
    $self->subrack($b1->subrack()); 
    $self->address($b1->address()); 
    $self->data($b1->data()); 
    $self->current($b1->current()); 
    $self->GPIBaddress($b1->GPIBaddress()); 
    $self->GPIBhead($b1->GPIBhead()); 
    $self->GPIBtail($b1->GPIBtail()); 
    $self->GPIBconn($b1->GPIBconn()); 
    return $self;
  }
    
  my @hp = split /:/,$arg;

  $self->GPIBaddress(18);
  $self->GPIBhead('c4d');
  $self->GPIBtail('00zx');
  $self->file("command.log");

  $self->host($hp[0]);
  if ($hp[1]>0) {
    $self->port($hp[1]);
  }
  if ($#_>1) {
    my ($a) = @_;
    $self->file($a);
  }
  if ($#_ >1) { $self->file($logfile);}
  $self->GPIBconn(new GPIBconnection(join ':',$self->host,$self->port));
  $self->current(new GPIBinstr(
                     "gpibwrite",$self->GPIBaddress,"000000"));
  $self->initialize();
  return $self; 
}
#-------------------------------------------------------------------- GPIBbox::initialize
#help: initialize(void) initializes box
sub initialize{
  my $self = shift;
  my ($address,$subrack) = @_;  # allow possibility to use default subrack.
  if (length($subrack)>0) {
    my ($subrack) = @_;
    $self->subrack($subrack);
  }
  $self->current->setCommand("gpibwrite");
  $self->current->mode(7);                                 # not sure about the 0
  $self->current->dataString("r0c4g1f0p0k0m1x");
#  $self->dbgmess("initalize r0c4g1f0p0k0m1x to box");
  $self->current->setNbytes();
  my $dat = $self->GPIBconn->exInstr($self->current);
  $self->data(unpack("N",$dat));
} 
#-------------------------------------------------------------------- GPIBbox::readData
#help: readData(address=current address,subrack=current subrack)  returns data from address on subrack
sub readData{
  my $self = shift;
  if ((length($_[0]))>0) {
    $self->writeAddress($_[0]);
    if (length $_[1] >0){
      $self->subrack($_[1]);
    }
  }
  my $byte = int(0) | $self->subrack;
  $self->current->setCommand("gpibwrite");
  $self->current->mode(7);                                 # not sure about the 0
  $self->current->dataString("c2x"); 
  $self->current->setNbytes(); 
  $self->cheezySleep(20000);
  my $dat = $self->GPIBconn->exInstr($self->current);
#  $self->dbgmess("sent c2x");
#  $self->data(unpack("N",$dat));
  print "status: ",$dat,"\n";
  $self->current->setCommand("gpibread");
  $self->current->mode(0);                                 # not sure about the 0
  $self->current->setData(""); 
  $self->current->size(4);
  $self->cheezySleep(20000);
  $dat = $self->GPIBconn->exInstr($self->current);
#  $self->dbgmess("sent gpibread");
  $self->data($dat);
#  $self->data(substr($dat,4,4));
  print "data read: ",$self->data,"\n";
  return hex($self->data);
}
#-------------------------------------------------------------------- GPIBbox::writeAddress
#help: writeAddress(address=current address,subrack=current subrack)  writes address on subrack
sub writeAddress{
  my $self = shift;
  my ($address,$subrack) = @_;  # allow possibility to use default subrack.
  if (length($subrack)>0) {
    my ($subrack) = @_; 
    $self->subrack($subrack);
  }
  $self->address($address);
  $self->subrack($self->subrack);
  my $byte = int(8) | $self->subrack;
  $address = join '',$self->address,"0",(sprintf "%lx",$byte);
  $self->current->setData(join '',$self->GPIBhead,$address,$self->GPIBtail);
  $self->current->mode(7);
  $self->current->setCommand("gpibwrite");
#  $self->cheezySleep(10000);
  $self->GPIBconn->exInstr($self->current);
}
#-------------------------------------------------------------------- GPIBbox::writeData
#help: writeData(address=current address,subrack=current subrack)  writes data to address on subrack
sub writeData{
  my $self = shift;
  my ($data,$subrack) = @_;  # allow possibility to use default subrack.
  if (length($subrack)>0) {
    my ($subrack) = @_; 
    $self->subrack($subrack);
  }
  $self->data($data);
  $self->subrack($self->subrack);
  my $byte = int(0) | $self->subrack;
  $data = join '',$self->data,"0",(sprintf "%lx",$byte);
  $self->current->setData(join '',$self->GPIBhead,$data,$self->GPIBtail);
  $self->current->mode(7);
  $self->current->setCommand("gpibwrite");
#  $self->cheezySleep(10000);
  $self->GPIBconn->exInstr($self->current);
}
#-------------------------------------------------------------------- GPIBbox::print
#help: print(void) prints selected info about GPIB box settings
sub print{
  my $self = shift;
  print $self->file," \n";
  print "Remote host: ",$self->host,"\n";
  print "Remote port: ",$self->port,"\n";
  print "Remote subrack: ",$self->subrack,"\n";
#  my $i=0;
#  my $lines = $self->nlines;
#  for ($i=0;$i<$lines;$i++){
#    $self->{instrs}->[$i]->write;
#  }
}
#-------------------------------------------------------------------- GPIBbox::setHost
#help: setHost(host) sets box's host
sub setHost{
  my $self = shift;
  my ($arg) = @_;
  my @hp = split /:/,$arg;
  $self->host($hp[0]);
  if ($hp[1]>0) {
    $self->port($hp[1]);
  }
}
#-------------------------------------------------------------------- GPIBbox::setPort
#help: setPort(port) sets box's port
sub setPort{
  my $self = shift;
  my ($port) = @_;
  $self->port($port);
} 
#-------------------------------------------------------------------- GPIBbox::Sleep
sub cheezySleep{
  my $self = shift;
  my $ticks = shift;
  my $i;
  for ($i=0;$i<$ticks;$i++){ 
    my $a = 0;
    if ($i/5.121 == 3.32){
      $a = 1;
    }
  }
  return;
}


\\__END__OF__GPIBbox.pm__FILE\\
chmod 664 GPIBbox.pm
echo unsharking GPIBconnection.pm
cat > GPIBconnection.pm << '\\__END__OF__GPIBconnection.pm__FILE\\'
#! /usr/local/bin/perl -w

package GPIBconnection;
#
#               GPIBconnection.pm
#
#       INHERITS FROM:  object
#       CONTAINS:  None
#
#	This package handles all of the communication between the software
#	and the internet connection.  It contains routines for opening and 
#	closing the socket connection, sending the datastrings to the server
#	(in two different ways:  one at a time, or by creating a queue of
#	instructions and sending all of the commands at once), and for
#	reading datastrings from the server.
#

require 5.002;
require object;
require ClientConnection;

use Socket;
use GPIBinstr;
use Carp;

@ISA = qw( ClientConnection );

my %fields = (
  instrs => [],     # this should be an array of refs to class instruction.
  nlines => undef,
  file => undef,
  host => undef,
  port => undef,
  sock => undef,
  sleepTime => undef,
);

#-------------------------------------------------------------------- GPIBconnection::new
sub new{
  my $this = shift;
  my $class = ref($this) || $this;
#  my $self = object->new;
  my $self = ClientConnection->new;
  $self->{_permitted} = \%fields;
  bless $self,$class;

  $self->setHost("ppdm06.fnal.gov");
  $self->setPort(2345);
  $self->file("command.log");
  $self->nlines(0);

  my ($arg,$logfile) = @_;
  my @hp = split /:/,$arg;
  $self->host($hp[0]);
  if ($hp[1]>0) {
    $self->port($hp[1]);
  }
  if ($#_>1) {
    my ($a) = @_;
    $self->file($a);
  }
  $self->sleepTime(0);
  return $self;
}

#-------------------------------------------------------------------- GPIBconnection::addInstr
#help: addInstr(GPIBinstr,subrack) add an instruction to the list.
sub addInstr{   # looks like it sets a reference, which gets overwritten.
  my $self = shift;
  my $index = $self->nlines;
  my ($argument,$subrack) = @_;
  my $arg = new GPIBinstr();
  $arg->copy($argument);
  $self->{instrs}->[$index] = $arg;
  $self->nlines($index+1);
}
#-------------------------------------------------------------------- GPIBconnection::addAddress
#help: addAddress(GPIBinstr,address,subrack) add an address to the instruction list.
sub addAddress{   # looks like it sets a reference, which gets overwritten.
  my $self = shift;
  my $index = $self->nlines;
  my ($argument,$address,$subrack) = @_;
  my $arg = new GPIBinstr();
  $arg->copy($argument);
  my $rack = int(8) | $subrack;
  $arg->setData(join '',$address,"0",(sprintf "%1x",$rack));
  $self->{instrs}->[$index] = $arg;
  $self->nlines($index+1);
}
#-------------------------------------------------------------------- GPIBconnection::addData
#help: addData(GPIBinstr,data,subrack) add data to the instruction list.
sub addData{   # looks like it sets a reference, which gets overwritten.
  my $self = shift;
  my $index = $self->nlines;
  my ($argument,$data,$subrack) = @_;
  my $arg = new GPIBinstr();
  $arg->copy($argument);
  my $rack = int(0) | $subrack;
  $arg->setData(join '',$data,"0",(sprintf "%1x", $rack));
  $self->{instrs}->[$index] = $arg;
  $self->nlines($index+1);
}
#-------------------------------------------------------------------- GPIBconnection::close
#help: close() send bye and close the socket.
sub close{
  my $self = shift;
  my $bye = new GPIBinstr("bye");
  $self->sendString($bye->command);
  $self->closeSocket();
#  $self->dbgmess("close: called closeSocket");
}
#-------------------------------------------------------------------- GPIBconnection::exInstr
#help: exInstr(GPIBinstr) add an instruction and execute it. Return the status.
sub exInstr{
  my $self = shift;
  my ($inst) = @_;
#  $self->dbgmess("exInstr: opening socket");
  $self->openSocket();
#  my $ready = $self->readLine();
#  if ($ready !~ /ready/) {
#    $self->dbgmess("NOT READY!!!!");
#    die "Not ready to communicate\n";
#  }
  my $status = $self->sendtoServer($inst);
  if ($status != 0) {$self->dbgmess(" exInstr, Status: $status");}
  $self->close();
  return $status;
}
#-------------------------------------------------------------------- GPIBconnection::print
#help: print(void) prints selected information about connection
sub print{
  my $self = shift;
  print $self->file," \n";
  print "Remote host: ",$self->host,"\n";
  print "Remote port: ",$self->port,"\n";
  my $i=0;
  for ($i=0;$i<$self->nlines;$i++){
    $self->{instrs}->[$i]->write;
  }
}

#-------------------------------------------------------------------- GPIBconnection::execute
#help: execute(void) executes all items in instruction queue
sub execute{
  my $self = shift;
  my $i=0;
  my $line='   ';
  $self->openSocket();
  for ($i=0;$i<$self->nlines;$i++){
    my $bits = $self->sendtoServer($self->{instrs}->[$i]);
  }
  $self->closeSocket();
#  reset counter to 0.
  $self->nlines(0);
}
#----------------------------------------------------------------- GPIBconnection::sendtoServer
#help: sendtoServer(GPIBinstr) sends a GPIBinstr over the net
sub sendtoServer{
  my $self = shift;
  my $len = 0;my $status=0;
  my $maxSize = 10000;     # some maximum size to read back as error status.
  my ($inst) = @_;
  my $bytessent;
#  $self->dbgmess("sendtoServer: begin");
  $bytessent = $self->sendString($inst->command);
  my $string = $inst->packline();
  $bytessent = $self->sendInt(length($string));
  $bytessent = $self->sendString($string);
  $len = $self->readInt();
  if ($len<0) {die "Error reading size from socket \n"};
  if ($len==0) {$status = "ERROR in ",$inst->command; return $status};
  if ($len>$maxSize) { $self->closeSocket(); die "socket closed\n";}

  my $data = $self->readString($len);                              # debug new
#  $self->dbgmess("sendtoServer $len , $data");
  return $data;
}
\\__END__OF__GPIBconnection.pm__FILE\\
chmod 664 GPIBconnection.pm
echo unsharking GPIBinstr.pm
cat > GPIBinstr.pm << '\\__END__OF__GPIBinstr.pm__FILE\\'
#! /usr/local/bin/perl -d

package GPIBinstr;
#
#               GPIBinstr.pm
#
#       INHERITS FROM:  object
#       CONTAINS:  None
#
#	This represents an instruction slot for the GPIB box, and contains
#	routines for concatenating the data string with the appropriate header
#	and footer elements, with the correct format
#

require object;

use Carp;

@ISA = qw( object );

my %fields = (                  # a hash (assosciative array)
  command    => undef,
  address    => undef,
  nbytes     => undef,
  dataString => undef,
  mode       => undef,
  timeout    => undef,
  size       => undef,
);

#---------------------------------------------------------------- GPIBinstr::new
sub new{
  my $this = shift;
  my $class = ref($this) || $this;
  my $self = object->new;
  $self->{_permitted} = \%fields;
  bless $self,$class;

  my ($a,$b,$c) = @_;
  $self->setCommand($a);
  $self->address($b);
  $self->setData($c);
  $self->setNbytes();  # number of bytes in instruction (const = 16 for reads).
  $self->mode(7);    # i am not sure what this means. this means GPIBwrite
  $self->timeout(10000);   # 10 second timeout.
  $self->size(0);    # size of bytes to read. (0 for gpibwrite).
  return $self;
}
#------------------------------------------------------------- GPIBinstr::copy
sub copy{
  my $self = shift;
  my ($inst) = @_; 
  $self->command($inst->command);
  $self->address($inst->address);
  $self->nbytes($inst->nbytes);
  $self->dataString($inst->dataString);
  $self->mode($inst->mode);
  $self->timeout($inst->timeout);
  $self->size($inst->size);
}
#------------------------------------------------------------- GPIBinstr::write
#help: write(void) outputs command string to screen
sub write{
  my $self = shift;
  printf "%s\t%04x\t%04x\t%s\t%04x\t%04x\n",
  $self->command,$self->address,$self->dataString,$self->mode,$self->timeout;
}
#-------------------------------------------------------------------- GPIBinstr::packline
#help: packline(void) creates line to be sent to GPIB box
sub packline{
  my $self = shift;
  my $len = length($self->dataString);
  my $TEMPLATE = "N4 A$len";         # server expects 4 numbers & string of $len chars.
  my $packline = pack ($TEMPLATE,$self->address,$self->mode,$self->timeout,
		       $self->size,$self->dataString);
  return $packline;
}
#-------------------------------------------------------------------- GPIBinstr::print
#help: print(void) prints information about the instruction
sub print{
  my $self = shift;
  printf "\n--------------------\n";
  printf "Command: %s\n",$self->command;
  printf "Nbytes:  %04x\n",$self->nbytes;
  printf "Address: %04x\n",$self->address;
  printf "Mode:    %04x\n",$self->mode;
  printf "Timeout: %04x\n",$self->timeout;
  printf "Size:    %04x\n",$self->size;
  printf "Data:    %s\n",$self->dataString;
#  printf "%04x\t%04x\t%04x\t%04x\n\n",$self->subrack,$self->address,$self->dataString,$self->readwrite;
  printf "--------------------\n\n";
}
#------------------------------------------------------------- GPIBinstr::setCommand
#help: setCommand(command) sets current command (such as gpibwrite, gpibread)
sub setCommand{
  my $self = shift;
  my ($arg) = @_;
  $self->command(join '',$arg,"\n");
}
#------------------------------------------------------------- GPIBinstr::setData
#help: setData(dataString) sets the dataString.
sub setData{
  my $self = shift;
  my ($arg) = @_;
  $self->dataString($arg);
  $self->setNbytes();   # if data word changes, so does length.
}
#------------------------------------------------------------- GPIBinstr::setNbytes
#help: setNbytes(length) sets length in bytes of message to box
sub setNbytes{
  my $self = shift;
  my ($len);
  $len = length($self->dataString)+16; 
  $self->nbytes($len);
}
\\__END__OF__GPIBinstr.pm__FILE\\
chmod 664 GPIBinstr.pm
echo unsharking HP33120A.pm
cat > HP33120A.pm << '\\__END__OF__HP33120A.pm__FILE\\'
#! /usr/local/bin/perl -w

package HP33120A;
#
#               HP33120A.pm
#
#       INHERITS FROM:  object
#       CONTAINS:  GPIBconnection, GPIBinstr   
#

require 5.002;
require object;

use Socket;
use GPIBconnection;
use GPIBinstr;
use Carp;

@ISA = qw( object );

my %fields = (
  GPIBaddress => undef,
  instrs => [],     # this should be an array of refs to class instruction.
  current => undef,
  file => undef,
  host => undef,
  port => undef,
  GPIBconn  => undef,
);

#-------------------------------------------------------------------- GPIBbox::new
sub new{
  my $this = shift;
  my $class = ref($this) || $this;
  my $self = object->new;
  $self->{_permitted} = \%fields;
  bless $self,$class;

  my ($arg,$logfile) = @_;
  if ($#_<0){ return $self; }
  if (length($logfile)==0 && $arg!~/:/){  # copy ctor
    my $b1 = $arg; 
    $self->instrs($b1->instrs()); 
    $self->file($b1->file()); 
    $self->host($b1->host()); 
    $self->port($b1->port()); 
    $self->GPIBaddress($b1->GPIBaddress()); 
    $self->GPIBconn($b1->GPIBconn()); 
    $self->current($b1->current());
    return $self;
  }
    
  my @hp = split /:/,$arg;

  $self->GPIBaddress(10);
  $self->file("command.log");

  $self->host($hp[0]);
  if ($hp[1]>0) {
    $self->port($hp[1]);
  }
  if ($#_>1) {
    my ($a) = @_;
    $self->file($a);
  }
  if ($#_ >1) { $self->file($logfile);}
  $self->GPIBconn(new GPIBconnection(join ':',$self->host,$self->port));
  $self->current(new GPIBinstr("gpibwrite",$self->GPIBaddress,"000000"));
  return $self; 
}
#-------------------------------------------------------------------- GPIBbox::initialize
#help: initialize(void) initializes box
sub initialize{
  my $self = shift;
  $self->current->mode(7);
  $self->current->dataString("RMT");
  $self->current->setNbytes();
  my $dat = $self->GPIBconn->exInstr($self->current);
  $self->current->dataString("*CLS");
  $self->current->setNbytes();
  my $dat = $self->GPIBconn->exInstr($self->current);
  my $data = unpack("N",$dat);
  print "Initialized status: ",$data,"\n";
} 
#-------------------------------------------------------------------- GPIBbox::print
#help: print(void) prints selected info about GPIB box settings
sub print{
  my $self = shift;
  print $self->file," \n";
  print "Remote host: ",$self->host,"\n";
  print "Remote port: ",$self->port,"\n";
}
#-------------------------------------------------------------------- GPIBbox::setHost
#help: setHost(host) sets box's host
sub setHost{
  my $self = shift;
  my ($arg) = @_;
  my @hp = split /:/,$arg;
  $self->host($hp[0]);
  if ($hp[1]>0) {
    $self->port($hp[1]);
  }
}
#-------------------------------------------------------------------- GPIBbox::setPort
#help: setPort(port) sets box's port
sub setPort{
  my $self = shift;
  my ($port) = @_;
  $self->port($port);
} 



\\__END__OF__HP33120A.pm__FILE\\
chmod 664 HP33120A.pm
echo unsharking RTFcard.pm
cat > RTFcard.pm << '\\__END__OF__RTFcard.pm__FILE\\'
#! /usr/local/bin/perl 

package RTFcard; 
#
#		RTFcard.pm
#
#	INHERITS FROM:  ElecModule
#	CONTAINS:  Control, DAC
#
#	Contains commands for setting and reading back the digital DACs and
#	controls on the RTF card.
#

require 5.002;
require ElecModule;

#use strict;
use GPIBbox;
use Control;
use DAC;

@ISA = qw( ElecModule );

my %fields = ( 
  box             => undef,
  module          => undef,
  data            => undef,
  address         => undef,
  jumpers         => undef,
  enable          => undef,
  filter          => undef,
  qlo		  => undef,
  qhi		  => undef,
  plo		  => undef,
  phi		  => undef,
  outfile         => undef,
  filename        => undef,
  Controls        => {},
  DACs            => {},
  scriptonly      => undef,
  class           => undef,
  Accumulate      => undef,
);
#
#                             Basic Functions
#
#--------------------------------------------------------------- RTFcard::new
sub new{
  my $this = shift;
  my $class = ref($this) || $this;
  my $self = ElecModule->new($_[0],$_[1],$_[2]);
  $self->{_permitted} = \%fields;
  bless $self,$class;

  $self->class("RTFcard");

  $self->filter(new Control(15,"Qo","Qi","P1","P2","P3","P4"));
  $self->filter->setAllGroupSize(2);
  $self->filter->setData("0");
  $self->enable(new Control(14,"P4","P3","P2","P1","Qo","Qi"));
  $self->enable->setData("0");

  $self->qlo  (new DAC(1,12,0,10));
  $self->qhi  (new DAC(2,12,0,10));
  $self->plo  (new DAC(3,12,0,10));
  $self->phi  (new DAC(4,12,0,10));

  $self->{Controls}->{Enable}   = $self->enable;
  $self->{Controls}->{Filter}   = $self->filter;
  $self->{DACs}->{QLow}         = $self->qlo;
  $self->{DACs}->{QHigh}        = $self->qhi;
  $self->{DACs}->{PLow}         = $self->plo;
  $self->{DACs}->{PHigh}        = $self->phi;

  my %controls = %{$self->Controls};
  my %dacs = %{$self->DACs};

  foreach $key (sort keys %controls) {
      $controls{$key}->setData(0);
  }

  foreach $key (sort keys %dacs) {
      $dacs{$key}->setValue(0);
  }

  my $host = $self->box->host;
  my $module = $self->module;
  my $subrack = $self->box->subrack;
  
  if (($self->scriptonly) == 1) {
      $host = "script";
  }

  $self->filename("/tmp/$host-$class-$subrack-$module.out");
  $self->fromFile($self->filename);

  return $self;
}
#--------------------------------------------------------------- RTFCard::init
#help: init resets registers and DACs to power-up states
sub init { 
    my $self = shift;
    my $class = ref($self) || $self;
    my $module = $self->module;

    $self->Disable;
    $self->setFilter(0);
    $self->PHiDAC(0);
    $self->PLoDAC(0);
    $self->QHiDAC(0);
    $self->QLoDAC(0);

}
#--------------------------------------------------------------- RTFcard::Disable
#help: Disable(channel)  Disable channel, Channels are: "P1", "P2", "P3", "P4", "Qi", "Qo".  Use DisableP (DisableQ) to disable all phonon (charge) channels.
sub Disable {
  my $self = shift;
  my $i=0;
  my @name = @_;
  my $comment = "RTF Disable";
  $self->enable->fromFile($self->filename);
  for ($i=0;$i<=$#name;$i++){
    $self->enable->setGroup($name[$i],0);
    $comment = "$comment" . " $name[$i]";
  }
  if ($#name<0) {          # no arguments, so disable all channels
    $self->Disable("P1","P2","P3","P4","Qo","Qi");
  } else {
    $self->writeControl($self->enable,$comment);
  }
}
#--------------------------------------------------------------- RTFcard::DisableP
sub DisableP {
  my $self = shift;
  $self->Disable("P1","P2","P3","P4");
}
#--------------------------------------------------------------- RTFcard::DisableQ
sub DisableQ {
  my $self = shift;
  $self->Disable("Qi","Qo");
}
#--------------------------------------------------------------- RTFcard::Enable
#help: Enable(channel) Enable channel, Channels are: "P1", "P2", "P3", "P4", "Qi", "Qo".  Use EnableP (EnableQ) to enable all phonon (charge) channels.
sub Enable {
  my $self = shift;
  my $i=0;
  my @name = @_;
  my $comment = "RTF Enable ";
  $self->enable->fromFile($self->filename);
  for ($i=0;$i<=$#name;$i++){
    $self->enable->setGroup($name[$i],1);
    $comment = "$comment" . " $name[$i]";
  }
  if ($#name<0) {          # no arguments, so enable all channels
    $self->Enable("P1","P2","P3","P4","Qi","Qo");
  } else {
    $self->writeControl($self->enable,$comment);
  }
} 
#--------------------------------------------------------------- RTFcard::EnableP
sub EnableP {
  my $self = shift;
  $self->Enable("P1","P2","P3","P4");
}
#--------------------------------------------------------------- RTFcard::EnableQ
sub EnableQ {
  my $self = shift;
  $self->Enable("Qo","Qi")
}
#--------------------------------------------------------------- RTFcard::setFilter
#help: setFilter(channel,number) Channels are: "P1", "P2", "P3", "P4", "Qi", "Qo".  If channel is omitted, sets all filters to number.
sub setFilter {
  my $self = shift;
  if ($#_ == 1) {
      my ($name,$value) = @_;
      my $comment = "RTF Set Filter $name to $value";
      $self->filter->fromFile($self->filename);
      $self->filter->setGroup($name,$value);
      $self->writeControl($self->filter,$comment);
  } elsif ($#_ == 0) {
      my $value = $_[0];
      $self->setFilter("P1",$value);
      $self->setFilter("P2",$value);
      $self->setFilter("P3",$value);
      $self->setFilter("P4",$value);
      $self->setFilter("Qi",$value);
      $self->setFilter("Qo",$value);
  } else {
      print "setFilter called with wrong number of arguments.\n"
  }
} 
#
#                           Write the DAC's and Thresholds
#
#--------------------------------------------------------------- RTFcard::QLoThresh
#help: QLoThresh(volts) set the low Charge threshold to volts
sub QLoThresh {
  my $self = shift;
  my ($val) = @_;
  $val = 2*$val;
  $self->QLoDAC($val);
}
#--------------------------------------------------------------- RTFcard::QHiThresh
#help: QHiThresh(volts) set the high Charge threshold to volts
sub QHiThresh {
  my $self = shift;
  my ($val) = @_;
  $val = 2*$val;
  $self->QHiDAC($val);
}
#--------------------------------------------------------------- RTFcard::PLoThresh
#help: PLoThresh(volts) set the low Phonon threshold to volts
sub PLoThresh {
  my $self = shift;
  my ($val) = @_;
  $val = 2*$val;
  $self->PLoDAC($val);
}
#--------------------------------------------------------------- RTFcard::PHiThresh
#help: PHiThresh(volts) set the high Phonon threshold to volts
sub PHiThresh {
  my $self = shift;
  my ($val) = @_;
  $val = 2*$val;
  $self->PHiDAC($val);
}
#--------------------------------------------------------------- RTFcard::QLoDAC
#help: QLoDAC(volts) set the low Charge DAC output to volts
sub QLoDAC {
  my $self = shift;
  my ($val) = @_;
  my $comment = "RTF QLoDAC to $val";
  $self->qlo->setValue($val);
  $self->writeControl($self->qlo,$comment);
}
#--------------------------------------------------------------- RTFcard::QHiDAC
#help: QHiDAC(volts) set the high Charge DAC output to volts
sub QHiDAC {
  my $self = shift;
  my ($val) = @_;
  my $comment = "RTF QHiDAC to $val";
  $self->qhi->setValue($val);
  $self->writeControl($self->qhi,$comment);
}
#--------------------------------------------------------------- RTFcard::PLoDAC
#help: PLoDAC(volts) set the low Phonon DAC output to volts
sub PLoDAC {
  my $self = shift;
  my ($val) = @_;
  my $comment = "RTF PLoDAC to $val";
  $self->plo->setValue($val);
  $self->writeControl($self->plo,$comment);
}
#--------------------------------------------------------------- RTFcard::PHiDAC
#help: PHiDAC(volts) set the high Phonon DAC output to volts
sub PHiDAC {
  my $self = shift;
  my ($val) = @_;
  my $comment = "RTF PHiDAC to $val";
  $self->phi->setValue($val);
  $self->writeControl($self->phi,$comment);
}
#




\\__END__OF__RTFcard.pm__FILE\\
chmod 664 RTFcard.pm
echo unsharking Savescript.pm
cat > Savescript.pm << '\\__END__OF__Savescript.pm__FILE\\'
#! /usr/local/bin/perl

package Savescript;
#
#		Savescript.pm
#
#	INHERITS FROM:  object
#	CONTAINS:  None
#
#	Includes 3 routines, all of which relate to creating a hex script through
#	rack.pl:  the first opens a file for writing, the second adds a single
#	line to the open script containing the formatted hex codes, and the third
#	routine closes the script.
#

require 5.002;
require object;

@ISA = qw( object );

my %fields = (
  filename     => undef,
  isOpen       => undef,
  class        => undef,
  subrack      => undef,
  module       => undef,
	      );
#
#
#-------------------------------------------------------------- Savescript::new
sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my $self = object->new;
    $self->{_permitted} = \%fields;
    bless $self,$class;

    my(@Fld) = @_;
    split @Fld;
    $self->filename($Fld[0]);
    $self->isOpen(undef);
    return $self;
}
#-------------------------------------------------------------- Savescript::OpenFile
sub openFile {
    my $self = shift;
    my $answer = $_[0];
    my $class = $_[1];
    my $delfile = undef;
    if (($self->isOpen) eq "1") {
	$self->CloseFile();
    }
    if (-e $self->filename) {
	unless (defined($answer)) {
	   print "Please type \n1 if you wish to continue with existing ", 
	       $self->filename,",\n2 if you wish to overwrite existing ",
               $self->filename,",\nor 3 to cancel: ";
	   chomp($answer = <STDIN>);
	}
	if ($answer eq "1") {
	    $filename = $self->filename;
	} elsif ($answer eq "2") {
	    $delfile = $self->filename;
	    unlink("$delfile");
	    $filename = $self->filename;
	} else {
	    print "Cancelling Savescript now.\n";
	    return;
	}
    }
    $filename = $self->filename;
    open(OUTFILE,">>$filename") or die "Can't open $filename, $!\n";
    $self->isOpen("1");
}

#-------------------------------------------------------------- Savescript::AddLine
sub AddLine {
    my $self = shift;
    if ($#_ < 3) {
	die "AddLine called with too few arguments.\n";
    }
    if ($#_ > 5) {
	print "AddLine called with too many arguments.\n";
    }
    $_[0] =~ s/\s//g;
    $_[1] =~ s/\s//g;
    $_[2] =~ s/\s//g;
    my $subrack = hex($_[0]);
    $subrack = sprintf("%04x",$subrack);
    my $address = hex($_[1]);
    $address = sprintf("%04x",$address);
    my $data = hex($_[2]);
    $data = sprintf("%04x",$data);
    my $readwrite = $_[3];
    my $comment = $_[4];
    print OUTFILE "$subrack\t$address\t$data\t$readwrite\t\% $comment\n";
}
#-------------------------------------------------------------- Savescript::CloseFile
sub CloseFile {
    my $self = shift;
    if ($self->isOpen eq "1") {
	close(OUTFILE);
	$self->isOpen(undef);
    } else { 
	print "Nothing to close, no script is open.\n";
    }
}


\\__END__OF__Savescript.pm__FILE\\
chmod 664 Savescript.pm
echo unsharking ServerConnection.pm
cat > ServerConnection.pm << '\\__END__OF__ServerConnection.pm__FILE\\'
#! /usr/local/bin/perl -w

package ServerConnection;
#
#               ServerConnection.pm
#
#       INHERITS FROM:  Connection
#       CONTAINS:  None
#
#	This package handles all of the communication for sending/receiving
#	ints and strings from a TCP/IP connection.  It contains routines for opening and 
#	closing the socket connection, sending the datastrings to the server
#	and for reading datastrings from the server.
#

require 5.002;
require object;
require Connection;

use Socket;
use Carp;

@ISA = qw( Connection );
#@ISA = qw( object );

my %fields = (
  port => undef,
  sock => undef,
);

#-------------------------------------------------------------------- ServerConnection::new
sub new{
  my $this = shift;
  my $class = ref($this) || $this;
#  my $self = Connection->new;
  my $self = object->new;
  $self->{_permitted} = \%fields;
  bless $self,$class;

  $self->port(2345);

  my ($p) = @_;
  $self->port($p);
  return $self;
}

#-------------------------------------------------------------------- ServerConnection::print
#help: print(void) prints selected information about connection
sub print{
  my $self = shift;
  print "Remote port: ",$self->port,"\n";
}
#----------------------------------------------------------------- ServerConnection::openSocket
#help: openSocket(void) opens socket connection for a Client.
sub openSocket{
  my $self = shift;
  my $port = $self->port;
  my $proto  = getprotobyname('tcp');
  die "No port" unless $port;
  my $tryagain = 0; my $attempts = 0; my $maxAttempts = 20;
  socket(Server,PF_INET,SOCK_STREAM,$proto) or die "socket: $!";
  setsockopt(Server,SOL_SOCKET,SO_REUSEADDR, pack("l",1)) 
     or die "setsockopt: $!";
  bind(Server,sockaddr_in($port, INADDR_ANY)) or die "bind: $!";
  listen(Server,SOMAXCONN)                    or die "listen: $!";
  $self->acceptConnection();
  return;
}
 
#----------------------------------------------------------- ServerConnection::acceptConnection
sub acceptConnection{
  my $self = shift;
  $SIG{CHLD} = \&REAPER;
  my $paddr = accept(SOCK,Server);               # attach connection to SOCK;
  my ($port,$iaddr) = sockaddr_in($paddr);
  my $name = gethostbyaddr($iaddr,AF_INET);
  print "Connection from $name [",inet_ntoa($iaddr),"] at port $port\n";
#  print "Connection from $name at port $port\n";
  $self->setSock(\*SOCK);
}

#-------------------------------------------------------------------- Connection::setSock
#help: setSock(sockfh) sets SOCK filehandle
sub setSock{
  my $self = shift;
  my ($s) = shift;
  $self->sock($s);
}

\\__END__OF__ServerConnection.pm__FILE\\
chmod 664 ServerConnection.pm
echo unsharking ZIPcard.pm
cat > ZIPcard.pm << '\\__END__OF__ZIPcard.pm__FILE\\'
#! /usr/local/bin/perl

package ZIPcard;
#
#		ZIPcard.pm
#
#	INHERITS FROM:  ElecModule
#	CONTAINS:  ZIPdriver, ZIPqbias, ZIPqet, ZIPsquid
#
#	Contains commands for setting and reading back the digital DACs and
#	controls on the ZIP card.
#

require 5.002;
require ElecModule;

use ZIPsquid;
use ZIPdriver;
use ZIPqbias;
use ZIPqet;

@ISA = qw( ElecModule );

my %fields = (
	      box          => undef,
	      module       => undef,
	      data         => undef,
	      address      => undef,
	      filename     => undef,
	      outfile      => undef,
	      scriptonly   => undef,
	      jumpers      => undef,
	      Controls     => {},
	      DACs         => {},
	      squid        => {},
	      driver       => undef,
	      qbias        => undef,
	      qet          => undef,
	      class        => undef,
	      Accumulate   => undef,
	      );
#
#                              Basic Functions
#
#----------------------------------------------------------------- ZIP::new
sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my $self = ElecModule->new($_[0],$_[1],$_[2]);
    $self->{_permitted} = \%fields;
    bless $self,$class;

    my $host = $self->box->host;
    my $subrack = $self->box->subrack;
    my $module = $self->module;
    
    if (($self->scriptonly) == 1) {
	$host = "script";
    }

    $self->filename("/tmp/$host-$class-$subrack-$module.out");
    $self->class("ZIPcard");

    $self->{squid}->{a} = new ZIPsquid(10,$self->filename);
    $self->{squid}->{b} = new ZIPsquid(11,$self->filename);
    $self->{squid}->{c} = new ZIPsquid(12,$self->filename);
    $self->{squid}->{d} = new ZIPsquid(13,$self->filename);

    $self->driver(new ZIPdriver(6,$self->filename));
    $self->qet(new ZIPqet(14,$self->filename));
    $self->qbias(new ZIPqbias(3,$self->filename));

#       Set up complete hash Controls

    $self->{Controls}->{SquidAZapControl}  = $self->{squid}->{a}->zapper;

    $self->{Controls}->{SquidBZapControl}  = $self->{squid}->{b}->zapper;

    $self->{Controls}->{SquidCZapControl}  = $self->{squid}->{c}->zapper;

    $self->{Controls}->{SquidDZapControl}  = $self->{squid}->{d}->zapper;

    $self->{Controls}->{QBiasLED1}         = $self->qbias->firstLED;
    $self->{Controls}->{QBiasLED2}         = $self->qbias->secondLED;

    $self->{Controls}->{QETheater}         = $self->qet->heater;

    $self->{Controls}->{Gains1}            = $self->driver->gains1;
    $self->{Controls}->{Gains2}            = $self->driver->gains2;

#      Set up complete hash DACs

    $self->{DACs}->{SquidABias}       = $self->{squid}->{a}->bias;
    $self->{DACs}->{SquidAGain}       = $self->{squid}->{a}->gain;
    $self->{DACs}->{SquidAOffset}     = $self->{squid}->{a}->offset;

    $self->{DACs}->{SquidBBias}       = $self->{squid}->{b}->bias;
    $self->{DACs}->{SquidBGain}       = $self->{squid}->{b}->gain;
    $self->{DACs}->{SquidBOffset}     = $self->{squid}->{b}->offset;

    $self->{DACs}->{SquidCBias}       = $self->{squid}->{c}->bias;
    $self->{DACs}->{SquidCGain}       = $self->{squid}->{c}->gain;
    $self->{DACs}->{SquidCOffset}     = $self->{squid}->{c}->offset;

    $self->{DACs}->{SquidDBias}       = $self->{squid}->{d}->bias;
    $self->{DACs}->{SquidDGain}       = $self->{squid}->{d}->gain;
    $self->{DACs}->{SquidDOffset}     = $self->{squid}->{d}->offset;

    $self->{DACs}->{QinBias}          = $self->qbias->Qibias;
    $self->{DACs}->{QoutBias}         = $self->qbias->Qobias;
    $self->{DACs}->{LED1Bias}         = $self->qbias->LED1bias;
    $self->{DACs}->{LED2Bias}         = $self->qbias->LED2bias;

    $self->{DACs}->{QETBiasA}         = $self->qet->{bias}->{a};
    $self->{DACs}->{QETBiasB}         = $self->qet->{bias}->{b};
    $self->{DACs}->{QETBiasC}         = $self->qet->{bias}->{c};
    $self->{DACs}->{QETBiasD}         = $self->qet->{bias}->{d};

    $self->{DACs}->{Offset0}          = $self->driver->{offset}->[0];
    $self->{DACs}->{Offset1}          = $self->driver->{offset}->[1];
    $self->{DACs}->{Offset2}          = $self->driver->{offset}->[2];
    $self->{DACs}->{Offset3}          = $self->driver->{offset}->[3];
    $self->{DACs}->{Offset4}          = $self->driver->{offset}->[4];
    $self->{DACs}->{Offset5}          = $self->driver->{offset}->[5];

#          Persistence loadup

    $self->fromFile($self->filename);

    return $self;
}
#----------------------------------------------------------------- ZIP::init
#help: init(void) resets memory to startup state of card
sub init {
    my $self = shift;
    my %controls = %{$self->Controls};
    my %dacs = %{$self->DACs};
    foreach $key (sort keys %controls) {
	$controls{$key}->setData(0);
    }
    foreach $key (sort keys %dacs) {
	$dacs{$key}->setValue(0);
    }
    $self->toFile($self->filename);
}
#----------------------------------------------------------------- ZIP::printSQUID
#help: printSQUID(channel) prints information about squid channel section
sub printSQUID {
    my $self = shift;
    my @channels = @_;
    $self->fromFile($self->filename);
    if ($#_ <0) {
	@channels = (a,b,c,d);
    }
    my $i = 0;
    for ($i=0;$i<=$#channels;$i++) {
	$self->{squid}->{$channels[$i]}->print($channels[$i]);
    }
}
#----------------------------------------------------------------- ZIP::printQET
#help: printQET(void) prints information about qet section
sub printQET {
    my $self = shift;
    $self->fromFile($self->filename);
    $self->qet->print;
}
#----------------------------------------------------------------- ZIP::printQBias
#help: printQBias(void) prints information about qbias section
sub printQBias {
    my $self = shift;
    $self->fromFile($self->filename);
    $self->qbias->print;
}
#----------------------------------------------------------------- ZIP::printDriver
#help: printDriver(void) prints information about driver section
sub printDriver {
    my $self = shift;
    $self->fromFile($self->filename);
    $self->driver->print;
}
#
#                              Squid Control Registers
#
#----------------------------------------------------------------- ZIP::openfb
#help: openfb(channel) sets squid on channel to calibration mode. If channel is omitted, sets all channels
sub openfb {
    my $self = shift;
    my @channel = undef;
    my $val = 1;
    my $comment = undef;
    if ($#_ < 0) {
	@channel = (a,b,c,d);
    } else {
	@channel = @_;
    } 
    for ($i=0;$i<=$#channel;$i++) {
	 $comment = "ZIP Squid $channel[$i] open feedback";
#	 if (($self->scriptonly) != 1) {
#	     $self->readSQUIDZapper($channel[$i]);
#	 } else {
	     $self->{squid}->{$channel[$i]}->zapper->fromFile($self->filename);
#	 }
	 $self->{squid}->{$channel[$i]}->zapper->setGroup("cal",$val);
	 $self->writeControl($self->{squid}->{$channel[$i]}->zapper,$comment);
     }
}
#----------------------------------------------------------------- ZIP::closefb
#help: closefb(channel) sets squid on channel to measure mode. If channel is omitted, sets all channels
sub closefb {
    my $self = shift;
    my @channel = undef;
    my $val = 0;
    my $comment = undef;
    if ($#_ < 0) {
	@channel = (a,b,c,d);
    } else {
	@channel = @_;
    } 
    for ($i=0;$i<=$#channel;$i++) {
	$comment = "ZIP Squid $channel[$i] close feedback";
#	if (($self->scriptonly) != 1) {
#	     $self->readSQUIDZapper($channel[$i]);
#	} else {
	     $self->{squid}->{$channel[$i]}->zapper->fromFile($self->filename);
#	}
	$self->{squid}->{$channel[$i]}->zapper->setGroup("cal",$val);
	$self->writeControl($self->{squid}->{$channel[$i]}->zapper,$comment);
    }
}
#----------------------------------------------------------------- ZIP::SynchZapMode
#help: SynchZapMode(channel) sets squid on channel to synchronous mode. If channel is omitted, sets all channels
sub SynchZapMode {
    my $self = shift;
    my @channel = undef;
    my $val = 1;
    my $comment = undef;
    if ($#_ < 0) {
	@channel = (a,b,c,d);
    } else {
	@channel = @_
    }
    for ($i=0;$i<=$#channel;$i++) {
	$comment = "ZIP Squid $channel[$i] synch mode";
#	if (($self->scriptonly) != 1) {
#	     $self->readSQUIDZapper($channel[$i]);
#	} else {
	    $self->{squid}->{$channel[$i]}->zapper->fromFile($self->filename);
#	}
	$self->{squid}->{$channel[$i]}->zapper->setGroup("mode",$val);
	$self->writeControl($self->{squid}->{$channel[$i]}->zapper,$comment);
    }
}
#----------------------------------------------------------------- ZIP::ASynchZapMode
#help: ASynchZapMode(channel) sets squid on channel to asynchronous mode. If channel is omitted, sets all channels
sub ASynchZapMode {
    my $self = shift;
    my @channel = undef;
    my $val = 0;
    my $comment = undef;
    if ($#_ < 0) {
	@channel = (a,b,c,d);
    } else {
	@channel = @_
    }
    for ($i=0;$i<=$#channel;$i++) {
	$comment = "ZIP Squid $channel[$i] asynch mode";
#	if (($self->scriptonly) != 1) {
#	     $self->readSQUIDZapper($channel[$i]);
#	} else {
	    $self->{squid}->{$channel[$i]}->zapper->fromFile($self->filename);
#	}
	$self->{squid}->{$channel[$i]}->zapper->setGroup("mode",$val);
	$self->writeControl($self->{squid}->{$channel[$i]}->zapper,$comment);
    }
}
#----------------------------------------------------------------- ZIP::ZapWidthIndex
sub ZapWidthIndex {
    my $self = shift;
    my $channel = undef;
    my $index = undef;
    if ($#_ == 0) {
	$index = $_[0];
	$self->ZapWidthIndex("a",$index);
	$self->ZapWidthIndex("b",$index);
	$self->ZapWidthIndex("c",$index);
	$self->ZapWidthIndex("d",$index);
	return;
    } elsif ($#_ == 1) {
	$channel = $_[0];
	$index = $_[1];
    } else {
	print "Incorrect number of arguments\n";
	return;
    }
    my $unit = 100;                               # unit of width
    my $val = $unit * ($index + 1);
    my $comment = "ZIP Squid $channel width bits to $index, value to $val";
#    if (($self->scriptonly) != 1) {
#	 $self->readSQUIDZapper($channel[$i]);
#    } else {
	$self->{squid}->{$channel}->zapper->fromFile($self->filename);
#    }
    $self->{squid}->{$channel}->zapper->setGroup("zapwidth",$index);
    $self->writeControl($self->{squid}->{$channel}->zapper,$comment);
}    
#----------------------------------------------------------------- ZIP::ZapWidth
#help: ZapWidth(channel,value) sets width for ZAP on channel to nearest possible width that is smaller than input value (in units of ms). If channel is omitted, sets all channels
sub ZapWidth {
    my $self = shift;
    my $channel = undef;
    my $index = undef;
    my $unit = 100;                          #set units of width
    my $val = undef;
    if ($#_ == 0) {
	$val = $_[0];
	$self->ZapWidth("a",$val);
	$self->ZapWidth("b",$val);
	$self->ZapWidth("c",$val);
	$self->ZapWidth("d",$val);
	return;
    } elsif ($#_ == 1) {
	$channel = $_[0];
	$val = $_[1];
    } else {
	print "Incorrect number of arguments\n";
	return;
    }
    $index = (int($val/$unit) - 1);
    if ($index > 15) {
	print "Max value is 1600 ms, setting to that\n";
	$index = 15;
    } elsif ($index < 0) {
	print "Min value is 100 ms, setting to that\n";
	$index = 0;
    }
    $self->ZapWidthIndex($channel,$index);
}
#----------------------------------------------------------------- ZIP::armZapSQUID
#help: armZapSQUID(channel) arms squid on channel. If channel is omitted, arms all channels
sub armZapSQUID {
    my $self = shift;
    my @channel = undef;
    my $val = 1;
    my $comment = undef;
    if ($#_ < 0) {
	@channel = (a,b,c,d);
    } else {
	@channel = @_;
    } 
    for ($i=0;$i<=$#channel;$i++) {
	$comment = "ZIP Squid arm $channel[$i]";
#	if (($self->scriptonly) != 1) {
#	     $self->readSQUIDZapper($channel[$i]);
#	} else {
	    $self->{squid}->{$channel[$i]}->zapper->fromFile($self->filename);
#	}
	$self->{squid}->{$channel[$i]}->zapper->setGroup("armzap",$val);
	$self->{squid}->{$channel[$i]}->zapper->setGroup("armed",$val);
	$self->{squid}->{$channel[$i]}->zapper->setGroup("disarm",0);
	$self->writeControl($self->{squid}->{$channel[$i]}->zapper,$comment);
    }
}
#----------------------------------------------------------------- ZIP::disarmZapSQUID
#help: disarmZapSQUID(channel) disarms squid on channel. If channel is omitted, disarms all channels
sub disarmZapSQUID {
    my $self = shift;
    my @channel = undef;
    my $val = 1;
    my $comment = undef;
    if ($#_ < 0) {
	@channel = (a,b,c,d);
    } else {
	@channel = @_;
    }
    for ($i=0;$i<=$#channel;$i++) {
	$comment = "ZIP Squid disarm $channel[$i]";
#	if (($self->scriptonly) != 1) {
#	     $self->readSQUIDZapper($channel[$i]);
#	} else {
	    $self->{squid}->{$channel[$i]}->zapper->fromFile($self->filename);
#	}
	$self->{squid}->{$channel[$i]}->zapper->setGroup("disarm",$val);
	$self->{squid}->{$channel[$i]}->zapper->setGroup("armzap",0);
	$self->{squid}->{$channel[$i]}->zapper->setGroup("armed",0);
	$self->writeControl($self->{squid}->{$channel[$i]}->zapper,$comment);
    }
}
#----------------------------------------------------------------- ZIP::Zeroarm
#help: Zeroarm(channel) zeros both arm and disarm bits on Squid channel
sub Zeroarm {
    my $self = shift;
    my @channel = undef;
    my $val = 0;
    my $comment = undef;
    if ($#_ < 0) {
	@channel = (a,b,c,d);
    } else {
	@channel = @_;
    }
    for ($i=0;$i<=$#channel;$i++) {
	$comment = "ZIP Squid zeroarm $channel[$i]";
#	if (($self->scriptonly) != 1) {
#	     $self->readSQUIDZapper($channel[$i]);
#	} else {	
	    $self->{squid}->{$channel[$i]}->zapper->fromFile($self->filename);
#	}
	$self->{squid}->{$channel[$i]}->zapper->setGroup("disarm",$val);
	$self->{squid}->{$channel[$i]}->zapper->setGroup("armzap",$val);
	$self->{squid}->{$channel[$i]}->zapper->setGroup("armed",$val);
	$self->writeControl($self->{squid}->{$channel[$i]}->zapper,$comment);
    }
}
#----------------------------------------------------------------- ZIP::armed
#help: armed(channel) reads zapper CSR and tells whether the ZAP is armed; updates variables.  If channel is omitted, checks all channels.  Will accept more than one channel.
sub armed {
    my $self = shift;
    my @channel = undef;
    my $val = undef;
    my $comment = undef;
    my @bits = undef;
    my $test = undef;
    if ($#_ == -1) {
	@channel = (a,b,c,d);
    } else {
	@channel = @_;
    }
    for ($i=0;$i<=$#channel;$i++) {
	$comment = "ZIP Squid $channel[$i] armed";
	$self->{squid}->{$channel[$i]}->zapper->fromFile($self->filename);
	$bits[$i] = $self->readControl($self->{squid}->{$channel[$i]}->zapper,
				       $comment);
	$self->{squid}->{$channel[$i]}->zapper->setData($bits[$i]);
	$bits[$i] =~ s/ //;
	$test = hex($bits[$i]) & 256;
	if ($test > 0) {
	    print "ZAP on channel $channel[$i] armed\n";
	} else {
	    print "ZAP on channel $channel[$i] disarmed\n";
	}
    }
}
#----------------------------------------------------------------- ZIP::polposSQUID
#help: polposSQUID(channel) puts squid on channel to positive polarity. If channel is omitted, does so for all channels
sub polposSQUID {
    my $self = shift;
    my @channel = undef;
    my $val = 1;
    my $comment = undef;
    if ($#_ < 0) {
	@channel = (a,b,c,d);
    } else {
	@channel = @_;
    }
    for ($i=0;$i<=$#channel;$i++) {
	$comment = "ZIP Squid polarity on $channel[$i] to positive";
#	if (($self->scriptonly) != 1) {
#	     $self->readSQUIDZapper($channel[$i]);
#	} else {
	    $self->{squid}->{$channel[$i]}->zapper->fromFile($self->filename);
#	}
	$self->{squid}->{$channel[$i]}->zapper->setGroup("pola",$val);
	$self->{squid}->{$channel[$i]}->zapper->setGroup("polb",0);
	$self->writeControl($self->{squid}->{$channel[$i]}->zapper,$comment);
    }
}
#----------------------------------------------------------------- ZIP::polnegSQUID
#help: polnegSQUID(channel) puts squid on channel to negative polarity. If channel is omitted, does so for all channels
sub polnegSQUID {
    my $self = shift;
    my @channel = undef;
    my $val = 1;
    my $comment = undef;
    if ($#_ < 0) {
	@channel = (a,b,c,d);
    } else {
	@channel = @_;
    } 
    for ($i=0;$i<=$#channel;$i++) {
	$comment = "ZIP Squid polarity on $channel[$i] to negative";
#	if (($self->scriptonly) != 1) {
#	     $self->readSQUIDZapper($channel[$i]);
#	} else {
	    $self->{squid}->{$channel[$i]}->zapper->fromFile($self->filename);
#	}
	$self->{squid}->{$channel[$i]}->zapper->setGroup("polb",$val);
	$self->{squid}->{$channel[$i]}->zapper->setGroup("pola",0);
	$self->writeControl($self->{squid}->{$channel[$i]}->zapper,$comment);
    }
}
#----------------------------------------------------------------- ZIP::Zeropol
#help Zeropol(channel) zeros both polarity bits on Squid channel
sub Zeropol {
    my $self = shift;
    my @channel = undef;
    my $val = 0;
    my $comment = undef;
    if ($#_ < 0) {
	@channel = (a,b,c,d);
    } else {
	@channel = @_;
    } 
    for ($i=0;$i<=$#channel;$i++) {
	$comment = "ZIP Squid zero polarity on $channel[$i]";
#	if (($self->scriptonly) != 1) {
#	     $self->readSQUIDZapper($channel[$i]);
#	} else {
	    $self->{squid}->{$channel[$i]}->zapper->fromFile($self->filename);
#	}
	$self->{squid}->{$channel[$i]}->zapper->setGroup("polb",$val);
	$self->{squid}->{$channel[$i]}->zapper->setGroup("pola",$val);
	$self->writeControl($self->{squid}->{$channel[$i]}->zapper,$comment);
    }
}
#----------------------------------------------------------------- ZIP::ZapVolt
#help: ZapVolt(channel,voltage) sets voltage on channel ZAP.  If channel is omitted, sets all channels.  Possible voltages are 0, 1.25, 2.5, 3.75 sets to closest lower value
sub ZapVolt {
    my $self = shift;
    my $val = undef;
    my $channel = undef;
    my $newindex;
    my @volts = (0,1.25,2.5,3.75);
    if ($#_ == 0) {
	$val = $_[0];
	$self->ZapVolt("a",$val);
	$self->ZapVolt("b",$val);
	$self->ZapVolt("c",$val);
	$self->ZapVolt("d",$val);
	return;
    } elsif ($#_ == 1) {
	$channel = $_[0];
	$val = $_[1];
    } else {
	print "Incorrect number of arguments\n";
	return;
    }
    for ($i=0;$i<=$#volts;$i++) {
	if ($val>=$volts[$i]) {
	    $newindex = $i;
	}
    }
    $self->ZapVoltIndex($channel,$newindex);
}
#----------------------------------------------------------------- ZIP::ZapVoltIndex
sub ZapVoltIndex {
    my $self = shift;
    my $index = undef;
    my $channel = undef;
    my @volts = (0,1.25,2.5,3.75);
    if ($#_ == 0) {
	$index = $_[0];
	$self->ZapVoltIndex("a",$index);
	$self->ZapVoltIndex("b",$index);
	$self->ZapVoltIndex("c",$index);
	$self->ZapVoltIndex("d",$index);
	return;
    } elsif ($#_ == 1) {
	$channel = $_[0];
	$index = $_[1];
    } else {
	print "Incorrect number of arguments\n";
	return;
    }
    my $comment = "ZIP set ZAP voltage on channel $channel to $volts[$index]";
#    if (($self->scriptonly) != 1) {
#	$self->readSQUIDZapper($channel[$i]);
#    } else {
	$self->{squid}->{$channel}->zapper->fromFile($self->filename);
#    }
    $self->{squid}->{$channel}->zapper->setGroup("zapvoltage",$index);
    $self->writeControl($self->{squid}->{$channel}->zapper,$comment);
}
#----------------------------------------------------------------- ZIP::readSQUIDZapper
#help: readSQUIDZapper(channel) reads the Zapper CSR on squid channel
sub readSQUIDZapper {
    my $self = shift;
    my @channel = undef;
    my $comment = undef;
    my $bits = undef;
    my $ret = undef;
    if ($#_ < 0) {
	@channel = (a,b,c,d);
    } else {
	@channel = @_;
    }
    for ($i=0;$i<=$#channel;$i++) {
	$comment = "ZIP read Squid Zapper $channel[$i]";
	$bits = $self->readControl($self->{squid}->{$channel[$i]}->zapper,
				   $comment);
	$self->{squid}->{$channel[$i]}->zapper->setData($bits);
	$ret = $i;
    }
    $self->toFile($self->filename);
    return $self->{squid}->{$channel[$ret]}->zapper->data;
}
#----------------------------------------------------------------- ZIP::readSQUID
#help: readSQUID(channel) reads all DACs and CSRsfor squid channel.  If channel is omitted, reads all channels.
sub readSQUID {
    my $self = shift;
    my @channel = undef;
    if ($#_ >= 0) {
	@channel = @_;
    } else {
	@channel = ("a","b","c","d");
    }
    $self->readSQUIDZapper(@channel);
    $self->readSQUIDDAC(@channel);
}
#
#                              Squid DACs
#
#----------------------------------------------------------------- ZIP::setSQUIDbias
#help: setSQUIDbias(channel,value) sets bias on squid channel to value in volts.  If channel is omitted, sets all four channels.  Channels are "a","b","c","d".
sub setSQUIDbias {
    my $self = shift;
    my $channel = 0;
    my $val = 0;
    if ($#_ == 1) {
	$channel = $_[0];
	$val = $_[1];
    } elsif ($#_ == 0) {
	$val = $_[0];
	$self->setSQUIDbias("a",$val);
	$self->setSQUIDbias("b",$val);
	$self->setSQUIDbias("c",$val);
	$self->setSQUIDbias("d",$val);
	return;
    }
    my $comment = "ZIP set squid $channel bias to $val";
    $self->{squid}->{$channel}->bias->setValue($val);
    $self->writeControl($self->{squid}->{$channel}->bias,$comment);
}
#----------------------------------------------------------------- ZIP::setSQUIDolgain
#help: setSQUIDolgain(channel,value) sets gain on squid channel to value in volts.  If channel is omitted, sets all four channels.  Channels are "a","b","c","d".
sub setSQUIDolgain {
    my $self = shift;
    my $channel = 0;
    my $val = 0;
    if ($#_ == 1) {
	$channel = $_[0];
	$val = $_[1];
    } elsif ($#_ == 0) {
	$val = $_[0];
	$self->setSQUIDolgain("a",$val);
	$self->setSQUIDolgain("b",$val);
	$self->setSQUIDolgain("c",$val);
	$self->setSQUIDolgain("d",$val);
	return;
    }
    my $comment = "ZIP set squid $channel olgain to $val";
    $self->{squid}->{$channel}->gain->setValue($val);
    $self->writeControl($self->{squid}->{$channel}->gain,$comment);
}
#----------------------------------------------------------------- ZIP::setLockPoint
#help: setLockPoint(channel,value) sets offset on squid channel to value in volts.  If channel is omitted, sets all four channels.  Channels are "a","b","c","d".
sub setLockPoint {
    my $self = shift;
    my $channel = 0;
    my $val = 0;
    if ($#_ == 1) {
	$channel = $_[0];
	$val = $_[1];
    } elsif ($#_ == 0) {
	$val = $_[0];
	$self->setLockPoint("a",$val);
	$self->setLockPoint("b",$val);
	$self->setLockPoint("c",$val);
	$self->setLockPoint("d",$val);
	return;
    }
    my $comment = "ZIP set squid $channel lock point to $val";
    $self->{squid}->{$channel}->offset->setValue($val);
    $self->writeControl($self->{squid}->{$channel}->offset,$comment);
}
#----------------------------------------------------------------- ZIP::readSQUIDbias
#help: readSQUIDbias(channel) reads bias on squid channel.  If channel is omitted, reads all four channels.  Channels are "a","b","c","d".
sub readSQUIDbias {
    my $self = shift;
    my @channel = 0;
    my $comment = undef;
    my $bits = undef;
    my $value = undef;
    my $ret = undef;
    if ($#_ >= 0) {
	@channel = @_;
    } else {
	@channel = ("a","b","c","d");
    }
    for ($i=0;$i<=$#channel;$i++) {
	$comment = "ZIP read squid $channel[$i] bias";
	$bits = $self->readControl($self->{squid}->{$channel[$i]}->bias,
				   $comment);
	$self->{squid}->{$channel[$i]}->bias->setData($bits);
	$self->toFile($self->filename);
	$ret = $i;
    }
    return $self->{squid}->{$channel[$ret]}->bias->value;
}
#----------------------------------------------------------------- ZIP::readSQUIDolgain
#help: readSQUIDolgain(channel) reads gain on squid channel.  If channel is omitted, reads all four channels.  Channels are "a","b","c","d".
sub readSQUIDolgain {
    my $self = shift;
    my @channel = undef;
    my $comment = undef;
    my $bits = undef;
    my $ret = undef;
    if ($#_ >= 0) {
	@channel = @_;
    } else {
	@channel = ("a","b","c","d");
    }
    for ($i=0;$i<=$#channel;$i++) {
	$comment = "ZIP read squid $channel[$i] olgain";
	$bits = $self->readControl($self->{squid}->{$channel[$i]}->gain,
				      $comment);
	$self->{squid}->{$channel[$i]}->gain->setData($bits);
	$self->toFile($self->filename);
	$ret = $i;
    }
    return $self->{squid}->{$channel[$ret]}->gain->value;
}
#----------------------------------------------------------------- ZIP::readLockPoint
#help: readLockPoint(channel) reads offset on squid channel.  If channel is omitted, reads all four channels.  Channels are "a","b","c","d".
sub readLockPoint {
    my $self = shift;
    my @channel = undef;
    my $comment = undef;
    my $bits = undef;
    my $ret = undef;
    if ($#_ >= 0) {
	@channel = @_;
    } else {
	@channel = ("a","b","c","d");
    }
    for ($i=0;$i<=$#channel;$i++) {
	$comment = "ZIP read squid $channel[$i] lock point";
	$bits = $self->readControl($self->{squid}->{$channel[$i]}->offset,
				   $comment);
	$self->{squid}->{$channel[$i]}->offset->setData($bits);
	$self->toFile($self->filename);
	$ret = $i;
    }
    return $self->{squid}->{$channel[$ret]}->offset->value;
}
#----------------------------------------------------------------- ZIP::readSQUIDDAC
#help: readSQUIDDAC(channel) reads all DACs for squid channel.  If channel is omitted, reads all channels.
sub readSQUIDDAC {
    my $self = shift;
    my @channel = undef;
    if ($#_ >= 0) {
	@channel = @_;
    } else {
	@channel = ("a","b","c","d");
    }
    $self->readSQUIDbias(@channel);
    $self->readSQUIDolgain(@channel);
    $self->readLockPoint(@channel);
}    
#
#                              QET Control Registers
#
#----------------------------------------------------------------- ZIP::IVMode
#help: IVMode(channel) set PHi channel to calibration mode.  If channel is omitted sets all channels to calibrate
sub IVMode {
    my $self = shift;
    my @channel = undef;
    my $val = 1;
    if ($#_ < 0) {
	@channel = (a,b,c,d);
    } else {
	@channel = @_;
    }
    my $comment = "ZIP IV mode on";
    $self->qet->heater->fromFile($self->filename);
    for ($i=0;$i<=$#channel;$i++) {
	$comment = $comment . " $channel[$i]";
	$self->qet->heater->setGroup("phical$channel[$i]",$val);
    }
    $self->writeControl($self->qet->heater,$comment);
}
#----------------------------------------------------------------- ZIP::BiasMode
#help: BiasMode(channel) set PHi channel to measure mode.  If channel is omitted sets all channels to measure
sub BiasMode {
    my $self = shift;
    my @channel = undef;
    my $val = 0;
    if ($#_ < 0) {
	@channel = (a,b,c,d);
    } else {
	@channel = @_;
    }
    my $comment = "ZIP bias mode on"; 
    $self->qet->heater->fromFile($self->filename);
    for ($i=0;$i<=$#channel;$i++) {
	$comment = $comment . " $channel[$i]";
	$self->qet->heater->setGroup("phical$channel[$i]",$val);
    }
    $self->writeControl($self->qet->heater,$comment);
}
#----------------------------------------------------------------- ZIP::EnableHeat
#help: EnableHeat(channels) enables heater channel. Channels are "a","b","c","d".  If channel is omitted, enables all heaters.
sub EnableHeat {
    my $self = shift;
    my @name = @_;
    my $val = 1;
    my $comment = "ZIP Enable Heater ";
    if ($#_ < 0) {
	@name = (a,b,c,d);
    } 
    $self->qet->heater->fromFile($self->filename);
    for ($i=0;$i<=$#name;$i++) {
	$self->qet->heater->setGroup("enableheat$name[$i]",$val);
	$comment = "$comment" . " $name[$i]";
    }
    $self->writeControl($self->qet->heater,$comment);
}
#----------------------------------------------------------------- ZIP::DisableHeat
#help: DisableHeat(channels) disables heater channel. Channels are "a","b","c","d".  If channel is omitted, disables all heaters.
sub DisableHeat {
    my $self = shift;
    my @name = @_;
    my $val = 0;
    my $comment = "ZIP Disable Heater ";
    if ($#_ < 0) {
	@name = (a,b,c,d);
    } 
    $self->qet->heater->fromFile($self->filename);
    for ($i=0;$i<=$#name;$i++) {
	$self->qet->heater->setGroup("enableheat$name[$i]",$val);
	$comment = "$comment" . " $name[$i]";
    }
    $self->writeControl($self->qet->heater,$comment);
}
#----------------------------------------------------------------- ZIP::HeaterWidthIndex
sub HeaterWidthIndex {
    my $self = shift;
    my $index = $_[0];
    my $unit = 100;                           # units for heater width
    my $width = ($index + 1)* $unit;
    my $comment = "ZIP Heater index to $index, width to $width";
    $self->qet->heater->fromFile($self->filename);
    $self->qet->heater->setGroup("heatwidth",$index);
    $self->writeControl($self->qet->heater,$comment);
}
#----------------------------------------------------------------- ZIP::HeaterWidth
#help: HeaterWidth(width) sets qet heater width to nearest possible value to width that is less than input value
sub HeaterWidth {
    my $self = shift;
    my $width = $_[0];
    my $unit = 100;                           # units for heater width
    my $index = (int($width/$unit) - 1);
    if ($index > 15) {
	print "Max heater width is 1600 ms, setting to that\n";
	$index = 15;
    } elsif ($index < 0) {
	print "Min heater width is 100 ms, setting to that\n";
	$index = 0;
    }
    $self->HeaterWidthIndex($index);
}
#----------------------------------------------------------------- ZIP::readHeater
#help: readHeater(void) reads back CSR on QET section and updates memory
sub readHeater {
    my $self = shift;
    my $bits = undef;
    my $comment = "ZIP read heater CSR";
    $bits = $self->readControl($self->qet->heater,$comment);
    $self->qet->heater->setData($bits);
    $self->toFile($self->filename);
    return $self->qet->heater->data;
}
#----------------------------------------------------------------- ZIP::readQET
#help: readQET(void) reads back CSR and DACs on QET section and updates memory
sub readQET {
    my $self = shift;
    $self->readHeater;
    $self->readQETBias;
}
#
#                              QET DACs
#
#----------------------------------------------------------------- ZIP::setQETBias
#help: setQETBias(channel,value) sets bias on QET channel to value in volts.  If channel is omitted, sets all four channels.  Channels are "a","b","c","d".
sub setQETBias {
    my $self = shift;
    my $channel = 0;
    my $val = 0;
    if ($#_ == 1) {
	$channel = $_[0];
	$val = $_[1];
    } elsif ($#_ == 0) {
	$val = $_[0];
	$self->setQETBias("a",$val);
	$self->setQETBias("b",$val);
	$self->setQETBias("c",$val);
	$self->setQETBias("d",$val);
	return;
    }
    my $comment = "ZIP set QET $channel bias to $val";
    $self->qet->{bias}->{$channel}->setValue($val);
    $self->writeControl($self->qet->{bias}->{$channel},$comment);
}
#----------------------------------------------------------------- ZIP::readQETBias
#help: readQETBias(channel) reads bias on QET channel.  If channel is omitted, reads all four channels.  Channels are "a","b","c","d".
sub readQETBias {
    my $self = shift;
    my @channel = undef;
    my $comment = undef;
    my $bits = undef;
    my $ret = undef;
    if ($#_ < 0) {
	@channel = (a,b,c,d);
    } else {
	@channel = @_;
    }
    for ($i=0;$i<=$#channel;$i++) {
	$comment = "ZIP read QET $channel[$i] bias";
	$bits = $self->readControl($self->qet->{bias}->{$channel[$i]},
				  $comment);
	$self->qet->{bias}->{$channel[$i]}->setData($bits);
	$ret = $i;
    }
    $self->toFile($self->filename);
    return $self->qet->{bias}->{$channel[$ret]}->value;
}
#
#                              QBias Control Registers
#
#----------------------------------------------------------------- ZIP::LEDOn
#help: LEDOn(LEDnumber,value) turns LEDnumber on if value = 1.  LEDnumber = 3 turns both to value.  If value is omitted, defaults to on.
sub LEDOn {
    my $self = shift;
    my $number = undef;
    my $val = undef;
    my $comment = undef;
    if ($#_ == 1) {
	($number,$val) = @_;
    } elsif ($#_ == 0) {
	$number = $_[0];
	$val = 1;
    } else {
	print "Incorrect number of arguments\n";
	return;
    }
    if ($number == 3) {
	$self->LEDOn(1,$val);
	$self->LEDOn(2,$val);
	return;
    }
    if ($val == 1) {
	$comment = "ZIP LED$number On";
    } else {
	$comment = "ZIP LED$number Off";
    }
    $self->qbias->firstLED->fromFile($self->filename);
    $self->qbias->firstLED->setGroup("led${number}on",$val);
    $self->writeControl($self->qbias->firstLED,$comment);
}
#----------------------------------------------------------------- ZIP::LEDOff
#help: LEDOff(number) turns LEDnumber off.  If number = 3, turns both off.
sub LEDOff {
    my $self = shift;
    my $number = 0;
    if ($#_ > -1) {
	$number = $_[0];
	$self->LEDOn($number,0);
    } else {
	$self->LEDOn(3,0);
    }
}
#----------------------------------------------------------------- ZIP::LEDWidthIndex
sub LEDWidthIndex {
    my $self = shift;
    my $index = undef;
    my $number = undef;
    my $comment = undef;
    my $unit = 100;                           # units for width
    if ($#_ == 0) {
	$index = $_[0];
	$self->LEDWidthIndex(1,$index);
	$self->LEDWidthIndex(2,$index);
	return;
    } elsif ($#_ == 1) {
	($number,$index) = @_;
    } else {
	print "Incorrect number of arguments\n";
	return;
    }
    if ($number == 3) {
	$self->LEDWidthIndex(1,$index);
	$self->LEDWidthIndex(2,$index);
	return;
    }
    $comment = "ZIP LED$number width bits to $index";
    $self->qbias->secondLED->fromFile($self->filename);
    $self->qbias->secondLED->setGroup("led${number}width",$index);
    $self->writeControl($self->qbias->secondLED,$comment);
}
#----------------------------------------------------------------- ZIP::LEDWidth
#help: LEDWidth(number,width) sets LEDnumber width to closest possible value of width, less than input value.  If number = 3, sets both LEDs to index
sub LEDWidth {
    my $self = shift;
    my $index = undef;
    my $number = width;
    my $unit = undef;                           #units for width
    my $width = undef;
    if ($#_ == 0) {
	$width = $_[0];
	$self->LEDWidth(3,$width);
	return;
    } elsif ($#_ == 1) {
	($number,$width) = @_;
    } else {
	print "Incorrect number of arguments\n";
	return;
    }
    if ($width >= 200) {
	$unit = 200;
	$self->LEDLongPulse($number);
	$index = (int($width/$unit) - 1);
    } else {
	$unit = 5;
	$self->LEDShortPulse($number);
	$index = (int($width/$unit) - 1);
    }
    if ($index > 15) {
	print "Exceeded max index, setting to index 15\n";
	$index = 15;
    } elsif ($index < 0) {
	print "Below min index, setting to index 0\n";
	$index = 0;
    }
    $self->LEDWidthIndex($number,$index);

}
#----------------------------------------------------------------- ZIP::LEDPeriodIndex
sub LEDPeriodIndex {
    my $self = shift;
    my $rate = undef;
    my $index = undef;
    my $number = undef;
    my $comment = undef;
    my $unit = 100;
    if ($#_ == 0) {
	$index = $_[0];
	$self->LEDPeriodIndex(3,$index);
	return;
    } elsif ($#_ == 1) {
	($number,$index) = @_;
    } else {
	print "Incorrect number of arguments\n";
	return;
    }
    if ($number == 3) {
	$self->LEDPeriodIndex(1,$index);
	$self->LEDPeriodIndex(2,$index);
	return;
    }
    $rate = ($index + 1) * $unit;
    $comment = "ZIP LED$number rate to $rate, bits to $index";
    $self->qbias->secondLED->fromFile($self->filename);
    $self->qbias->secondLED->setGroup("led${number}rate",$index);
    $self->writeControl($self->qbias->secondLED,$comment);
}
#----------------------------------------------------------------- ZIP::LEDPeriod
#help: LEDPeriod(number,period) sets LEDnumber rate to closest possible period, less than input value.  If number = 3, sets both LEDs to period
sub LEDPeriod {
    my $self = shift;
    my $index = undef;
    my $number = undef;;
    my $unit = 100;                           # units for period
    my $rate = undef;
    if ($#_ == 0) {
	$rate = $_[0];
	$self->LEDPeriod(3,$rate);
	return;
    } elsif ($#_ == 1) {
	($number,$rate) = @_;
    } else {
	print "Incorrect number of arguments\n";
	return;
    }
    $index = (int($rate/$unit) - 1);
    if ($index > 15) {
	print "Max rate is 1600 ms, setting to that\n";
	$index = 15;
    } elsif ($index <0) {
	print "Min rate is 100 ms, setting to that\n";
	$index = 0;
    }
    $self->LEDPeriodIndex($number,$index);

}
#----------------------------------------------------------------- ZIP::gndQI
#help: gndQI(state=1) ground/unground Qi bias (state=1 grounds it)
sub gndQI {
    my $self = shift;
    my $val = undef;
    my $comment = undef;
    $val = 1;
    if ($#_>-1) {
	($val) = @_;
    }
    if ($val == 1) {
	$comment = "ZIP ground Vi bias";
    } else {
	$comment = "ZIP unground Vi bias";
    }
    $self->qbias->firstLED->fromFile($self->filename);
    $self->qbias->firstLED->setGroup("qinbias",$val);
    $self->writeControl($self->qbias->firstLED,$comment);
}
#----------------------------------------------------------------- ZIP::gndQO
#help: gndQO(state=1) ground/unground Qo bias (state=1 grounds it)
sub gndQO {
    my $self = shift;
    my $val = undef;
    my $comment = undef;
    $val = 1;
    if ($#_>-1) {
	($val) = @_;
    }
    if ($val == 1) {
	$comment = "ZIP ground Vo bias";
    } else {
	$comment = "ZIP unground Vo bias";
    }
    $self->qbias->firstLED->fromFile($self->filename);
    $self->qbias->firstLED->setGroup("qoutbias",$val);
    $self->writeControl($self->qbias->firstLED,$comment);
}
#----------------------------------------------------------------- ZIP::LEDShortPulse
#help: LEDShortPulse(number,value) sets LEDnumber to 0 = short, 1 = long.  If number = 3, sets both LEDs to value. If value is omitted, sets to short
sub LEDShortPulse {
    my $self = shift;
    my $val = undef;
    my $number = undef;
    my $comment = undef;
    if ($#_ == 0) {
	($number) = @_;
	$val = 0;
    } elsif ($#_ == 1) {
	($number,$val) = @_;
    } else {
	print "Incorrect number of arguments\n";
	return;
    }
    if ($number == 3) {
	$self->LEDShortPulse(1,$val);
	$self->LEDShortPulse(2,$val);
	return;
    }
    if ($val == 1) {
	$comment = "ZIP LED$number long";
    } elsif ($val == 0) {
	$comment = "ZIP LED$number short";
    }
    $self->qbias->firstLED->fromFile($self->filename);
    $self->qbias->firstLED->setGroup("led${number}long",$val);
    $self->writeControl($self->qbias->firstLED,$comment);
}
#----------------------------------------------------------------- ZIP::LEDLongPulse
#help: LEDLongPulse(number) sets LEDnumber to long.  If number = 3, sets both to long
sub LEDLongPulse {
    my $self = shift;
    my $number = 0;
    if ($#_ > -1) {
	$number = $_[0];
	$self->LEDShortPulse($number,1);
    } else {
	$self->LEDShortPulse(3,1);
    }
}
#----------------------------------------------------------------- ZIP::LEDRepMode
#help: LEDRepMode(number) sets LEDnumber to repetitive mode.  If number = 3, sets both LEDs to rep.
sub LEDRepMode {
    my $self = shift;
    my $val = 1;
    my $number = $_[0];
    my $comment = undef;
    if ($number == 3) {
	$self->LEDRepMode(1);
	$self->LEDRepMode(2);
	return;
    }
    $comment = "ZIP LED$number to repetitive mode";
    $self->qbias->firstLED->fromFile($self->filename);
    $self->qbias->firstLED->setGroup("led${number}rep",$val);
    $self->writeControl($self->qbias->firstLED,$comment);
}
#----------------------------------------------------------------- ZIP::LEDSingleMode
#help: LEDSingleMode(number) sets LEDnumber to single fire mode.  If number = 3, sets both to single
sub LEDSingleMode {
    my $self = shift;
    my $number = $_[0];
    my $val = 0;
    my $comment = undef;
    if ($number == 3) {
	$self->LEDSingleMode(1);
	$self->LEDSingleMode(2);
	return;
    }
    $comment = "ZIP LED$number to single mode";
    $self->qbias->firstLED->fromFile($self->filename);
    $self->qbias->firstLED->setGroup("led${number}rep",$val);
    $self->writeControl($self->qbias->firstLED,$comment);
}
#----------------------------------------------------------------- ZIP::LEDPulseMode
#help: LEDPulseMode(number,value) sets LEDnumber to 0 = pulse, 1 = cont.  If number = 3, sets both LEDs to value. If value is omitted, sets to short
sub LEDPulseMode {
    my $self = shift;
    my $val = undef;
    my $number = undef;
    my $comment = undef;
    if ($#_ == 0) {
	($number) = @_;
	$val = 0;
    } elsif ($#_ == 1) {
	($number,$val) = @_;
    } else {
	print "Incorrect number of arguments\n";
	return;
    }
    if ($number == 3) {
	$self->LEDPulseMode(1,$val);
	$self->LEDPulseMode(2,$val);
	return;
    }
    if ($val == 1) {
	$comment = "ZIP LED$number continuous";
    } elsif ($val == 0) {
	$comment = "ZIP LED$number pulse";
    }
    $self->qbias->firstLED->fromFile($self->filename);
    $self->qbias->firstLED->setGroup("led${number}cont",$val);
    $self->writeControl($self->qbias->firstLED,$comment);
}
#----------------------------------------------------------------- ZIP::LEDContMode
#help: LEDContMode(number) sets LEDnumber to continuous.  If number = 3, sets both to long
sub LEDContMode {
    my $self = shift;
    my $number = 0;
    if ($#_ > -1) {
	$number = $_[0];
	$self->LEDPulseMode($number,1);
    } else {
	$self->LEDPulseMode(3,1);
    }
}
#----------------------------------------------------------------- ZIP::LEDFire
#help: LEDFire(number) fires LEDnumber, and then resets CSR bit.  If number = 3, fires both LEDs to value.
sub LEDFire {
    my $self = shift;
    my $val = 1;
    my $number = $_[0];
    my $comment = undef;
    if ($number == 3) {
	$self->LEDFire(1);
	$self->LEDFire(2);
	return;
    }
    $comment = "Checking if in single fire mode";
    my $bits = undef;
    $bits = $self->readControl($self->qbias->firstLED,$comment);
    $bits =~ s/ //;
    my @test = undef;
    $test[1] = hex($bits) & 4;
    $test[2] = hex($bits) & 64;
    if ($test[$number] != 0) {
	print "LED $number needs to be in single fire mode\n";
	return;
    }
    $comment = "ZIP fire LED$number";
    $self->qbias->firstLED->fromFile($self->filename);
    $self->qbias->firstLED->setGroup("led${number}single",$val);
    $self->writeControl($self->qbias->firstLED,$comment);
    $val = 0;
    $self->qbias->firstLED->setGroup("led${number}single",$val);
    $self->writeControl($self->qbias->firstLED,$comment);
}
#----------------------------------------------------------------- ZIP::readLEDModeStatus
#help: readLEDModeStatus(void) reads back first CSR on QBias section
sub readLEDModeStatus {
    my $self = shift;
    my $bits = undef;
    my $comment = "ZIP read first LED CSR";
    $bits = $self->readControl($self->qbias->firstLED,$comment);
    $self->qbias->firstLED->setData($bits);
    $self->toFile($self->filename);
    return $self->qbias->firstLED->data;
}
#----------------------------------------------------------------- ZIP::readLEDWPStatus
#help: readLEDWPStatus(void) reads back first CSR on QBias section
sub readLEDWPStatus {
    my $self = shift;
    my $bits = undef;
    my $comment = "ZIP read second LED CSR";
    $bits = $self->readControl($self->qbias->secondLED,$comment);
    $self->qbias->secondLED->setData($bits);
    $self->toFile($self->filename);
    return $self->qbias->secondLED->data;
}
#----------------------------------------------------------------- ZIP::readQBiasCSR
#help: readQBiasCSR(void) reads back CSRs on QBias section
sub readQBiasCSR {
    my $self = shift;
    $self->readLEDModeStatus;
    $self->readLEDWPStatus;
}
#----------------------------------------------------------------- ZIP::readQBias
#help: readQBias(void) reads back CSRs and DACs on QBias section
sub readQBias {
    my $self = shift;
    $self->readQBiasCSR;
    $self->readQBiasDAC;
}
#
#                              QBias DACs
#
#----------------------------------------------------------------- ZIP::setQIDAC
#help: setQIDAC(value) sets Qinner DAC to value in volts
sub setQIDAC {
    my $self = shift;
    my $val = $_[0];
    my $comment = "ZIP set Qinner DAC to $val";
    $self->qbias->Qibias->setValue($val);
    $self->writeControl($self->qbias->Qibias,$comment);
}
#----------------------------------------------------------------- ZIP::setQODAC
#help: setQODAC(value) sets Qouter DAC to value in volts
sub setQODAC {
    my $self = shift;
    my $val = $_[0];
    my $comment = "ZIP set Qouter DAC to $val";
    $self->qbias->Qobias->setValue($val);
    $self->writeControl($self->qbias->Qobias,$comment);
}
#----------------------------------------------------------------- ZIP::setLED1DAC
#help: setLED1DAC(value) sets LED1 DAC to value in volts
sub setLED1DAC {
    my $self = shift;
    my $val = $_[0];
    my $comment = "ZIP set LED1 DAC to $val";
    $self->qbias->LED1bias->setValue($val);
    $self->writeControl($self->qbias->LED1bias,$comment);
}
#----------------------------------------------------------------- ZIP::setLED2DAC
#help: setLED2DAC(value) sets LED2 DAC to value in volts
sub setLED2DAC {
    my $self = shift;
    my $val = $_[0];
    my $comment = "ZIP set LED2 DAC to $val";
    $self->qbias->LED2bias->setValue($val);
    $self->writeControl($self->qbias->LED2bias,$comment);
}
#----------------------------------------------------------------- ZIP::readQIDAC
#help: readQIDAC(void) reads Qinner DAC
sub readQIDAC {
    my $self = shift;
    my $comment = "ZIP read Qinner DAC";
    my $bits = $self->readControl($self->qbias->Qibias,$comment);
    $self->qbias->Qibias->setData($bits);
    $self->toFile($self->filename);
    return $self->qbias->Qibias->value;
}
#----------------------------------------------------------------- ZIP::readQODAC
#help: readQODAC(void) reads Qouter DAC
sub readQODAC {
    my $self = shift;
    my $comment = "ZIP read Qouter DAC";
    my $bits = $self->readControl($self->qbias->Qobias,$comment);
    $self->qbias->Qobias->setData($bits);
    $self->toFile($self->filename);
    return $self->qbias->Qobias->value;
}
#----------------------------------------------------------------- ZIP::readLED1DAC
#help: readLED1DAC(void) reads LED1 DAC
sub readLED1DAC {
    my $self = shift;
    my $comment = "ZIP read LED1 DAC";
    my $bits = $self->readControl($self->qbias->LED1bias,$comment);
    $self->qbias->LED1bias->setData($bits);
    $self->toFile($self->filename);
    return $self->qbias->LED1bias->value;
}
#----------------------------------------------------------------- ZIP::readLED2DAC
#help: readLED2DAC(void) reads LED2 DAC
sub readLED2DAC {
    my $self = shift;
    my $comment = "ZIP read LED2 DAC";
    my $bits = $self->readControl($self->qbias->LED2bias,$comment);
    $self->qbias->LED2bias->setData($bits);
    $self->toFile($self->filename);
    return $self->qbias->LED2bias->value;
}
#----------------------------------------------------------------- ZIP::readQBiasDAC
#help: readQBiasDAC(void) reads all DACs in QBias section
sub readQBiasDAC {
    my $self = shift;
    $self->readQIDAC;
    $self->readQODAC;
    $self->readLED1DAC;
    $self->readLED2DAC;
}
#
#                              Driver Control Registers
#
#----------------------------------------------------------------- ZIP::setGain
#help: setGain(channel,gain) set channel to the nearest gain possible to gain.  If channel is omitted, sets all gains.
sub setGain {
    my $self = shift;
    my $channel = undef;
    my $gain = undef;
    if ($#_ == 1) {
	($channel,$gain) = @_;
    } elsif ($#_ == 0) {
	$gain = $_[0];
	for ($i=0;$i<6;$i++) {
	    $self->setGain($i,$gain);
	}
	return;
    }
    my $i = 0;
    my $newIndex = 0;
    my @gainValues = (1,1.43,2,5,10,14.3,20,50);
    for ($i=0;$i<$#gainValues;$i++) {
	if (abs($gain)>=$gainValues[$i]) {
	    $newIndex = $i;
	}
    }
    $self->gainIndex($channel,$newIndex);
    if ($gain<0) {
	$self->polarity($channel,1);
    } else {
	$self->polarity($channel,0);
    }
}
#----------------------------------------------------------------- ZIP::gainIndex
sub gainIndex {
    my $self = shift;
    my $channel = undef;
    my $index = undef;
    if ($#_ == 1) {
	($channel,$index) = @_;
    } elsif ($#_ == 0) {
	$index = $_[0];
	for ($i=0;$i<6;$i++) {
	    $self->gainIndex($i,$index);
	}
	return;
    }
    my @gains = (1,1.43,2,5,10,14.3,20,50);
    my $comment = "ZIP gain on ch$channel to $gains[$index], index $index";
    $self->fromFile($self->filename);
    if ($channel<3) {
	$self->driver->gains1->setGroup("gain$channel",$index);
	$self->writeControl($self->driver->gains1,$comment);
    } elsif ($channel<6) {
	$self->driver->gains2->setGroup("gain$channel",$index);
	$self->writeControl($self->driver->gains2,$comment);
    }
}
#----------------------------------------------------------------- ZIP::polarity
#help: polarity(channel,index) set polarity on channel to pos or neg.  If channel is omitted, sets all polarities.
sub polarity {
    my $self = shift;
    my $channel = undef;
    my $value = undef;
    if ($#_ == 1) {
	($channel,$value) = @_;
    } elsif ($#_ == 0) {
	$value = $_[0];
	for ($i=0;$i<6;$i++) {
	    $self->polarity($i,$value);
	}
	return;
    }
    my $comment = "ZIP polarity on driver p$channel to $value";
    if ($channel<3) {
	$self->driver->gains1->setGroup("p$channel",$value);
	$self->writeControl($self->driver->gains1,$comment);
    } elsif ($channel<6) {
	$self->driver->gains2->setGroup("p$channel",$value);
	$self->writeControl($self->driver->gains2,$comment);
    }
}
#----------------------------------------------------------------- ZIP::readGains
#help: readGains(void) reads the gains from the card
sub readGains {
    my $self = shift;
    my $comment = "ZIP read Gains1";
    my $bits1 = $self->readControl($self->driver->gains1,$comment);
    $comment = "ZIP read Gains2";
    my $bits2 = $self->readControl($self->driver->gains2,$comment);
    $self->driver->gains1->setData($bits1);
    $self->driver->gains2->setData($bits1);
    $self->toFile($self->filename);
}	
#----------------------------------------------------------------- ZIP::readDriver
#help: readDriver(void) reads DACs and gains from driver section
sub readDriver {
    my $self = shift;
    $self->readGains;
    $self->readOffset;
}
#
#                              Driver DACs
#
#----------------------------------------------------------------- ZIP::setOffset
#help: setOffset(channel,value) sets offset DAC on channel to value volts.  If channel is omitted, sets all offsets.
sub setOffset {
    my $self = shift;
    my $channel = undef;
    my $val = undef;
    if ($#_ == 1) {
	($channel,$val) = @_;
    } elsif ($#_ == 0) {
	$val = $_[0];
	for ($i=0;$i<6;$i++) {
	    $self->setOffset($i,$val);
	}
	return;
    }
    my $comment = "ZIP set Offset DAC $channel to $val";
    if (($channel>5) || ($channel<0)) {
	print "No such DAC\n";
	return;
    }
    $self->driver->{offset}->[$channel]->setValue($val);
    $self->writeControl($self->driver->{offset}->[$channel],$comment);
}
#----------------------------------------------------------------- ZIP::readOffset
#help: readOffset(channel) reads offset DAC on channel and updates variables
sub readOffset {
    my $self = shift;
    my @channel = undef;
    my $comment = undef;
    my $bits = undef;
    my $ret = undef;
    if ($#_ < 0) {
	$self->readOffset(0,1,2,3,4,5,);
    } else {
	@channel = @_;
    }
    for ($i=0;$i<=$#channel;$i++) {
	if (($channel[$i]>5) || ($channel[$i] < 0)) {
	    print "No such DAC\n";
	    next;
	}
	$comment = "ZIP read offset DAC $channel[$i]";
	$bits = $self->readControl($self->driver->{offset}->[$channel[$i]],
				   $comment);
	$self->driver->{offset}->[$channel[$i]]->setData($bits);
	$self->toFile($self->filename);
	$ret = $i;
    }
    return $self->driver->{$channel[$ret]}->value;
}




\\__END__OF__ZIPcard.pm__FILE\\
chmod 664 ZIPcard.pm
echo unsharking ZIPdriver.pm
cat > ZIPdriver.pm << '\\__END__OF__ZIPdriver.pm__FILE\\'
#! /usr/local/bin/perl

package ZIPdriver;
#
#		ZIPdriver.pm
#
#	INHERITS FROM:  object
#	CONTAINS:  Control, DAC
#
#	This object contains the controls and DACs for the driver section of
#	the ZIP card.  Other than the constructor and a print routine, it 
#	does not contain any methods.  (It could possibly be used for combining
#	the 3U and 9U versions of the ZIP card in the software.)
#

require 5.002;
require object;

use Control;
use DAC;

@ISA = qw( object );

my %fields = (
	      filename     => undef,
	      offset       => [],
	      gains1         => undef,
	      gains2         => undef,
	      Controls     => {},
	      DACs         => {},
	      );
#
#               Basic Functions
#
#------------------------------------------------------------ ZIPqet::new
sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my $self = object->new(@_);
    $self->{_permitted} = \%fields;
    bless $self,$class;

    my $section = $_[0];
    my $filename = $_[1];
    $self->filename("$filename");
    $section = $section << 4;

    my $i = 0;
    my $address = 0;
    for ($i=0;$i<6;$i++) {
	$address = $i + 4;
	$self->{offset}->[$i] = new DAC (($section | $address),12,-5,5);
    }
    $self->gains1( new Control (($section | 0),"gain0","","gain1","","gain2",
				"","p0","p1","p2",""));
    $self->gains1->setGroupSize("gain0",3);
    $self->gains1->setGroupSize("gain1",3);
    $self->gains1->setGroupSize("gain2",3);
    $self->gains2( new Control (($section | 1),"gain3","","gain4","","gain5",
				"","p3","p4","p5",""));
    $self->gains2->setGroupSize("gain3",3);
    $self->gains2->setGroupSize("gain4",3);
    $self->gains2->setGroupSize("gain5",3);

    $self->{Controls}->{Gains1}     = $self->gains1;
    $self->{Controls}->{Gains2}     = $self->gains2;
    $self->{DACs}->{Offset0}        = $self->{offset}->[0];
    $self->{DACs}->{Offset1}        = $self->{offset}->[1];
    $self->{DACs}->{Offset2}        = $self->{offset}->[2];
    $self->{DACs}->{Offset3}        = $self->{offset}->[3];
    $self->{DACs}->{Offset4}        = $self->{offset}->[4];
    $self->{DACs}->{Offset5}        = $self->{offset}->[5];

    return $self;
}
#----------------------------------------------------------------- ZIPdriver::print
sub print {
    my $self = shift;
    my %controls = %{$self->Controls};
    my %dacs = %{$self->DACs};
    print "??? Driver Information\n";
    foreach $key (sort keys %controls) {
	print ">> $key Control\n"; $controls{$key}->print;
    }
    foreach $key (sort keys %dacs) {
	print ">> $key DAC\n"; $dacs{$key}->print;
    }
}

\\__END__OF__ZIPdriver.pm__FILE\\
chmod 664 ZIPdriver.pm
echo unsharking ZIPqbias.pm
cat > ZIPqbias.pm << '\\__END__OF__ZIPqbias.pm__FILE\\'
#! /usr/local/bin/perl

package ZIPqbias;
#
#               ZIPqbias.pm
#
#       INHERITS FROM:  object
#       CONTAINS:  Control, DAC
#
#       This object contains the controls and DACs for the QBias section of
#       the ZIP card.  Other than the constructor and a print routine, it
#       does not contain any methods.  (It could possibly be used for combining  
#       the 3U and 9U versions of the ZIP card in the software.)
#

require 5.002;
require object;

use Control;
use DAC;

@ISA = qw( object );

my %fields = (
	      filename     => undef,
	      Qibias       => undef,
	      Qobias       => undef,
	      LED1bias     => undef,
	      LED2bias     => undef,
	      firstLED     => undef,
	      secondLED    => undef,
	      Controls     => {},
	      DACs         => {},
	      );
#
#               Basic Functions
#
#------------------------------------------------------------ ZIPqbias::new
sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my $self = object->new(@_);
    $self->{_permitted} = \%fields;
    bless $self,$class;

    my $section = $_[0];
    my $filename = $_[1];
    $section = $section << 4;
    $self->filename("$filename");
    $self->Qibias( new DAC (($section | 4),12,-5,5));
    $self->Qobias( new DAC (($section | 5),12,-5,5));
    $self->LED1bias( new DAC (($section | 6),12,-5,5));
    $self->LED2bias( new DAC (($section | 7),12,-5,5));
    $self->firstLED( new Control (($section | 0),"led1on","led1cont","led1rep",
				  "led1long","led2on","led2cont","led2rep",
				  "led2long","qinbias","qoutbias","","",
				  "led1single","led2single","",""));
    $self->secondLED( new Control (($section | 1),"led1width","led1rate",
				   "led2width","led2rate"));
    $self->secondLED->setAllGroupSize(4);

    $self->{Controls}->{FirstLED}        = $self->firstLED;
    $self->{Controls}->{SecondLED}       = $self->secondLED;

    $self->{DACs}->{QinBias}             = $self->Qibias;
    $self->{DACs}->{QoutBias}            = $self->Qobias;
    $self->{DACs}->{LED1Bias}            = $self->LED1bias;
    $self->{DACs}->{LED2Bias}            = $self->LED2bias;

    return $self;
}
#----------------------------------------------------------------- ZIPqbias::print
sub print {
    my $self = shift;
    my %controls = %{$self->Controls};
    my %dacs = %{$self->DACs};
    print "??? QBias Information\n";
    foreach $key (sort keys %controls) {
	print ">> $key Control\n"; $controls{$key}->print;
    }
    foreach $key (sort keys %dacs) {
	print ">> $key DAC\n"; $dacs{$key}->print;
    }
}


\\__END__OF__ZIPqbias.pm__FILE\\
chmod 664 ZIPqbias.pm
echo unsharking ZIPqet.pm
cat > ZIPqet.pm << '\\__END__OF__ZIPqet.pm__FILE\\'
#! /usr/local/bin/perl

package ZIPqet;
#
#               ZIPqet.pm
#
#       INHERITS FROM:  object
#       CONTAINS:  Control, DAC
#
#       This object contains the controls and DACs for the QET section of
#       the ZIP card.  Other than the constructor and a print routine, it
#       does not contain any methods.  (It could possibly be used for combining  
#       the 3U and 9U versions of the ZIP card in the software.)
#

require 5.002;
require object;

use Control;
use DAC;

@ISA = qw( object );

my %fields = (
	      filename     => undef,
	      bias         => {},
	      heater       => undef,
	      Controls     => {},
	      DACs         => {},
	      );
#
#               Basic Functions
#
#------------------------------------------------------------ ZIPqet::new
sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my $self = object->new(@_);
    $self->{_permitted} = \%fields;
    bless $self,$class;

    my $section = $_[0];
    my $filename = $_[1];
    $self->filename("$filename");
    $section = $section << 4;
    $self->{bias}->{a} = new DAC (($section | 4),12,-5,5);
    $self->{bias}->{b} = new DAC (($section | 5),12,-5,5);
    $self->{bias}->{c} = new DAC (($section | 6),12,-5,5);
    $self->{bias}->{d} = new DAC (($section | 7),12,-5,5);
    $self->heater( new Control (($section | 0),"phicala","phicalb","phicalc",
				"phicald","heatwidth","enableheata",
				"enableheatb","enableheatc","enableheatd","",
				"","",""));
    $self->heater->setGroupSize("heatwidth",4);

    $self->{Controls}->{heater}            = $self->heater;
    $self->{DACs}->{biasa}                 = $self->{bias}->{a};
    $self->{DACs}->{biasb}                 = $self->{bias}->{b};
    $self->{DACs}->{biasc}                 = $self->{bias}->{c};
    $self->{DACs}->{biasd}                 = $self->{bias}->{d};

    return $self;
}
#----------------------------------------------------------------- ZIPqet::print
sub print {
    my $self = shift;
    my %controls = %{$self->Controls};
    my %dacs = %{$self->DACs};
    print "??? QET Information\n";
    foreach $key (sort keys %controls) {
	print ">> $key Control\n"; $controls{$key}->print;
    }
    foreach $key (sort keys %dacs) {
	print ">> $key DAC\n"; $dacs{$key}->print;
    }
}









\\__END__OF__ZIPqet.pm__FILE\\
chmod 664 ZIPqet.pm
echo unsharking ZIPsquid.pm
cat > ZIPsquid.pm << '\\__END__OF__ZIPsquid.pm__FILE\\'
#! /usr/local/bin/perl

package ZIPsquid;
#
#               ZIPsquid.pm
#
#       INHERITS FROM:  object
#       CONTAINS:  Control, DAC
#
#       This object contains the controls and DACs for the SQUID section of
#       the ZIP card.  Other than the constructor and a print routine, it
#       does not contain any methods.  (It could possibly be used for combining  
#       the 3U and 9U versions of the ZIP card in the software.)
#

require 5.002;
require object;

use Control;
use DAC;

@ISA = qw( object );

my %fields = (
	      filename     => undef,
	      gain         => undef,
	      bias         => undef,
	      offset       => undef,
	      zapper       => undef,
	      Controls     => {},
	      DACs         => {},
	      );
#
#               Basic Functions
#
#------------------------------------------------------------ ZIPsquid::new
sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my $self = object->new(@_);
    $self->{_permitted} = \%fields;
    bless $self,$class;

    my $section = $_[0];
    my $filename = $_[1];
    $self->filename($filename);
    $section = $section << 4;
    $self->bias( new DAC(($section | 4),12,-5,5));
    $self->gain( new DAC(($section | 5),12,-5,5));
    $self->offset( new DAC(($section | 6),12,-5,5));
    $self->zapper( new Control(($section | 0),"cal","mode","zapvoltage",
			       "zapwidth","armed","armzap","disarm",
			       "","pola","polb","",""));
    $self->zapper->setGroupSize("zapwidth",4);
    $self->zapper->setGroupSize("zapvoltage",2);

    $self->{Controls}->{ZapControl}    = $self->zapper;

    $self->{DACs}->{bias}              = $self->bias;
    $self->{DACs}->{gain}              = $self->gain;
    $self->{DACs}->{offset}            = $self->offset;

    return $self;
}
#----------------------------------------------------------------- ZIPsquid::print
sub print {
    my $self = shift;
    my $channel = $_[0];
    my %controls = %{$self->Controls};
    my %dacs = %{$self->DACs};
    print "??? Squid $channel Information\n";
    foreach $key (sort keys %controls) {
	print ">> $key Control\n"; $controls{$key}->print;
    }
    foreach $key (sort keys %dacs) {
	print ">> $key DAC\n"; $dacs{$key}->print;
    }
}




\\__END__OF__ZIPsquid.pm__FILE\\
chmod 664 ZIPsquid.pm
echo unsharking firstClientConnection.pm
cat > firstClientConnection.pm << '\\__END__OF__firstClientConnection.pm__FILE\\'
#! /usr/local/bin/perl -w

package ClientConnection;
#
#               ClientConnection.pm
#
#       INHERITS FROM:  object
#       CONTAINS:  None
#
#	This package handles all of the communication for sending/receiving
#	ints and strings from a TCP/IP connection.  It contains routines for opening and 
#	closing the socket connection, sending the datastrings to the server
#	and for reading datastrings from the server.
#

require 5.002;
require object;

use Socket;
use Carp;

@ISA = qw( object );

my %fields = (
  host => undef,
  port => undef,
);

#-------------------------------------------------------------------- ClientConnection::new
sub new{
  my $this = shift;
  my $class = ref($this) || $this;
  my $self = object->new;
  $self->{_permitted} = \%fields;
  bless $self,$class;

  $self->host("ppdm06.fnal.gov");
  $self->port(2345);

  my ($arg) = @_;
  my @hp = split /:/,$arg;
  $self->host($hp[0]);
  if ($hp[1]>0) {
    $self->port($hp[1]);
  }
  return $self;
}

#-------------------------------------------------------------------- ClientConnection::print
#help: print(void) prints selected information about connection
sub print{
  my $self = shift;
  print "Remote host: ",$self->host,"\n";
  print "Remote port: ",$self->port,"\n";
}
#----------------------------------------------------------------- ClientConnection::closeSocket
#help: closeSocket(void) closes socket connection
sub closeSocket{
  my $self = shift;
  close (SOCK);
}
#----------------------------------------------------------------- ClientConnection::openSocket
#help: openSocket(void) opens socket connection for a Client.
sub openSocket{
  my $self = shift;
  my ($host,$port,$iaddr,$paddr,$proto);
  $host = $self->host; 
  $port = $self->port;
  my $tryagain = 0; my $attempts = 0; my $maxAttempts = 20;

  if ($port =~ /\D/) {$port = getservbyname($port, 'tcp') }
  die "No port" unless $port;
  $iaddr  = inet_aton($host)               or warn "no host: $host";
  $paddr  = sockaddr_in($port,$iaddr)      or warn "no paddr: $paddr";
  $proto  = getprotobyname('tcp');

  if (socket(SOCK, PF_INET, SOCK_STREAM, $proto)) { 
    connect(SOCK,$paddr)                       or $tryagain=1;
  } else { 
    $tryagain = 1;
  }
TRY:
  while ($tryagain && $attempts++<$maxAttempts){
    $tryagain =0;
    my $rnd = int(rand(3e4)*$attempts);
    my $i = 0;
    for ($i=0;$i<$rnd;$i++) {;}          # cheesy delay
    $iaddr  = inet_aton($host)               or warn "no host: $host";
    $paddr  = sockaddr_in($port,$iaddr)      or warn "no paddr: $paddr";
    $proto  = getprotobyname('tcp');

     socket(SOCK, PF_INET, SOCK_STREAM, $proto) or next TRY; 
     connect(SOCK,$paddr) or $tryagain=1;
  }  
#  print "$attempts attempts\n";
  if ($attempts >= $maxAttempts) { die "openSocket: $!\n"; }
}
#----------------------------------------------------------------- ClientConnection::readInt
#help: readInt() reads an int from a remote socket.
sub readInt{
  my $self = shift;
  my $len = 4;
  my $number;
  recv SOCK,$number,$len,0;
  $number = unpack("N",$number);
  return $number;
}
#----------------------------------------------------------------- ClientConnection::readString
#help: readString(lengthtoread) reads a string of specified length from internet
sub readString{
  my $self = shift;
  my ($lentoRead) = @_;
  my $String="";
  recv SOCK,$String,$lentoRead,0;
  if ($String<0) {die "Error reading from socket \n"};
  my ($valRead) = unpack ("N",$String);
  return $String;
}
#----------------------------------------------------------------- ClientConnection::sendInt
#help: sendInt() send an int to a remote socket.
sub sendInt{
  my $self = shift;
  my ($number) = @_;
  my $tosend = pack ("N","$number");
#my $tosendback = unpack ("N",$tosend);
#printf "debug: ClientConnection: sendInt sending $number , %x to socket \n",$tosendback;
  my $bytessent = send SOCK,$tosend,0;
  return $bytessent;
}
#----------------------------------------------------------------- ClientConnection::sendString
#help: sendString(string) sends given string over net
sub sendString{
  my $self = shift;
  my ($String) = @_;
  my $bytessent = send SOCK,$String,0;
  if ($bytessent<0) {die "Error sending $String to socket \n"};
  return $bytessent;
}
#-------------------------------------------------------------------- ClientConnection::setHost
#help: setHost(host) sets host to host
sub setHost{
  my $self = shift;
  my ($arg) = @_;
  my @hp = split /:/,$arg;
  $self->host($hp[0]);
  if ($hp[1]>0) {
    $self->port($hp[1]);
  }
}
#-------------------------------------------------------------------- ClientConnection::setPort
#help: setPort(port) sets port
sub setPort{
  my $self = shift;
  my ($port) = @_;
  $self->port($port);
} 
\\__END__OF__firstClientConnection.pm__FILE\\
chmod 664 firstClientConnection.pm
echo unsharking functionGen.pm
cat > functionGen.pm << '\\__END__OF__functionGen.pm__FILE\\'
#! /usr/local/bin/perl -w

package functionGen;
#
#               functionGen.pm
#
#       INHERITS FROM:  object
#       CONTAINS:  GPIBconnection, GPIBinstr   
#
#	This represents the HP 33120A function Generator.
#       WORK IN PROGRESS!!!
#

require 5.002;
require object;

use Socket;
use GPIBconnection;
use GPIBinstr;
use Carp;

@ISA = qw( object );

my %fields = (
  file => undef,
  device => undef,
  host => undef,
  port => undef,
  data => undef,
  current => undef,
  GPIBaddress => undef,
  GPIBconn  => undef,
);

#-------------------------------------------------------------------- functionGen::new
sub new{
  my $this = shift;
  my $class = ref($this) || $this;
  my $self = object->new;
  $self->{_permitted} = \%fields;
  bless $self,$class;

  my ($arg,$logfile) = @_;
  if ($#_<0){ return $self; }
  if (length($logfile)==0 && $arg!~/:/){  # copy ctor
    my $b1 = $arg; 
    $self->instrs($b1->instrs()); 
    $self->file($b1->file()); 
    $self->host($b1->host()); 
    $self->port($b1->port()); 
    $self->data($b1->data()); 
    $self->current($b1->current()); 
    $self->GPIBaddress($b1->GPIBaddress()); 
    $self->GPIBconn($b1->GPIBconn()); 
    return $self;
  }
    
  my @hp = split /:/,$arg;

  $self->GPIBaddress(10);
  $self->file("command.log");
  $self->device("/dev/GPIB/functionGen");

  $self->host($hp[0]);
  if ($hp[1]>0) {
    $self->port($hp[1]);
  }
  if ($#_>1) {
    my ($a) = @_;
    $self->file($a);
  }
  if ($#_ >1) { $self->file($logfile);}
  $self->GPIBconn(new GPIBconnection(join ':',$self->host,$self->port));
  $self->current(new GPIBinstr(
                     "gpibwrite",$self->GPIBaddress,"000000"));
  return $self; 
}
#-------------------------------------------------------------------- functionGen::initialize
#help: initialize(void) initializes box
sub initialize{
  my $self = shift;
  my ($address,$subrack) = @_;  # allow possibility to use default subrack.
  if (length($subrack)>0) {
    my ($subrack) = @_;
    $self->subrack($subrack);
  }
  $self->current->dataString("r0c4g1f0p0k0m1x");
  $self->current->setNbytes();
  my $dat = $self->GPIBconn->exInstr($self->current);
  $self->data(unpack("N",$dat));
  print "Initialized status: ",$self->data,"\n";
} 
#-------------------------------------------------------------------- functionGen::print
#help: print(void) prints selected info about GPIB box settings
sub print{
  my $self = shift;
  print $self->file," \n";
  print "Remote host: ",$self->host,"\n";
  print "Remote port: ",$self->port,"\n";
  print "Remote subrack: ",$self->subrack,"\n";
#  my $i=0;
#  my $lines = $self->nlines;
#  for ($i=0;$i<$lines;$i++){
#    $self->{instrs}->[$i]->write;
#  }
}
#-------------------------------------------------------------------- functionGen::setHost
#help: setHost(host) sets box's host
sub setHost{
  my $self = shift;
  my ($arg) = @_;
  my @hp = split /:/,$arg;
  $self->host($hp[0]);
  if ($hp[1]>0) {
    $self->port($hp[1]);
  }
}
#-------------------------------------------------------------------- functionGen::setPort
#help: setPort(port) sets box's port
sub setPort{
  my $self = shift;
  my ($port) = @_;
  $self->port($port);
} 



\\__END__OF__functionGen.pm__FILE\\
chmod 664 functionGen.pm
echo unsharking object.pm
cat > object.pm << '\\__END__OF__object.pm__FILE\\'
#! /usr/local/bin/perl5.003

package object;
#		object.pm
#
#	INHERITS FROM:  None
#  	CONTAINS:  None
#
#	Contains basic constructor, help routines, and an AUTOLOAD function for
#	smooth running.  Used as a base class for other objects.
#

my @helpLine = [];

#---------------------------------------------------------------- object::new
sub new{    # arguments: Address of command, name1,name2,name3....
  my $this = shift;
  my $class = ref($this) || $this;
  my $self = {};

  bless $self,$class;
  return $self; 
}
#---------------------------------------------------------------- object::getSourceHelp
sub getSourceHelp {
  my $self = shift;
  my $pattern = '';
  if ($#_ > -1) {
    ($pattern) = @_;
  }
  my $fname = $self->getSourceFile;
  open (SOURCE,"<$fname") || die "Can't open $fname\n";

  $i=0;
  while (<SOURCE>){
    if (($_ =~ /#help:/) && ($_ =~ /$pattern/) ) {
      $start = index $_,"#help:";
      $helpLine[$i]=substr $_,$start+6;
      $helpLine[$i] =~ s/^\s*//;
      $i++;
    }
  }
}
#---------------------------------------------------------------- object::printHelp
sub printHelp {
  my $self = shift;
  my $line;
  for ($i=0;$i<=$#helpLine;$i++){
    $line = $helpLine[$i];
    @Fld = split (' ',$line,9999);
    $line = substr $line,length $Fld[0];
    $line =~ s/^\s*//;                # get rid of leading spaces.
    $rest = $line;                    # remainder of line
    write;
  }
}
# --------------------------------------------------------------- format top
format STDOUT_TOP =
                          Help
.
# --------------------------------------------------------------- format
format STDOUT =
   @<<<<<<<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    $Fld[0],                   $rest
   ~                           ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
                               $rest
   ~                           ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
                               $rest
.
#---------------------------------------------------------------- object::getSourceFile
sub getSourceFile {
  my $self = shift;
  my $type = ref($self) ||  die "$self is not an object";
  my $source = "$type.pm";
 
  if (! -r $source) {
    print "looking in other directorys for source\n";
    for ($i=0;$i<$#INC;$i++){
      $dir = $INC[$i];
      print "$dir \n";
      if (-r "$dir/$source") {return "$dir/$source";}
    }
  }
  return $source;
}  
#---------------------------------------------------------------- object::help
sub help{
  my $self = shift;
  $helpLine = [];
  $#helpLine = 0;
  if ($#_ > -1) {
    $self->getSourceHelp(@_);
  } else { 
    $self->getSourceHelp;
  }
  $self->printHelp;
}
#---------------------------------------------------------------- object::dbgmess
sub dbgmess {
  my $self = shift;
  my ($arg) = @_;
  my $type = ref($self) ||  die "$self is not an object";
  print "DEBUG $type: $arg\n";
} 
#---------------------------------------------------------------- object::AUTOLOAD
sub AUTOLOAD {
  my $self = shift;
  my $type = ref($self) || $self || die "$self is not an object";
  my $name = $AUTOLOAD;
  $name =~ s/.*://;         # strip fully qualified portion.
  if (!(exists $self->{_permitted}->{$name} )) {
      if ($name  ne "exit") {
	  die "Can't access `$name' field in object of class $type \n";
      } else {
	  die "\n";
      }
  }
  if (@_) {
    return $self->{$name}=shift;
  } else {
    return $self->{$name};
  }
}
\\__END__OF__object.pm__FILE\\
chmod 664 object.pm
\\__END__OF__Modules.sh__FILE\\
chmod 664 Modules.sh
echo unsharking Perl.sh
cat > Perl.sh << '\\__END__OF__Perl.sh__FILE\\'
#!/bin/sh
########################################################
# This is a shell archive  --- shark 0.1.1 ---         #
# Please remove any lines before this header and       #
# run     sh this-file-name     to extract all files.  #
# 1994 (C) Fernando J G Pereira - fjp@minerva.inesc.pt #
########################################################
echo unsharking DAClin.pl
cat > DAClin.pl << '\\__END__OF__DAClin.pl__FILE\\'
#! /usr/local/bin/perl -I. -I./blib/arch -I./blib/lib 

use RTFcard;               # instruction class
use Term::ReadLine;

$host = "wimp.fnal.gov";
# $host = $ENV{HOST};
$port = 2345;
$subrack = 3;
$module = 8;

while ($#ARGV > -1) {
    if ($ARGV[0] eq '-h') {
	shift;$host = $ARGV[0];shift;
    } elsif ($ARGV[0] eq '-p') {
	shift;$port = $ARGV[0];shift;
    } elsif ($ARGV[0] eq '-r') {
	shift;$subrack = $ARGV[0];shift;
    } elsif ($ARGV[0] eq '-m') {
	shift;$module = $ARGV[0];shift;
    } elsif ($ARGV[0] eq '-c') {
        shift; $channel = $ARGV[0];shift;
    } else {
	print "Unknown argument $ARGV[0] $ARGV[1]; skipping pair\n";
	shift;
	shift;
    }
}

print "Host is $host:$port.\n";
print "Using subrack $subrack, set to module $module.\n";
if ($scriptonly == 1) {
    print "Communication with host disabled.\n";
}

$box = new GPIBbox("$host:$port");   # host and port of server.
$box->subrack($subrack);                # controller slider switch.

$rtf = undef;
$username = $ENV{'USER'};

$rtf = new RTFcard($box,$module,$scriptonly);

$ser = $rtf->serial();
$rev = $rtf->version();
$reportdir = "~/electronics/reports/flipRTF/$rev-$ser";
$outfile = "$reportdir/DAC$channel.dat";

$increment = .2;
$maxThresh = 5;
$cmd = join ("",$channel,'Thresh');
$dac = lc($channel);
print $cmd;

system ("rm -f $outfile");          # make a new file.
for ($thresh = 0; $thresh < $maxThresh; $thresh+=$increment){
  measure($rtf,$thresh);
}
$maxThresh -= $increment/2;
for ($thresh = $maxThresh; $thresh >= 0; $thresh-=$increment){
  measure($rtf,$thresh);
}
system ("cp $outfile outfile");
system ("octave plotlin.m");

  sub measure {
  my ($rtf,$thresh) = @_;
  $rtf->$cmd($thresh);
  $rtf->{$dac}->decode();
  $val = 0.5*$rtf->{$dac}->value;
  $val = sprintf "%8.4f",$val;
  system ("echo -n $val >> $outfile");
  system ("echo -n '    ' >> $outfile");
  system ("/home/eichblat/drivers/gpib/multimeter/gv.csh >> $outfile");
  }

\\__END__OF__DAClin.pl__FILE\\
chmod 755 DAClin.pl
echo unsharking benchmark.pl
cat > benchmark.pl << '\\__END__OF__benchmark.pl__FILE\\'
#! /usr/local/bin/perl -I./blib/arch -I./blib/lib 

#
#		rack.pl
#
#    This interface program makes a complete GPIB box setup, with up to 
#    eight subracks.  It requires a file containing the rack card 
#    configuration.  This setup file requires the following format:
#          
#        subrack #
#        <cardtype>,<cardtype>,<cardtype>,...\n
#        subrack #
#        <cardtype>,<cardtype>,<cardtype>,...\n
#    Note that the cards of each subrack must be on a single line.


#    The possible cardtypes are:
#        Z = zip
#        R = rtf
#        B = blip
#        F3D = driver (3u)
#        F3QB = qbias (3u)
#        F3QET = qet (3u)
#        F3S = squid (3u)
#

# First load up all the card packages...

use RTFcard;
use Term::ReadLine;
use FileHandle;
use sigtrap;

$host = "wimp.fnal.gov";
# $host = $ENV{HOST};
$port = 2345;
$subrack = 3;
$module = 1;
$scriptonly = undef;
$setup = undef;

$box = new GPIBbox("$host:$port");
$box->subrack($subrack);

$rtf = new RTFcard($box,$module);

#$i = hex(ffff);
$i = 200;
print scalar localtime, "\n";
while ($i--){
  $a = sprintf "%4x",$i;
#  $box->writeData($a);
#  $rtf->Enable;
  my $ver = $rtf->version;
#  if ($ver != 2) { die "$version wrong version\n"; }
#  print "                                                                   writing $i \n";
}
print scalar localtime,"\n";
;
\\__END__OF__benchmark.pl__FILE\\
chmod 755 benchmark.pl
echo unsharking blip.pl
cat > blip.pl << '\\__END__OF__blip.pl__FILE\\'
#! /usr/local/bin/perl -I./blib/arch -I./blib/lib 

#! /usr/local/bin/perl -I./blib/arch -I./blib/lib -I/usr/local/products/shells/v2_2/lib/perl5/IP20-irix/5.00311 -I/usr/local/products/shells/v2_2/lib/perl5

use BLIPcard;               # instruction class
use Term::ReadLine;

$host = "ppdm06.fnal.gov";
# $host = $ENV{HOST};
$port = 2345;
$subrack = 3;
$module = 8;
$scriptonly = undef;

while ($#ARGV > -1) {
    if ($ARGV[0] eq '-h') {
	shift;
	$host = $ARGV[0];
	shift;
    } elsif ($ARGV[0] eq '-p') {
	shift;
	$port = $ARGV[0];
	shift;
    } elsif ($ARGV[0] eq '-r') {
	shift;
	$subrack = $ARGV[0];
	shift;
    } elsif ($ARGV[0] eq '-m') {
	shift;
	$module = $ARGV[0];
	shift;
    } elsif ($ARGV[0] eq '-s') {
	shift;
	$scriptonly = 1;
    } else {
	print "Unknown argument $ARGV[0] $ARGV[1]; skipping pair\n";
	shift;
	shift;
    }
}

print "Host is $host:$port.\n";
print "Using subrack $subrack, set to module $module.\n";
if ($scriptonly == 1) {
    print "Communication with host disabled.\n";
}

$box = new GPIBbox("$host:$port");   # host and port of server.
$box->subrack($subrack);                # controller slider switch.

$username = $ENV{'USER'};

$minmod = 1;
$maxmod = 21;
for ($imodule=$minmod;$imodule<=$maxmod;$imodule++) {
  $blip[$imodule] = new BLIPcard($box,$imodule,$scriptonly);
}

$term = new Term::ReadLine 'BLIP card interactive Perl Session';

$prompt = "perl: ";
$straight = 0;
$sessionfile = "/tmp/$class-$username-perlsession";
@macros = ("saveScript","endScript","enableBox","disableBox",
	   "accumulate","unaccumulate","execute");

$OUT = $term->OUT || STDOUT;
%features = %{ $term->Features };
if (%features) {
  @f = %features;
}
if ($features{autohistory}) {
  print "got autohistory\n";
  open (INFILE,"<$sessionfile");
  while (<INFILE>) {
    chop;
    $term->addhistory("$_");
  }
  close INFILE;
}
open (OUTFILE,">>$sessionfile");
READLOOP:
while (defined ($_ = $term->readline($prompt,""))){
    if ($_ !~ /exit/) {print OUTFILE "$_\n";}
    for ($i=0;$i<=$#macros;$i++) {
	if ($_ =~ /^$macros[$i]/) {
	    @input = split /[\(,\)]/, $_;
	    shift @input;
	    if ($_ =~ /^saveScript/) {
		if ($#input < 1) {
		    my $in = $input[0];
		    $in =~ s/"//g;
		    if (-e $in) {
			print "Please type\n1 to continue with existing ",
			  $in,",\n2 to overwrite ", $in,
			  ",\n3 to cancel: ";
			chomp($input[1] = <STDIN>);
		    }
		print "Saving script to $in\n";		
		}
	    }
	    $input = join ',',@input;
	    for ($j=$minmod;$j<=$maxmod;$j++) {
		$instruction = "\$blip[$j]->$macros[$i]($input)";
		$res = eval($instruction);
	    }
	    goto bottom;
	}
    }
    if ($_ =~ /\.pl\s*$/) {
        print "running $_...\n";
        system "./$_";
        goto bottom;
    } elsif ( $_ =~ /module/) {
        @Fld = split(' ',$_);
        $module = $Fld[1];
        print "module set to $module\n";
        goto bottom;
  } else {
    if ($_ =~ / /) { $straight = 1; goto bottom;}
    $instruction = "\$blip[$module]->$_";
#    print "instruction is $instruction\n";
    $res = eval($instruction);
#    print "returned $res\n";
    if ($@) {
      $straight = 1;
      warn $@;
    }
  }
bottom:
  if ($straight == 1) {  
    $straight = 0;
    $res = eval($_);
#    print "returned $res\n";
  }
#  if ($@) {
#    warn $@;
#  }
  $term->addhistory($_) if /\S/ and !$features{autohistory};
}
\\__END__OF__blip.pl__FILE\\
chmod 755 blip.pl
echo unsharking f3udriver.pl
cat > f3udriver.pl << '\\__END__OF__f3udriver.pl__FILE\\'
#! /usr/local/bin/perl -I./blib/arch -I./blib/lib

#! /usr/local/bin/perl -I./blib/arch -I./blib/lib -I/usr/local/products/shells/v2_2/lib/perl5/IP20-irix/5.00311 -I/usr/local/products/shells/v2_2/lib/perl5

use FLIP3UDriver;               # instruction class
use Term::ReadLine;

$host = "ppdm06.fnal.gov";
# $host = $ENV{HOST};
$port = 2345;
$subrack = 2;
$module = 0x06;
$scriptonly = undef;

while ($#ARGV > -1) {
    if ($ARGV[0] eq '-h') {
	shift;
	$host = $ARGV[0];
	shift;
    } elsif ($ARGV[0] eq '-p') {
	shift;
	$port = $ARGV[0];
	shift;
    } elsif ($ARGV[0] eq '-r') {
	shift;
	$subrack = $ARGV[0];
	shift;
    } elsif ($ARGV[0] eq '-m') {
	shift;
	$module = $ARGV[0];
	shift;
    } elsif ($ARGV[0] eq '-s') {
	shift;
	$scriptonly = 1;
    } else {
	print "Unknown argument $ARGV[0] $ARGV[1]; skipping pair\n";
	shift;
	shift;
    }
}

print "Host is $host:$port.\n";
print "Using subrack $subrack, set to module $module.\n";
if ($scriptonly == 1) {
    print "Communication with host disabled.\n";
}

$box = new GPIBbox("$host:$port");   # host and port of server.
$box->subrack($subrack);                # controller slider switch.

$minmod=1;
$maxmod=21;
for ($imodule=$minmod;$imodule<=$maxmod;$imodule++) {
    $driver[$imodule] = new FLIP3UDriver($box,$module,$scriptonly);  
}
$term = new Term::ReadLine 'FLIP3U Driver interactive Perl Session';

$username = $ENV{'USER'};
$prompt = "perl: ";
$straight = 0;
$sessionfile = "/tmp/$class-$username-perlsession";
@macros = ("saveScript","endScript","enableBox","disableBox",
	   "accumulate","unaccumulate","execute");

$OUT = $term->OUT || STDOUT;
%features = %{ $term->Features };
if (%features) {
  @f = %features;
}
if ($features{autohistory}) {
  print "got autohistory\n";
  open (INFILE,"<$sessionfile");
  while (<INFILE>) {
    chop;
    $term->addhistory("$_");
  }
  close INFILE;
}
open (OUTFILE,">>$sessionfile");
READLOOP:
while (defined ($_ = $term->readline($prompt,""))){
  if ($_ !~ /exit/) {print OUTFILE "$_\n";}
    for ($i=0;$i<=$#macros;$i++) {
	if ($_ =~ /^$macros[$i]/) {
	    @input = split /[\(,\)]/, $_;
	    shift @input;
	    if ($_ =~ /^saveScript/) {
		if ($#input < 1) {
		    my $in = $input[0];
		    $in =~ s/"//g;
                    print "$in\n";
		    if (-e $in) {
			print "Please type\n1 to continue with existing ",
			  $in,",\n2 to overwrite ", $in,
			  ",\n3 to cancel: ";
			chomp($input[1] = <STDIN>);
		    }
		print "Saving script to $in\n";
		}
	    }
	    $input = join ',',@input;
	    for ($j=$minmod;$j<=$maxmod;$j++) {
		$instruction = "\$driver[$j]->$macros[$i]($input)";
		$res = eval($instruction);
	    }
	    goto bottom;
	}
    }
  if ($_ =~ /\.pl\s*$/) {
    print "running $_...\n";
    system "./$_";
    goto bottom;
  } else {
    if ($_ =~ / /) { $straight = 1; goto bottom;}
    $instruction = "\$driver[$module]->$_";
#    print "instruction is $instruction\n";
    $res = eval($instruction);
#    print "returned $res\n";
    if ($@) {
      $straight = 1;
      warn $@;
    }
  }
bottom:
  if ($straight == 1) {  
    $straight = 0;
    $res = eval($_);
#    print "returned $res\n";
  }
#  if ($@) {
#    warn $@;
#  }
  $term->addhistory($_) if /\S/ and !$features{autohistory};
}

\\__END__OF__f3udriver.pl__FILE\\
chmod 755 f3udriver.pl
echo unsharking f3uqbias.pl
cat > f3uqbias.pl << '\\__END__OF__f3uqbias.pl__FILE\\'
#! /usr/local/bin/perl -I./blib/arch -I./blib/lib

#! /usr/local/bin/perl -I./blib/arch -I./blib/lib -I/usr/local/products/shells/v2_2/lib/perl5/IP20-irix/5.00311 -I/usr/local/products/shells/v2_2/lib/perl5

use FLIP3UQBias;               # instruction class
use Term::ReadLine;

$host = "ppdm06.fnal.gov";
# $host = $ENV{HOST};
$port = 2345;
$subrack = 2;
$module = 0x09;
$scriptonly = undef;

while ($#ARGV > -1) {
    if ($ARGV[0] eq '-h') {
	shift;
	$host = $ARGV[0];
	shift;
    } elsif ($ARGV[0] eq '-p') {
	shift;
	$port = $ARGV[0];
	shift;
    } elsif ($ARGV[0] eq '-r') {
	shift;
	$subrack = $ARGV[0];
	shift;
    } elsif ($ARGV[0] eq '-m') {
	shift;
	$module = $ARGV[0];
	shift;
    } elsif ($ARGV[0] eq '-s') {
	shift;
	$scriptonly = 1;
    } else {
	print "Unknown argument $ARGV[0] $ARGV[1]; skipping pair\n";
	shift;
	shift;
    }
}

print "Host is $host:$port.\n";
print "Using subrack $subrack, set to module $module.\n";
if ($scriptonly == 1) {
    print "Communication with host disabled.\n";
}

$box = new GPIBbox("$host:$port");   # host and port of server.
$box->subrack($subrack);                # controller slider switch.

$minmod=1;
$maxmod=21;
for ($imodule=$minmod;$imodule<=$maxmod;$imodule++) {
    $qbias = new FLIP3UQBias($box,$module,$scriptonly);  
}

$term = new Term::ReadLine 'FLIP3U QBias card interactive Perl Session';

$username=$ENV{'USER'};
$prompt = "perl: ";
$straight = 0;
$sessionfile = "/tmp/$class-$username-perlsession";
@macros = ("saveScript","endScript","enableBox","disableBox",
	   "accumulate","unaccumulate","execute");

$OUT = $term->OUT || STDOUT;
%features = %{ $term->Features };
if (%features) {
  @f = %features;
}
if ($features{autohistory}) {
  print "got autohistory\n";
  open (INFILE,"<$sessionfile");
  while (<INFILE>) {
    chop;
    $term->addhistory("$_");
  }
  close INFILE;
}
open (OUTFILE,">>$sessionfile");
READLOOP:
while (defined ($_ = $term->readline($prompt,""))){
  if ($_ !~ /exit/) {print OUTFILE "$_\n";}
    for ($i=0;$i<=$#macros;$i++) {
	if ($_ =~ /^$macros[$i]/) {
	    @input = split /[\(,\)]/, $_;
	    shift @input;
	    if ($_ =~ /^saveScript/) {
		if ($#input < 1) {
		    my $in = $input[0];
		    $in =~ s/"//g;
                    print "$in\n";
		    if (-e $in) {
			print "Please type\n1 to continue with existing ",
			  $in,",\n2 to overwrite ", $in,
			  ",\n3 to cancel: ";
			chomp($input[1] = <STDIN>);
		    }
		print "Saving script to $in\n";
		}
	    }
	    $input = join ',',@input;
	    for ($j=$minmod;$j<=$maxmod;$j++) {
		$instruction = "\$qbias[$j]->$macros[$i]($input)";
		$res = eval($instruction);
	    }
	    goto bottom;
	}
    }
  if ($_ =~ /\.pl\s*$/) {
    print "running $_...\n";
    system "./$_";
    goto bottom;
  } else {
    if ($_ =~ / /) { $straight = 1; goto bottom;}
    $instruction = "\$qbias[$module]->$_";
#    print "instruction is $instruction\n";
    $res = eval($instruction);
#    print "returned $res\n";
    if ($@) {
      $straight = 1;
      warn $@;
    }
  }
bottom:
  if ($straight == 1) {  
    $straight = 0;
    $res = eval($_);
#    print "returned $res\n";
  }
#  if ($@) {
#    warn $@;
#  }
  $term->addhistory($_) if /\S/ and !$features{autohistory};
}

\\__END__OF__f3uqbias.pl__FILE\\
chmod 755 f3uqbias.pl
echo unsharking gpibServer.pl
cat > gpibServer.pl << '\\__END__OF__gpibServer.pl__FILE\\'
#!/usr/bin/perl

require 5.002;
use strict;
use Socket;
use ServerConnection;

BEGIN {$ENV{PATH} = '/usr/ucb:/bin' }
use Carp;

my $port;
$port = shift || 2345;
my $server = new ServerConnection("$port");
my %devlist = ();
# $server->help();
while (1) {
  $server->openSocket();        ## wait for connection.

TOP:
#  $server->sendString("ready\n");
  my $line = $server->readLine();
  print "read: $line ";
  if ($line =~ "gpibread") {
    my $stat = gpibread();
    print "Status of read: $stat\n";
    goto TOP;
  }
  if ($line =~ "gpibwrite") {
    my $stat = gpibwrite();
    print "Status of write: $stat\n";
    goto TOP;
  }
  if ($line =~ "bye") {
    $server->closeSocket();
    print "socket closed\n";
  }
}
# ------------------------------------------------------------ logmsg
sub logmsg {print "$0 $$: @_ at ",scalar localtime, "\n" }

# ------------------------------------------------------------ gpibfind
sub gpibfind {
  # find the name of the device with address given...
  my $GPIBaddress = shift;
  return $devlist{$GPIBaddress} if (defined($devlist{$GPIBaddress}));

  print "Reading the configuration file to find device $GPIBaddress\n";

  open (CONFFILE,"</etc/gpib.conf") || die "can't open /etc/gpib.conf\n";
  my $name = "";
  my $add = 0;
  while (<CONFFILE>){
    if ($_ =~ /name/) { 
      my @Fld = split('=',$_,9999);
      $name = $Fld[1];
      @Fld = split(' ',$name,9999);
      $name = $Fld[0];
      print $name,"\n";
    }
    if ($_ =~ /pad/) {
      my @Fld = split('=',$_,9999);
      $add = $Fld[1];
    }  
    if ($add == $GPIBaddress) {
      chomp $name;
      $name =~ s/" "//g;
      print "name is $name, address $add\n";
      $devlist{$GPIBaddress} = $name;
      return $name;
    }
  }
  return "Not found"; 
}

# ------------------------------------------------------------ gpibread
sub gpibread {
  my ($bytestofollow,$GPIBaddress,$mode,$timeout,$nbytes);
  my ($size,$data,$statuslength,$status);
  $bytestofollow = $server->readInt();
  $GPIBaddress   = $server->readInt();
  $mode          = $server->readInt();
  $timeout       = $server->readInt();
  $nbytes        = $server->readInt();
  print "in GPIB read  $bytestofollow  $GPIBaddress  $mode  $timeout  $nbytes\n";

  my $err = 0;
  my $device = gpibfind($GPIBaddress);
  if ($device eq "Not found") {$status = -1;}

  if ($status == 0) {
    $nbytes += 4;                                            # for good measure.
    ($status,$nbytes,$data) = ibrd($device,$nbytes);
  }
  if ($status != 0) {
    $nbytes = 0;
    $data = "";
  }

#  print "in gpibread: $nbytes, $data\n";

  $server->sendInt(length($data));
  $server->sendString($data);
  return $status;
# ----------------------------------------------------

}
# ------------------------------------------------------------ ibrd
sub ibrd {
  # this gives an error the first time it is called...
  my ($device,$nbytes) = @_;
  my $data;
  my $ibrd = "/home/eichblat/drivers/gpib/bin/gpibFindRead";
  logmsg ("$ibrd -v $device -n $nbytes ");   
  open (IBRD,"$ibrd -v $device -n $nbytes |") || return -1;   # will this work for binary?
  $data =<IBRD>;
  close IBRD;
#
#   I need some error trapping here.
#
  $data =~ s/^\s*//g;            # chop off leading whitespace
  $data =~ s/\s*$//g;            # chop off trailing whitespace

  my $nread = length($data);
  if ($nread < $nbytes) { $nbytes = $nread; }
  $data = substr $data,0, $nbytes;
  print "in ibrd: $nread, $nbytes, $data\n";
  return (0,$nbytes,$data);
}

# ------------------------------------------------------------ ibwrt
sub ibwrt {
  my ($device,$data) = @_;
  open (DEVICE,">/dev/GPIB/$device") || die "Can't open $device\n";
  logmsg("ibwrt: sending $data to card\n");
  print DEVICE $data;
  close DEVICE;
#  my $ibwrt = "/home/eichblat/drivers/gpib/bin/gpibFindWrite";
#  logmsg("$ibwrt -v $device -d \"$data\"\n");
#  if ((system("$ibwrt -v $device -d \"$data\"\n")) != 0) {
#    return "bad";
#  }
  return (0);
}
# ------------------------------------------------------------ gpibwrite
sub gpibwrite {
  my ($bytestofollow,$GPIBaddress,$mode,$timeout,$nbytes);
  my ($size,$data,$statuslength,$status);

  $bytestofollow = $server->readInt();
  $GPIBaddress   = $server->readInt();
  $mode          = $server->readInt();
  $timeout       = $server->readInt();
  $nbytes        = $server->readInt();
  $size          = $bytestofollow-16;
  $data          = $server->readString($size);
#  print "$bytestofollow $GPIBaddress $mode $timeout $nbytes\n";
#  print "Data:         $data \n";

  my $device = gpibfind($GPIBaddress);
  if ($device eq "Not found") {return -1;}
#  print "device $device\n";

  $device =~ s/^\s*//g;            # chop off leading whitespace
  $device =~ s/\s*$//g;            # chop off trailing whitespace
  $status = ibwrt($device,$data);
#  $status = 0;
  my $len = length($status)+1;
  $server->sendInt($len);
  $server->sendString("$status\n");
  return $status;
}
#-------------------------------------------------------------------- GPIBbox::sleep
sub cheezySleep{
  my $ticks = shift;
  my $i;
  for ($i=0;$i<$ticks;$i++){
    my $a = 0;
    if ($i/5.121 == 3.32){
       $a = 1;
    }
  }
  return;
 }
\\__END__OF__gpibServer.pl__FILE\\
chmod 755 gpibServer.pl
echo unsharking rack.pl
cat > rack.pl << '\\__END__OF__rack.pl__FILE\\'
#! /usr/local/bin/perl -I. -I./blib/arch -I./blib/lib 

#
#		rack.pl
#
#    This interface program makes a complete GPIB box setup, with up to 
#    eight subracks.  It requires a file containing the rack card 
#    configuration.  This setup file requires the following format:
#          
#        subrack #
#        <cardtype>,<cardtype>,<cardtype>,...\n
#        subrack #
#        <cardtype>,<cardtype>,<cardtype>,...\n
#    Note that the cards of each subrack must be on a single line.


#    The possible cardtypes are:
#        Z = zip
#        R = rtf
#        B = blip
#        F3D = driver (3u)
#        F3QB = qbias (3u)
#        F3QET = qet (3u)
#        F3S = squid (3u)
#

# First load up all the card packages...

use BLIPcard;
use RTFcard;
use ZIPcard;
use FLIP3UDriver;
use FLIP3UQBias;
use FLIP3UQet;
use FLIP3USquid;
use Term::ReadLine;
use FileHandle;
use sigtrap;

# Set default variables...

$host = "wimp.fnal.gov";
# $host = $ENV{HOST};
$port = 2345;
$subrack = 3;
$module = 5;
$scriptonly = undef;
$setup = undef;

command_line();

# This is the file containing the rack configuration:

open(SETUP,"<$setup") || die "Can't find $setup\n";

# Initialize several variables

# boards is an array containing references to all of the cards.  It is an 
# array with 8 elements, each of which is a reference to an anonymous array.
# Each anonymous array contains the cards for that subrack.
@boards = ([],[],[],[],[],[],[],[]);   
# class is an array similar in structure to boards, containing the classes
# of the appropriate card
@class = ([],[],[],[],[],[],[],[]);

# Initialize more variables - all are housekeeping variables telling us where
# the boards are.

$isubrack = undef;
@imodule = (undef);
@minmod = (1,1,1,1,1,1,1,1);
@maxmod = @minmod;

# The following routine reads in the setup file and sets up the rack.

setup_rack();

close(SETUP);

# Update maxima according to actual card list.  Also reset defaults if 
# default subrack doesn't exist

$maxsubrack = $isubrack;

#if ($subrack > $maxsubrack) {
if ($isubrack == undef) {die "Subrack undefined\n";}
if ($maxsubrack > 0 && $maxsubrack < 8) {
    $subrack = $maxsubrack;
    print "Subrack set to $subrack\n";
}

@maxmod = @imodule;

if ($module > $maxmod[$subrack]) {
    $module = $maxmod[$subrack];
    print "Module set to $module\n";
}

# Create interactive session and the needed variables

$term = new Term::ReadLine 'Rack Interactive Perl Session';

$prompt = "$class[$subrack][$module] r$subrack,m$module: ";
$straight = 0;
$username = $ENV{'USER'};

# Setup autohistory file to be username-prefix to setup file-perlsession

$setup =~ s/\..*//;
$sessionfile = "/tmp/$username-$setup-perlsession";

# The following macros array contains routines which the user is likely
# to want to apply to all cards, including communication and scripting 
# routines.

@macros = ("saveScript","endScript","enableBox","disableBox",
	   "accumulate","unaccumulate","execute");

# Perform autohistory stuff...

$OUT = $term->OUT || STDOUT;
%features = %{ $term->Features };
if (%features) {
  @f = %features;
}
if ($features{autohistory}) {
#  print "got autohistory\n";
  open (INFILE,"<$sessionfile");
  while (<INFILE>) {
    chop;
    $term->addhistory("$_");
    $histlinenum++;
  }
  close INFILE;
}
open (OUTFILE,">>$sessionfile");
OUTFILE->autoflush(1);

#-------------------------------------------------------------------------
# This is the main interface loop.  It reads in a line, and compares it to
# several defaults, then farms it out to the appropriate subroutine or 
# executes appropriate command.
#-------------------------------------------------------------------------

READLOOP:
while (defined ($_ = $term->readline($prompt,""))){
    $command = $_;
    if ($_ =~ /^\s*$/) { goto bottom; }  # ignore empty lines
# Write to autohistory file any command except exit
    if ($_ !~ /exit/) {
	autohist();
    }
    $_ = $command;
    for ($i=0;$i<=$#macros;$i++) {
	if ($_ =~ /^$macros[$i]/) {
# If it matches a macro command, send to macro execution command.
	    exec_macro();
	    goto bottom;
	}
    }
    if ($_ =~ /\.pl\s*$/) {
# If it has a .pl suffix, assume it's a Perl script and execute it
	exec_pl();
	goto bottom;
    } elsif ( $_ =~ /^module/) {
# If comamnd begins with "module", changes module
	change_module();
	goto bottom;
    } elsif ( $_ =~ /^subrack/) {
# If command begins with "subrack", changes subrack
	change_subrack();
	goto bottom;
    } elsif ( $_ =~ /^mode/) {
# If command begins with "mode", change mode
	set_mode();
        goto bottom;
    } elsif ( $_ =~ /^readfile/) {
# If command begins with "readfile ", read filename as if it's contents were typed
        read_file($_);
        goto bottom;
    } elsif ( $_ =~ /^\s*$/) {
# If empty line, ignore
        goto bottom;
    } elsif ( $_ =~ /^\s*loop/) {
	exec_command();
	goto bottom;
    } else {
	if ($_ =~ / /) { 
# If command contains a space, then it is probably a Perl command so 
# execute it
	    exec_perl_command();
	    goto bottom;
	}
# Send to routine to execute command
	exec_command();
	goto bottom;
    }
bottom:
# Add command to autohistory if you got this far.
    $term->addhistory($_) if /\S/ and !$features{autohistory};
}


#-------------------------------------------------------------------------
#                         SUBROUTINES
#-------------------------------------------------------------------------

#------------------------------------------------------------command_line
# The next routine is the command line processor, resets defaults if given.  
# Also reads in setup file, and can set to scripting mode.

sub command_line {
    @inputs = @ARGV;

# This loop reads in command line arguments and sets appropriate variables.

    while ($#inputs > -1) {
	if ($inputs[0] eq '-h') {
	    shift @inputs;
	    $host = $inputs[0];
	    shift @inputs;
	} elsif ($inputs[0] eq '-p') {
	    shift @inputs;
	    $port = $inputs[0];
	    shift @inputs;
#	} elsif ($inputs[0] eq '-r') {
#	    shift @inputs;
#	    $subrack = $inputs[0];
#	    shift @inputs;
#	} elsif ($inputs[0] eq '-m') {
#	    shift @inputs;
#	    $module = $inputs[0];
#	    shift @inputs;
	} elsif ($inputs[0] eq '-s') {
	    shift @inputs;
	    $scriptonly = 1;
	} elsif ($inputs[0] eq '-i') {
	    shift @inputs;
	    $setup = $inputs[0];
	    shift @inputs;
	} else {
	    print "Unknown argument $inputs[0] $inputs[1]; skipping pair\n";
	    shift @inputs;
	    shift @inputs;
	}
    }

# Give user information about variables, and get setup file if necessary...

    print "Host is $host:$port.\n";
#    print "Using subrack $subrack, set to module $module.\n";
    if ($scriptonly == 1) {
	print "Communication with host disabled.\n";
    }
    unless (defined($setup)) {
	print "Please input setup file: ";
	chomp($setup = <STDIN>);
    }
}

#------------------------------------------------------------setup_rack
# This routine reads in the setup file and sets up the module

sub setup_rack {

@box = [];
 
SETUP: 
    while (<SETUP>) {
# Check for subrack label line; if it is missing, skip line
	if ($_ =~ /^end/i) {
	    last;
	}
	if ($_ =~ /subrack/) {
	    chomp($_);
	    @field = split / /, $_;
	    print "$_\n";
	    $isubrack = $field[1];
	    $box[$isubrack] = new GPIBbox("$host:$port");  
	    $box[$isubrack]->subrack($isubrack);            
#            $box[$isubrack]->print;
	} else {
	    if (length($_) > 0) {
		print "Looking for subrack, skipping $_";
	    }
	    next SETUP;
	}
# Read in next line as card list, and set up array of card types
	$cardlist = <SETUP>;
#	print $cardlist;
	chomp($cardlist);
	my @cardtype = split /,/, $cardlist;
# Loop over each element of cardtype array; for each one, build appropriate
# card and place it in boards array.
	for ($i=0;$i<=$#cardtype;$i++) {
	    $imodule[$isubrack]++;
	    my $imodule = $imodule[$isubrack];
	    $cardtype[$i] =~ s/\W//;
	    if ($cardtype[$i] =~ /^Z/i) {
		$boards[$isubrack][$imodule] = new ZIPcard ($box[$isubrack],
							    $imodule,
							    $scriptonly);
		$class[$isubrack][$imodule] = "zip";
	    } elsif ($cardtype[$i] =~ /^B/i) {
		$boards[$isubrack][$imodule] = new BLIPcard ($box[$isubrack],
							     $imodule,
							     $scriptonly);
		$class[$isubrack][$imodule] = "blip";
	    } elsif ($cardtype[$i] =~ /^R/i) {
		$boards[$isubrack][$imodule] = new RTFcard ($box[$isubrack],
							    $imodule,
							    $scriptonly);
		$class[$isubrack][$imodule] = "rtf";
	    } elsif ($cardtype[$i] =~ /^F3D/i) {
		$boards[$isubrack][$imodule]= new FLIP3UDriver($box[$isubrack],
							       $imodule,
							       $scriptonly);
		$class[$isubrack][$imodule] = "driver";
	    } elsif ($cardtype[$i] =~ /^F3QB/i) {
		$boards[$isubrack][$imodule] = new FLIP3UQBias($box[$isubrack],
							       $imodule,
							       $scriptonly);
		$class[$isubrack][$imodule] = "qbias";
	    } elsif ($cardtype[$i] =~ /^F3QET/i) {
		$boards[$isubrack][$imodule] = new FLIP3UQet ($box[$isubrack],
							      $imodule,
							      $scriptonly);
		$class[$isubrack][$imodule] = "qet";
	    } elsif ($cardtype[$i] =~ /^F3S/i) {
		$boards[$isubrack][$imodule] = new FLIP3USquid($box[$isubrack],
							       $imodule,
							       $scriptonly);
		$class[$isubrack][$imodule] = "squid";
	    }
            if (defined($class[$isubrack][$imodule])) {
               print "module $imodule is a $class[$isubrack][$imodule] \n";
            }
	}
      print "\n";
    }
}

#------------------------------------------------------------autohist
# This routine adds a line to the autohistory, and keeps control of its size

sub autohist {
# Write the command to the outfile
    print OUTFILE "$_\n";
    $histlinenum++;
# When line number gets too high, do something about it
    if ($histlinenum > 300) {
	$histlinenum = 0;
# enddel is where to begin keeping the lines
	$enddel = 151;
	close(OUTFILE);
# The process is to open the sessionfile, copy the recent commands to a tmp
# file, and then delete the old sessionfile, and then rename the tmp file
# to sessionfile.  Everything remains in the current "addhistory" buffer,
# I think.
	open(COPY,"<$sessionfile");
	open(AUTOHIST,">$sessionfile.tmp");
	$linenum=0;
	while (<COPY>) {
	    $linenum++;
	    $line = $_;
	    if ($linenum>$enddel) {
		print AUTOHIST $line;
		$histlinenum++;
	    }
	}
	close(COPY);
	close(AUTOHIST);
	unlink("$sessionfile");
	rename("$sessionfile.tmp","$sessionfile");
	open(OUTFILE,">>$sessionfile");
	OUTFILE->autoflush(1);
    }
}
#------------------------------------------------------------read_file
# Read all the lines in a file as if they had been typed in
# to this parser/interpreter.

sub read_file {
  split ;
  my $comm = shift;
  my ($file) = @_;
  if (length ($file) == 0 ) { 
    print "Please input file: ";
    chomp($file = <STDIN>);
  }
  if (!open(INFILE,"<$file")) { print "Can't open $file\n"; return;}
  print "reading file $file\n";
  while (<INFILE>){
    print $_;
    exec_command();
  }
  close(INFILE);
}

#------------------------------------------------------------exec_macro
# This routine executes a macro for all boards

sub exec_macro {
    @input = split /[\(,\) ]/, $_;
# Get rid of actual command in @input list, to pass arguments
    shift @input;
    @input = (join ',',@input);     # Assemble list of arguments to pass

# If it is saveScript command, send to savescript subroutine for extra
# processing
    if ($_ =~ /^saveScript/) {
	savescript($_);
    }
# Loop over all crates, and all cards in each crate, and apply instruction
    for ($k=0;$k<=$maxsubrack;$k++) {
	for ($j=$minmod[$k];$j<=$maxmod[$k];$j++) {
	    $instruction = "\$boards[$k][$j]->$macros[$i](@input)";
#            print $instruction,(join ',',@input),"\n";
	    $res = eval($instruction);
        }
    }
}

#------------------------------------------------------------savescript
# This routine performs the necessary user input for the saveScript command

sub savescript {
    @Fld = split(' ',$_);
    my $in;
    if ($#Fld <= 1) {
	$in = $Fld[1];
	$in =~ s/"//g;            #"
	if (-e $in) {
	    print "Please type\n1 to continue with existing ",
	           $in,",\n2 to overwrite ", $in,
		   ",\n3 to cancel: ";
	    chomp($Fld[1] = <STDIN>);
	}
	print "Saving script to $in\n";		
    }
    return $in;
}

#------------------------------------------------------------exec_pl
# This routine executes a Perl script from within the interface shell.

sub exec_pl {
    print "running $_...\n";
    system "./$_";
}
#------------------------------------------------------------change_module
# The next two routines change the module and subrack, respectively

sub change_module {
    @Fld = split(' ',$_);
    $module = $Fld[1];
    print "Module set to $module\n";
    $prompt = "$class[$subrack][$module] r$subrack,m$module: ";
}

#------------------------------------------------------------change_subrack
sub change_subrack {
    @Fld = split(' ',$_);
    $subrack = $Fld[1];
    print "Subrack set to $subrack\n";
    $prompt = "$class[$subrack][$module] r$subrack,m$module: ";
}

#------------------------------------------------------------set_mode
# The following routine changes the mode setting.  Possible modes are:
#       blip, rtf, zip, driver, qbias, qet, squid, normal
# In normal mode, commands are executed only to chosen module.  In "card"
# mode, a given command is executed by all cards of that class.

sub set_mode {
    my @Fld = split / /, $_;
    $mode = $Fld[1];
    $mode =~ tr/A-Z/a-z/;
    if ($mode =~ /normal/i) {
	print "Mode set to normal\n";
        $prompt = "$class[$subrack][$module] r$subrack,m$module: ";
	$mode = undef;
    } elsif ($mode !~ /(blip|rtf|zip|driver|qbias|qet|squid)/) {
	print "Error setting mode\n";
        $mode = undef;
    } else {
	print "Mode set to $mode\n";
        $prompt = "$mode: ";
    }
}

#------------------------------------------------------------exec_command
sub exec_command {
# First, if mode is defined, loop through all appropriate cards and apply
# command to them
    if ( $_ =~ /^\s*$/) { return; }
    my $in = $_;
    my $count = 1;
    if ($_ =~ /^loop /) { 
      my @Fld = split " ",$in;
      $count = $Fld[1];
      $in    = $Fld[2];
    }
    while ($count--) {
    if (defined($mode)) {
	for($k=0;$k<=7;$k++) {
	    for($j=$minmod[$k];$j<=$maxmod[$k];$j++) {
		if ($class[$k][$j] eq $mode) {
		    if ($in ne "exit") {
			print "$mode in r$k, m$j\n";
		    }
		    $instruction = "\$boards[$k][$j]->$in";
		    $res = eval($instruction); 
		}
	    }
	}
    } else {
# Otherwise, execute instruction on card currently chosen
	$instruction = "\$boards[$subrack][$module]->$in";
	$res = eval($instruction);
    }
# If an error message pops up, print it for user, then try it as a perl
# command with exec_perl_command routine.
    if ($@) {
	warn $@;
	exec_perl_command();
    }
    }
}

#------------------------------------------------------------exec_perl_command
# If it's a perl command, just execute it with the next routine

sub exec_perl_command {
    $res = eval($_);
}

\\__END__OF__rack.pl__FILE\\
chmod 755 rack.pl
echo unsharking readscript.pl
cat > readscript.pl << '\\__END__OF__readscript.pl__FILE\\'
#! /usr/local/bin/perl

#
#		readscript.pl
#	
#	Program for execution of existing hex script (using the format of 
#	Savescript through rack.pl).


use GPIBbox;

# Initialize variables and files

$script = $ARGV[0];
$echo = $ARGV[1];

unless (defined($script)) {
    print "Please enter script to be performed: ";
    chomp($script = <STDIN>);
    }
unless (defined($echo)) {
    print "Echo comments (y/n)? ";
    chomp($echo = <STDIN>);
    }

$host = "ppdm06.fnal.gov";
$port = "2345";

$box = new GPIBbox("$host:$port");

open(SCRIPT,"$script") || die "Can't open $script\n";

# Read file commands

SCRIPTING: while (<SCRIPT>) {
    @values = split;
    $subrack = $values[0];
    $address = $values[1];
    $dataWord = $values[2];
    $readwrite = $values[3];
    $comment = $values[5];
    if ($comment =~ /[ZIP,RTF,BLIP]) {
	$class = "$comment" . "card";
    } else {
	$class = $comment;
    }
    for ($i = 6; $i <= ($#values); $i++) {
	$comment = $comment . " $values[$i]";
    }
    $box->subrack("$subrack");
    $module = $values[1];
    $module =~ s/(.)(.)../$1$2/;
    $module = int($module);
    $srack = int($subrack); 
    $filename = "/tmp/$host-$class-$srack-$module.out";
    open (FILE,"<$filename") || "Can't open $filename\n";
    if ($readwrite eq "0") {
# Add to queue...
	$box->GPIBconn->addAddress($box->current,$address,$subrack);
	$box->GPIBconn->addData($box->current,$dataWord,$subrack);
    } elsif ($readwrite eq "1") {
# If readwrite variable is read, then execute queue and read back DAC
	$box->GPIBconn->execute();
	$box->writeAddress($address);
	$decdata = $box->readData();
	$dataWord = sprintf "%04x",$decdata;
    }
# Fix persistence file...
    $file =  "/tmp/temp-$class-$srack-$module.out";
    unlink("$file");
    open(TEMP,">$file") || warn "Can't open $file\n";
    while (<FILE>) {
        @Fld = split(' ',$_,9999);
	$hexval = $Fld[1];
        if ("$hexval" eq "$address") {
	    $_ =~ s/$Fld[0](\s*)$Fld[1](\s*)$Fld[2]/$Fld[0] $Fld[1] $dataWord/;
        }
	print TEMP $_;
    }
    close FILE;
    unlink("$filename");
    close TEMP;
    rename("$file","$filename");
    chmod(0666,"$filename");
    if ($echo =~ /y/i) {
	print "Address: $address Data: $dataWord\n";
	print "$comment\n";
    }
}

#Execute items remaining in queue

$box->GPIBconn->execute();

close(SCRIPT);

\\__END__OF__readscript.pl__FILE\\
chmod 755 readscript.pl
echo unsharking rtf.pl
cat > rtf.pl << '\\__END__OF__rtf.pl__FILE\\'
#! /usr/local/bin/perl -I. -I./blib/arch -I./blib/lib 

use RTFcard;               # instruction class
use Term::ReadLine;

$host = "ppdm06.fnal.gov";
# $host = $ENV{HOST};
$port = 2345;
$subrack = 3;
$module = 8;
$scriptonly = undef;

while ($#ARGV > -1) {
    if ($ARGV[0] eq '-h') {
	shift;
	$host = $ARGV[0];
	shift;
    } elsif ($ARGV[0] eq '-p') {
	shift;
	$port = $ARGV[0];
	shift;
    } elsif ($ARGV[0] eq '-r') {
	shift;
	$subrack = $ARGV[0];
	shift;
    } elsif ($ARGV[0] eq '-m') {
	shift;
	$module = $ARGV[0];
	shift;
    } elsif ($ARGV[0] eq '-s') {
	shift;
	$scriptonly = 1;
    } else {
	print "Unknown argument $ARGV[0] $ARGV[1]; skipping pair\n";
	shift;
	shift;
    }
}

print "Host is $host:$port.\n";
print "Using subrack $subrack, set to module $module.\n";
if ($scriptonly == 1) {
    print "Communication with host disabled.\n";
}

$box = new GPIBbox("$host:$port");   # host and port of server.
$box->subrack($subrack);                # controller slider switch.

@rtf = undef;
$username = $ENV{'USER'};

$minmod = 1;
$maxmod = 21;
for ($imodule=$minmod;$imodule<=$maxmod;$imodule++) {
  $rtf[$imodule] = new RTFcard($box,$imodule,$scriptonly);
}

$term = new Term::ReadLine 'RTF card interactive Perl Session';

$prompt = "perl: ";
$straight = 0;
$sessionfile = "/tmp/$class-$username-perlsession";
@macros = ("saveScript","endScript","enableBox","disableBox",
	   "accumulate","unaccumulate","execute");

$OUT = $term->OUT || STDOUT;
%features = %{ $term->Features };
if (%features) {
  @f = %features;
}
if ($features{autohistory}) {
  print "got autohistory\n";
  open (INFILE,"<$sessionfile");
  while (<INFILE>) {
    chop;
    $term->addhistory("$_");
  }
  close INFILE;
}
open (OUTFILE,">>$sessionfile");
READLOOP:
while (defined ($_ = $term->readline($prompt,""))){
    if ($_ !~ /exit/) {print OUTFILE "$_\n";}
    for ($i=0;$i<=$#macros;$i++) {
	if ($_ =~ /^$macros[$i]/) {
	    @input = split /[\(,\)]/, $_;
	    shift @input;
	    if ($_ =~ /^saveScript/) {
		if ($#input < 1) {
		    my $in = $input[0];
		    $in =~ s/"//g;
                    print "$in\n";
		    if (-e $in) {
			print "Please type\n1 to continue with existing ",
			  $in,",\n2 to overwrite ", $in,
			  ",\n3 to cancel: ";
			chomp($input[1] = <STDIN>);
		    }
		print "Saving script to $in\n";
		}
	    }
	    $input = join ',',@input;
	    for ($j=$minmod;$j<=$maxmod;$j++) {
		$instruction = "\$rtf[$j]->$macros[$i]($input)";
		$res = eval($instruction);
	    }
	    goto bottom;
	}
    }
    if ($_ =~ /\.pl\s*$/) {
	print "running $_...\n";
	system "./$_";
	goto bottom;
    } elsif ( $_ =~ /^module/) {
	@Fld = split(' ',$_);
	$module = $Fld[1];
	print "module set to $module\n";
	goto bottom;
    } else {
	if ($_ =~ / /) { $straight = 1; goto bottom;}
	$instruction = "\$rtf[$module]->$_";
#	print "instruction is $instruction\n";
	$res = eval($instruction);
#	print "returned $res\n";
	if ($@) {
	    $straight = 1;
	    warn $@;
	}
    }
bottom:
    if ($straight == 1) {  
	$straight = 0;
	$res = eval($_);
#	print "returned $res\n";
    }
#    if ($@) {
#	warn $@;
#    }
    $term->addhistory($_) if /\S/ and !$features{autohistory};
}
\\__END__OF__rtf.pl__FILE\\
chmod 755 rtf.pl
echo unsharking session.pl
cat > session.pl << '\\__END__OF__session.pl__FILE\\'
#! /usr/local/bin/perl -I./blib/arch -I./blib/lib -I/usr/local/products/shells/v2_2/lib/perl5/IP20-irix/5.00311 -I/usr/local/products/shells/v2_2/lib/perl5

use Term::ReadLine;
use RTFcard;
use ElecModule;

$username = $ENV{'USER'};

$term = new Term::ReadLine 'RTF card interactive Perl Session';

$prompt = "perl: ";
$sessionfile = "/tmp/$username-perlsession";

$OUT = $term->OUT || STDOUT;
%features = %{ $term->Features };
if (%features) {
  @f = %features;
}
if ($features{autohistory}) {
  print "got autohistory\n";
  open (INFILE,"<$sessionfile");
  while (<INFILE>) {
    chop;
    $term->addhistory("$_");
  }
  close INFILE;
}
open (OUTFILE,">>$sessionfile");
READLOOP:
while (defined ($_ = $term->readline($prompt,""))){
    $res = eval($_);
#    print "returned $res\n";
  }
#  if ($@) {
#    warn $@;
#  }
  $term->addhistory($_) if /\S/ and !$features{autohistory};
\\__END__OF__session.pl__FILE\\
chmod 755 session.pl
echo unsharking testcable.pl
cat > testcable.pl << '\\__END__OF__testcable.pl__FILE\\'
#! /usr/local/bin/perl -I./blib/arch -I./blib/lib 

#
#		rack.pl
#
#    This interface program makes a complete GPIB box setup, with up to 
#    eight subracks.  It requires a file containing the rack card 
#    configuration.  This setup file requires the following format:
#          
#        subrack #
#        <cardtype>,<cardtype>,<cardtype>,...\n
#        subrack #
#        <cardtype>,<cardtype>,<cardtype>,...\n
#    Note that the cards of each subrack must be on a single line.


#    The possible cardtypes are:
#        Z = zip
#        R = rtf
#        B = blip
#        F3D = driver (3u)
#        F3QB = qbias (3u)
#        F3QET = qet (3u)
#        F3S = squid (3u)
#

# First load up all the card packages...

use RTFcard;
use Term::ReadLine;
use FileHandle;
use sigtrap;

$host = "wimp.fnal.gov";
# $host = $ENV{HOST};
$port = 2345;
@subracks = (2,3,4);
$module = 1;
$scriptonly = undef;
$setup = undef;
$i = 0;

foreach $subrack (@subracks){
  $box[$i] = new GPIBbox("$host:$port");
  $box[$i]->subrack($subrack);
  $i++;
}

@strings = ("aaaa","5555","0000","ffff");
print scalar localtime, "\n";
foreach $string (@strings) {
  for ($i=0;$i<=$#subracks;$i++){
    $box[$i]->writeAddress($string);
    $box[$i]->writeData($string);
  }
  sleep 5;
}
print scalar localtime,"\n";
;
\\__END__OF__testcable.pl__FILE\\
chmod 755 testcable.pl
echo unsharking trigger.pl
cat > trigger.pl << '\\__END__OF__trigger.pl__FILE\\'
#! /usr/local/bin/perl -I./blib/arch -I./blib/lib 

use BLIPcard;               # instruction class

$host = "ppdm06.fnal.gov";
# $host = $ENV{HOST};
$port = 2345;
$subrack = 3;
$module = 15;
$scriptonly = 0;
$ntimes = 20;

while ($#ARGV > -1) {
    if ($ARGV[0] eq '-h') {
	shift;
	$host = $ARGV[0];
	shift;
    } elsif ($ARGV[0] eq '-p') {
	shift;
	$port = $ARGV[0];
	shift;
    } elsif ($ARGV[0] eq '-n') {
	shift;
	$ntimes = $ARGV[0];
	shift;
    } elsif ($ARGV[0] eq '-r') {
	shift;
	$subrack = $ARGV[0];
	shift;
    } elsif ($ARGV[0] eq '-m') {
	shift;
	$module = $ARGV[0];
	shift;
    } else {
	print "Unknown argument $ARGV[0] $ARGV[1]; skipping pair\n";
	shift;
	shift;
    }
}

$box = new GPIBbox("$host:$port");   # host and port of server.
$box->subrack($subrack);                # controller slider switch.

$blip = new BLIPcard($box,$imodule);
$blip->accumulate;
$blip->LEDpulse($ntimes);
$blip->execute;
$blip->unaccumulate;
\\__END__OF__trigger.pl__FILE\\
chmod 755 trigger.pl
echo unsharking zip.pl
cat > zip.pl << '\\__END__OF__zip.pl__FILE\\'
#! /usr/local/bin/perl -I./blib/arch -I./blib/lib 

#! /usr/local/bin/perl -I./blib/arch -I./blib/lib -I/usr/local/products/shells/v2_2/lib/perl5/IP20-irix/5.00311 -I/usr/local/products/shells/v2_2/lib/perl5


use BLIPcard;
use RTFcard;
use ZIPcard;               # instruction class
use Term::ReadLine;

$host = "ppdm06.fnal.gov";
# $host = $ENV{HOST};
$port = 2345;
$subrack = 3;
$module = 8;
$scriptonly = undef;

while ($#ARGV > -1) {
    if ($ARGV[0] eq '-h') {
	shift;
	$host = $ARGV[0];
	shift;
    } elsif ($ARGV[0] eq '-p') {
	shift;
	$port = $ARGV[0];
	shift;
    } elsif ($ARGV[0] eq '-r') {
	shift;
	$subrack = $ARGV[0];
	shift;
    } elsif ($ARGV[0] eq '-m') {
	shift;
	$module = $ARGV[0];
	shift;
    } elsif ($ARGV[0] eq '-s') {
	shift;
	$scriptonly = 1;
    } else {
	print "Unknown argument $ARGV[0] $ARGV[1]; skipping pair\n";
	shift;
	shift;
    }
}

print "Host is $host:$port.\n";
print "Using subrack $subrack, set to module $module.\n";
if ($scriptonly == 1) {
    print "Communication with host disabled.\n";
}

$box = new GPIBbox("$host:$port");   # host and port of server.
$box->subrack($subrack);                # controller slider switch.

@rtf = undef;
$username = $ENV{'USER'};

$modmin = 1;
$modmax = 21;
for ($imodule=$modmin;$imodule<=$modmax;$imodule++) {
  $zip[$imodule] = new ZIPcard($box,$imodule,$scriptonly);
}

$term = new Term::ReadLine 'ZIP card interactive Perl Session';

$class = "zip";
$prompt = "$class: ";
$straight = 0;
$sessionfile = "/tmp/$class-$username-perlsession";
@macros = ("saveScript","endScript","enableBox","disableBox",
	   "accumulate","unaccumulate","execute");

$OUT = $term->OUT || STDOUT;
%features = %{ $term->Features };
if (%features) {
  @f = %features;
}
if ($features{autohistory}) {
  print "got autohistory\n";
  open (INFILE,"<$sessionfile");
  while (<INFILE>) {
    chop;
    $term->addhistory("$_");
  }
  close INFILE;
}
open (OUTFILE,">>$sessionfile");
READLOOP:
while (defined ($_ = $term->readline($prompt,""))){
    if ($_ !~ /exit/) {print OUTFILE "$_\n";}
    for ($i=0;$i<=$#macros;$i++) {
	if ($_ =~ /^$macros[$i]/) {
	    @input = split /[\(,\)]/, $_;
	    shift @input;
	    if ($_ =~ /^saveScript/) {
		if ($#input < 1) {
	            $in = $input[0];
		    $in =~ s/"//g;
                    print "$in\n";
		    if (-e $in) {
			print "Please type\n1 to continue with existing ",
			  $in,",\n2 to overwrite ", $in,
			  ",\n3 to cancel: ";
			chomp($input[1] = <STDIN>);
		    }
		print "Saving script to $in\n";		
		}
	    }
	    $input = join ',',@input;
	    for ($j=$minmod;$j<=$maxmod;$j++) {
		$instruction = "\$zip[$j]->$macros[$i]($input)";
		$res = eval($instruction);
	    }
	    goto bottom;
	}
    }
    if ($_ =~ /\.pl\s*$/) {
	print "running $_...\n";
	system "./$_";
	goto bottom;
    } elsif ( $_ =~ /^module/) {
	@Fld = split(' ',$_);
	$module = $Fld[1];
	print "module set to $module\n";
	goto bottom;
    } else {
	if ($_ =~ / /) { $straight = 1; goto bottom;}
	$instruction = "\$zip[$module]->$_";
	$res = eval($instruction);
	if ($@) {
	    $straight = 1;
	    warn $@;
	}
    }
bottom:
    if ($straight == 1) {  
	$straight = 0;
	$res = eval($_);
	print "returned $res\n";
    }
#    if ($@) {
#        warn $@;
#    }
    $term->addhistory($_) if /\S/ and !$features{autohistory};
}
\\__END__OF__zip.pl__FILE\\
chmod 755 zip.pl
\\__END__OF__Perl.sh__FILE\\
chmod 664 Perl.sh
echo unsharking blip.crate
cat > blip.crate << '\\__END__OF__blip.crate__FILE\\'
subrack 1
R,B,B,,B
subrack 2
,B,R,
subrack 3
,,,,,,,B
subrack 4
,,,,B
end
\\__END__OF__blip.crate__FILE\\
chmod 664 blip.crate
echo unsharking rtf.crate
cat > rtf.crate << '\\__END__OF__rtf.crate__FILE\\'
subrack 3
R,R,R,R,R,R,R,R,R,R,R,R,R,R,R,R,R,R,R,R,R
end
\\__END__OF__rtf.crate__FILE\\
chmod 664 rtf.crate
echo unsharking squid3U.crate
cat > squid3U.crate << '\\__END__OF__squid3U.crate__FILE\\'
subrack 3
F3QET,F3S,F3S,F3S,F3S,F3D,F3QB
end
\\__END__OF__squid3U.crate__FILE\\
chmod 664 squid3U.crate
echo unsharking squidBroken3U.crate
cat > squidBroken3U.crate << '\\__END__OF__squidBroken3U.crate__FILE\\'
subrack 2
F3S,F3S,F3S
end
\\__END__OF__squidBroken3U.crate__FILE\\
chmod 664 squidBroken3U.crate
echo unsharking test.crate
cat > test.crate << '\\__END__OF__test.crate__FILE\\'
,,,B
end
\\__END__OF__test.crate__FILE\\
chmod 664 test.crate
sh Perl.sh