#!/bin/perl

# Script to copy the stash from one job to another.
#
# See-also: Jeff Coles "copy_stash"
#
# wmc@bas.ac.uk, vn1.0

sub usage {

  "
   warning: this code can operate directly on the DBSE files. If you don't have write
            access, it won't work. Also, you can screw up the files themselves with
            no checking. Probably best to back them up first, or operate on downloaded
            files instead (FROM=.).


   status: appears to work. Should probably be considerede 'alpha'.


   use: copy_stash.pl [TEST=1] [DEBUG=n] [MODE=mode] [FROM=dir] source destination

        source: RUNID, eg aaxzc
        destination: RUNID

        FROM=dbse - default - read files direct from the DBSE. In this case, RUNID \"eeeej\" is
                    assumed to be in eeee/j
            =dir  - read from directory dir.
                    In this case RUNID eeeej is assumed in dir/basis_eeeej


        MODE=ow   - overwrite - default (and probably safest): overwrite dest stash with source
            =m    - merge - attempt to merge source and dest into dest
            =ma   - only merge atmos diags
            =mo   - only merge ocean diags

          Overwrite mode copies the entire stash section. Merge just copies the items, etc.
          If you use merge mode, be sure that the usage profiles etc are the same
          between the jobs. Attempting to merge ocean diags into an atmos-only job would be unwise. Perhaps.

        TEST=1    - write output to current directory. Test will be enabled also if the dest job is open.

        DEBUG=1   - extra info.


   known bugs:

     - if you merge an atmos-only job into an AO one with MODE=m, the atmos diags
       get added to the ocean ones. But if you use MODE=ma its OK, except the output
       messages may be confusing.

  "

};

# Config section. You will want to change these unless you are at bas...
my $DBSE="/data/vacs/umui_manchester_new/umui2.0/DBSE/";

# Other variables
my ($source,$sx,$sj,$st,$nsad,$nsod,$sourcef);
my ($dest,$dx,$dj,$dt,$ndad,$ndod,$destf);
my ($TEST,$DEBUG,$MODE,$FROM);

$DEBUG=0;
$TEST=0;
$MODE="ow";
$FROM="dbse";

# Command line args
eval "\$$1=\$2" while $ARGV[0] =~ /^(\w+)=(.*)/ && shift;

# Get arguments

$source=shift or die &usage();
$dest=shift or die &usage();
($sx,$sj)=($source=~/(....)(.)/);
($dx,$dj)=($dest=~/(....)(.)/);

# Decide on location of input and output

if ($FROM eq "dbse") {

  $sourcef="$DBSE/$sx/$sj";
  $st=`cat $DBSE/$sx/$sj.job`; @st=split(/\n/,$st);
  if ($DEBUG > 0) { print "Source description: $st[1]\n" };
  if ($st[13] ne "N") {
    print "Source job is open by $st[13]. DBSE state may not reflect UMUI. Make sure you're pressed 'save'\n"
  };

  $destf="$DBSE/$dx/$dj";
  $dt=`cat $DBSE/$dx/$dj.job`; @dt=split(/\n/,$dt);
  if ($DEBUG > 0) { print "Destination description: $dt[1]\n" };
  if ($dt[13] ne "N") {
    print "Destination job is open by $dt[13]. Cannot write; Test mode only (TEST=1)\n";
    $TEST=1
  };

} else {

  $sourcef="$FROM/basis_$source";
  $destf="$FROM/basis_$dest";

};

# Read in source and destination

$st=`cat $sourcef`;
if (length($st) < 50000) {
  print "Source job state corrupt? Length is only ".length($st).". Setting TEST=1\n";
  $TEST=1
};
($nsad) = ($st=~/NDIAG_A=(\d+)/);
($nsod) = ($st=~/NDIAG_O=(\d+)/);
if ($DEBUG > 0) { print "Source job has $nsad atmos and $nsod ocean diags\n" };

$dt=`cat $destf`;
if (length($dt) < 100000) {
  print "Destination job state corrupt? Length is only ".length($dt).". Setting TEST=1\n";
  $TEST=1
};
($ndad) = ($dt=~/NDIAG_A=(\d+)/);
($ndod) = ($dt=~/NDIAG_O=(\d+)/);
if ($DEBUG > 0) { print "Destination job has $ndad atmos and $ndod ocean diags\n" };

# Parse the source and dest stashs (only necessary for merge mode)

my ($rasti,$rosti)=parse_st("source",$st);
my ($rasto,$rosto)=parse_st("destination",$dt);

# OK, thats enough setup. Now extract stash and move it across.

($ssa) = ($st =~ /(a2321[^&]*&END)/ms);
($sso) = ($st =~ /(o2321[^&]*&END)/ms);
if ($DEBUG > 4) { print "Source stash is: $ssa\n\n$sso" };

# Overwrite is easy: just copy source to dest

