Index: /trunk/Ohana/src/perl/src/cadc2qso
===================================================================
--- /trunk/Ohana/src/perl/src/cadc2qso	(revision 105)
+++ /trunk/Ohana/src/perl/src/cadc2qso	(revision 105)
@@ -0,0 +1,46 @@
+#!/usr/local/bin/perl
+# extract mosaic IQ values from table, send to QSO db
+
+sub vsystem {
+    print STDERR "@_\n";
+    $status = system ("@_");
+    $status;
+}
+
+sub goodbye {
+    die "@_\n";
+}
+
+if (@ARGV != 1) { die "USAGE: cadc2qso (table.fits)\n"; }
+
+# update the following entries to the QSO database (one per mosaic):
+
+# --iq_center (OBS_IQ_CENTER)
+# --iq_r_ratio (OBS_IQ_R_RATIO)
+# --iq_x_ratio (OBS_IQ_X_RATIO)
+# --iq_y_ratio (OBS_IQ_Y_RATIO)
+
+# add error checking on the ftable call...
+@obsid = `ftable -column OBSID $ARGV[0]`;
+@iqcen = `ftable -column OBS_IQ_CENTER $ARGV[0]`;
+@iqr   = `ftable -column OBS_IQ_R_RATIO $ARGV[0]`;
+@iqx   = `ftable -column OBS_IQ_X_RATIO $ARGV[0]`;
+@iqy   = `ftable -column OBS_IQ_Y_RATIO $ARGV[0]`;
+
+foreach $value (@obsid) { chop $value; }
+foreach $value (@iqcen) { chop $value; }
+foreach $value (@iqr)   { chop $value; }
+foreach $value (@iqx)   { chop $value; }
+foreach $value (@iqy)   { chop $value; }
+
+$Nrow = @obsid;
+if ($Nrow != @iqcen) { &goodbye ("error in OBS_IQ_CENTER"); }
+if ($Nrow != @iqr) { &goodbye ("error in OBS_IQ_R_RATIO"); }
+if ($Nrow != @iqx) { &goodbye ("error in OBS_IQ_X_RATIO"); }
+if ($Nrow != @iqy) { &goodbye ("error in OBS_IQ_Y_RATIO"); }
+
+for ($i = 0; $i < $Nrow; $i++) {
+    vsystem ("/cfht/bin/update_xexpe.sh -U qso_elixir -P op1eliw --obsid $obsid[$i] --iq_center $iqcen[$i] --iq_r_ratio $iqr[$i] --iq_x_ratio $iqx[$i] --iq_y_ratio $iqy[$i]");
+}
+print STDOUT "SUCCESS: done with $ARGV[0]\n";
+exit (0);
Index: /trunk/Ohana/src/perl/src/defringe.ccd
===================================================================
--- /trunk/Ohana/src/perl/src/defringe.ccd	(revision 105)
+++ /trunk/Ohana/src/perl/src/defringe.ccd	(revision 105)
@@ -0,0 +1,141 @@
+#!/usr/bin/env perl
+
+# grab the command line options
+$close = "";
+$quiet = 0;
+$preserve = 0;
+@tARGV = ();
+for (; @ARGV > 0; ) {
+    if ($ARGV[0] eq "-close") {
+	$close = "-close";
+        shift; next;
+    }
+    if ($ARGV[0] eq "-quiet") {
+	$quiet = 1;
+        shift; next;
+    }
+    if ($ARGV[0] eq "-preserve") {
+        $preserve = 1;
+        shift; next;
+    }
+    @tARGV = (@tARGV, $ARGV[0]);
+    shift;
+}
+@ARGV = @tARGV;
+
+if (@ARGV != 4) { &escape ("USAGE: defringe.chip (input) (output) (ccd) (mode) [-close]"); }
+
+# various lists
+$input  = $ARGV[0];
+$output = $ARGV[1];
+$ccd    = $ARGV[2];
+$mode   = uppercase ($ARGV[3]);
+if ($mode ne "SPLIT") { &escape ("defringe.ccd requires SPLIT input data for now"); }
+
+# load config info
+$dbmode = `gconfig DETREND-DB-MODE`; chop $dbmode;
+$ccdn   = `cameraconfig -N $ccd`; chop $ccdn;
+
+# find fringe-point file (always MEF)
+$frpts  = `detsearch -quiet -image $input $ccd split -type frpts`; chop $frpts;
+if ($?) { &escape ("can't get fringe points for image"); }
+
+# measure fringe amplitude of input image
+($name, $sky, $rng, $drng) = split (" ", `getfringe $input $ccd $frpts 1`);
+if ($?) { &escape ("failure to measure fringe amplitude"); }
+
+# find fringe master frames
+$file = `detsearch -quiet $close -image $input $ccd split -type fringe`; chop $file;
+if ($?) { &escape ("can't find fringe master for $input"); }
+
+$frmaster = $file;
+if ($dbmode eq "MEF") { $frmaster = "$file\[$ccd\]"; }
+
+# get fringe master stats
+if ($dbmode eq "MEF") {
+    ($name, $C0, $C1, $SKY, $RNG) = split (" ", `echo $file | fields -x $ccdn FRNG_C0 FRNG_C1 FRNG_SKY FRNG_RNG`);
+} else {
+    ($name, $C0, $C1, $SKY, $RNG) = split (" ", `echo $file | fields FRNG_C0 FRNG_C1 FRNG_SKY FRNG_RNG`);
+}
+
+if (-e $output) { unlink $output; }
+
+# load flips parameter file
+$paramfile = `gconfig FLIPS_PARAM_DEFRINGE`; chop $paramfile;
+open (FILE, "$paramfile");
+@rawpars = <FILE>;
+close (FILE);
+
+$infile  = mktemp ("\@defringe");
+$parfile = mktemp ("defringe");
+
+# create input list file
+$s0 = $sky;
+$s1 = $SKY;
+$RF = $RNG / $rng;
+$ds = 0.0;
+open (FILE, ">$infile");
+print FILE "$input    $s0 1.0 $ds\n";
+print FILE "$frmaster $s1 $RF $ds\n";
+close (FILE);
+
+# create input par file
+@params = @rawpars;
+foreach $line (@params) {
+    $line =~ s|LISTNAME|$infile|;
+    $line =~ s|FILENAME|$output|;
+    $line =~ s|COMMENT|Elixir Defringing|;
+}
+open (FILE, ">$parfile");
+foreach $line (@params) { print FILE "$line"; }
+close (FILE);
+
+vsystem ("imcombred $parfile");
+if ($?) { &escape ("failure running imcombred"); }
+
+&goodbye;
+
+########
+
+sub vsystem {
+    print STDERR "@_\n";
+    $status = system ("@_");
+    $status;
+}
+
+@temp = ();
+sub mktemp {
+
+    my ($base) = $_[0];
+    my ($name);
+    $name = `mktemp /tmp/$base.XXXXXX`;
+    chop $name;
+
+    push @temp, $name;
+    return $name;
+}
+
+sub uppercase {
+    return "\U$_[0]\E";
+}
+
+sub escape {
+    $message = $_[0];
+    foreach $name (@temp) {
+	unlink ($name);
+    }
+    if ($quiet) { 
+	die "$message\n";
+    } else {
+	die "ERROR: $message\n"; 
+    }
+}
+
+sub goodbye {
+    foreach $name (@temp) { 
+	if ($preserve) { print STDERR "tmp file: $name\n"; }
+	else { unlink ($name); }
+    }
+    if (!$quiet) { print STDERR "SUCCESS\n"; }
+    exit 0;
+}