if ($MODE eq "ow" ) {
  
  $dt =~ s/a2321[^&]*&END/$ssa/ms; 
  $dt =~ s/o2321[^&]*&END/$sso/ms; 

# Merge is harder, because we have to understand it

} elsif ($MODE =~ /^m/i ) {

# Merge internally to us
  if ($MODE =~ /^(ma|m$)/i ) {
    print "ATMOS\n";
    for $k (sort numeric (keys %$rasti)) {
      if (defined $$rasto{$k}) {
        print "$k is in source and dest; no change\n"
      } else {
        print "$k is in source and not dest; adding\n";
        $$rasto{$k}=$$rrasti{$k}
      };
    };
  };
 
  if ($MODE =~ /^(mo|m$)/i ) {
    print "OCEAN\n";
      for $k (sort numeric (keys %$rosti)) {
      if (defined $$rosto{$k}) {
        print "$k is in source and dest; no change\n"
      } else {
        print "$k is in source and not dest; adding\n";
        $$rosto{$k}=$$rrosti{$k}
      };
    };
  };
# Now write the new bits to text
  ($nda,$nsta)=rewrite_st("A",$rasto);
  ($ndo,$nsto)=rewrite_st("O",$rosto);

# Now insert the new bits
  if ($MODE eq "m" or $MODE =~ /a/) { $dt =~ s/IINC_A=.*NDIAG_A=\d+/${nsta}\n NDIAG_A=$nda/ms }; 
  if ($MODE eq "m" or $MODE =~ /o/) { $dt =~ s/IINC_O=.*NDIAG_O=\d+/${nsto}\n NDIAG_O=$ndo/ms }; 

} else {

  die "unknown MODE $MODE"

};


# Write out destination (unless test is set)

if ($TEST) { 

  $fileout="> ./$dest.$TEST";
  print "TEST=$TEST; writing modified job to $fileout\n";

} else {

  $fileout="> $destf"

};

open OUT, $fileout or die "Failed to open $fileout for write";
print OUT $dt;
if ($DEBUG > 0) { print "Wrote ".length($dt)." bytes to $fileout.\n" };


sub parse_st {

  my ($io,$st)=@_;

  my (%ast,$rast,%ost,$rost);

# Parse the input stash. All we retain is %ast and %ost.
  my @syn=splitup("IINC_A","IUSE_A",$st);
  my @siu=splitup("IUSE_A","IDOM_A",$st);
  my @sid=splitup("IDOM_A","ITIM_A",$st);
  my @sit=splitup("ITIM_A","ITEM_A",$st);
  my @sii=splitup("ITEM_A","ISEC_A",$st);
  my @sis=splitup("ISEC_A","NDIAG_A",$st);

  if ($DEBUG > 1) { print "ATMOS $io stash:\n" };
  for (my $i=0; $i<scalar(@syn); $i++) {
    if ($DEBUG > 3) { print "$syn[$i] $siu[$i] $sid[$i] $sis[$i].$sii[$i].$sit[$i]\n" };
# Note the sprintf - this is to get the ordering right when we sort on the key.
    $ast{$sis[$i].".".sprintf("%03.0d",$sii[$i]).",$syn[$i],$siu[$i],$sid[$i],$sit[$i]"}=1;
  };
  for $k (sort numeric keys %ast) { if ($DEBUG > 1) { print "$k $ast{$k}\n" } };

  my @syn=splitup("IINC_O","IUSE_O",$st);
  my @siu=splitup("IUSE_O","IDOM_O",$st);
  my @sid=splitup("IDOM_O","ITIM_O",$st);
  my @sit=splitup("ITIM_O","ITEM_O",$st);
  my @sii=splitup("ITEM_O","ISEC_O",$st);
  my @sis=splitup("ISEC_O","NDIAG_O",$st);

  if ($DEBUG > 1) { print "OCEAN $io stash:\n" };
  for (my $i=0; $i<scalar(@syn); $i++) {
    if ($DEBUG > 3) { print "$syn[$i] $siu[$i] $sid[$i] $sis[$i].$sii[$i].$sit[$i]\n" };
# Note the sprintf - this is to get the ordering right when we sort on the key.
    $ost{$sis[$i].".".sprintf("%03.0d",$sii[$i]).",$syn[$i],$siu[$i],$sid[$i],$sit[$i]"}=1;
  };
  for $k (sort numeric keys %ost) { if ($DEBUG > 1) { print "$k $ost{$k}\n" } };

  $rast=\%ast;
  $rost=\%ost;

  return ($rast,$rost);

};

sub splitup {

  my($h,$t,$st)=@_;

  my ($s,@s);

  ($s)=($st =~ /$h=(.*)$t=/ms);
  $s=~s/\n //g;
  @s=split(/,/,$s);

  return @s

};

sub numeric { $a <=> $b };

sub rewrite_st {

  my ($ao,$rst) = @_;

  $txt="";

  if ($DEBUG > 1) { print "rewrite: output STASH for $ao will be:\n" };

# Reconstruct arrays
  my $i=0;
  for $k (sort numeric keys %$rst) {
    ($is[$i],$ii[$i],$yn[$i],$iu[$i],$id[$i],$it[$i])=($k =~ /(\d+)\.(\d+),([^,]+),([^,]+),([^,]+),([^,]+)/);
# Undo the sprintf or the UMUI gets sad and confused
    $ii[$i]=sprintf("%d",$ii[$i]);
    if ($DEBUG > 1) { print "$k: $is[$i],$ii[$i],$yn[$i],$iu[$i],$id[$i],$it[$i]\n" };
    $i++
  };

# Write
  $txt.="IINC_$ao=".join(",\n ",@yn);
  $txt.="\n IUSE_$ao=".join(",\n ",@iu);
  $txt.="\n IDOM_$ao=".join(",\n ",@id);
  $txt.="\n ITIM_$ao=".join(",\n ",@it);
  $txt.="\n ITEM_$ao=".join(",\n ",@ii);
  $txt.="\n ISEC_$ao=".join(",\n ",@is);

  return ($i,$txt);

};