Index: branches/pap/ippScripts/scripts/receive_file.pl
===================================================================
--- branches/pap/ippScripts/scripts/receive_file.pl	(revision 23948)
+++ branches/pap/ippScripts/scripts/receive_file.pl	(revision 25027)
@@ -17,6 +17,8 @@
 use IPC::Cmd 0.36 qw( can_run run );
 use PS::IPP::Metadata::Config;
+use PS::IPP::Metadata::List qw( parse_md_list );
 use PS::IPP::Config 1.01 qw( :standard );
-use File::Temp qw( tempfile );
+use File::Temp qw( tempfile tempdir );
+use File::Basename qw( basename );
 use Carp;
 
@@ -33,8 +35,8 @@
 }
 
-my $tempdir = "/tmp";
+my $temproot = "/tmp";
 
 # Parse the command-line arguments
-my ( $file_id, $source, $product, $fileset, $file, $workdir, $dbname, $verbose, $no_update, $save_temps );
+my ( $file_id, $source, $product, $fileset, $fileset_id, $file, $component, $bytes, $md5sum, $workdir, $dirinfo_uri, $dbname, $verbose, $no_update, $save_temps );
 
 GetOptions(
@@ -43,6 +45,11 @@
            'product=s'         => \$product, # Product for data
            'fileset=s'         => \$fileset, # Fileset for data
+           'fileset_id=s'      => \$fileset_id, # database id for the fileset
            'file=s'            => \$file, # File to retrieve
+           'component=s'       => \$component, # component for this file (class_id, skycell_id or dbinfo)
+           'bytes=i'           => \$bytes, # file size in bytes
+           'md5sum=s'          => \$md5sum, # md5sum for file from data store
            'workdir=s'         => \$workdir, # Working directory for output
+           'dirinfo=s'    => \$dirinfo_uri, # file containing the destination directories for this component
            'dbname=s'          => \$dbname,    # Database name
            'verbose'           => \$verbose,   # Print to stdout
@@ -52,5 +59,5 @@
 
 pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV;
-pod2usage( -msg => "Required options: --file_id --source --product --fileset --file --workdir",
+pod2usage( -msg => "Required options: --file_id --source --product --fileset --file --component --workdir --bytes --md5sum --dirinfo",
            -exitval => $PS_EXIT_CONFIG_ERROR) unless
     defined $file_id and
@@ -59,8 +66,21 @@
     defined $fileset and
     defined $file and
+    defined $component and
+    defined $bytes and
+    defined $md5sum and
+    defined $dirinfo_uri and
     defined $workdir;
+
+my $tempdir = tempdir( "$temproot/receive.$file_id.XXXX", CLEANUP => !$save_temps);
+
+&my_die( "dirinfo is NULL for $component", $file_id, $PS_EXIT_CONFIG_ERROR )
+    if (($dirinfo_uri eq "NULL") and ($component ne "dirinfo"));
 
 my $ipprc = PS::IPP::Config->new() or
     &my_die( "Unable to set up", $file_id, $PS_EXIT_CONFIG_ERROR ); # IPP configuration
+
+my $mdcParser = PS::IPP::Metadata::Config->new;
+
+
 
 # Retrieve file
@@ -69,43 +89,181 @@
     my $uri = "$source/$product/$fileset/$file"; # URI for datastore file
     my $command = "dsget --uri $uri --filename $filename"; # Command to execute
+    $command .= " --timeout 590";
+    $command .= " --bytes $bytes --md5 $md5sum";
 
     my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
         run(command => $command, verbose => $verbose);
-    die "Unable to retrieve file from $uri\n" unless $success;
+    &my_die( "Unable to retrieve file from $uri\n", $file_id, $PS_EXIT_DATA_ERROR) unless $success;
 }
 my $mjd_copy = DateTime->now->mjd;   # MJD of finishing copy
 
+# figure out which dirinfo file to read
+my $dirinfo_file_to_read = $component eq "dirinfo" ? $filename : $dirinfo_uri;
+
+# process it
+my ($destdir, $components, $dirinfo_lines) = read_dirinfo_file($dirinfo_file_to_read, $file_id);
+
+# select a directory for the dirinfo and dbinfo files
+# XXX: perhaps this directory should be set by the script and passed in
+# rather than computed here.
+
+my ($day, $month, $year) = (localtime)[3,4,5];
+my $datestr = sprintf "%04d%02d%02d", $year+1900, $month + 1, $day;
+my $dir_for_info_files = caturi($workdir, $datestr, $fileset);
+
 # Deal with file
-if ($file =~ m|^dbinfo\.\S+\.mdc$|) {
-    # Load into database
-
-    # Need to fix paths to point to new workdir
-    my ($fixFile, $fixName) = tempfile( "$tempdir/$file.XXXX", UNLINK => !$save_temps ); # Fixed file
-    open my $inFile, $filename or die "Can't open $filename\n"; # Input file
-    my $workdir_old;            # Old workdir
-    while (<$inFile>) {
-        # XXX This is a global approach to fixing the path: it should fix anything and everything, but won't
-        # work if there are multiple workdirs in a file and the bits are all mixed up.  To cover that case,
-        # we should fix each of the elements (workdir, uri, path_base) separately.
-        if (m|^\s*workdir\s+STR\s+(\S+)|) {
-            $workdir_old = $1;
-            $workdir_old =~ s|\@HOST\@|\\S+|;
-        }
-        if (defined $workdir_old) {
-            s|$workdir_old|$workdir|;
-        }
-        print $fixFile $_;
-    }
-    close($inFile);
-
-    my ($stage) = $file =~ m|^dbinfo\.(\S+)\.\d+\.mdc$|; # Stage of interest
-    my $tool = can_run("${stage}tool") or die "Can't find tool to load $file\n";
-
-    my $command = "$tool -importrun -infile $fixName"; # Command to execute
+if ($component eq 'dirinfo') {
+    # save the dirinfo file contents into the $workdir
+
+    $dirinfo_uri = caturi($dir_for_info_files, basename($filename));
+    print "dirinfo_uri: $dirinfo_uri\n" if $verbose;
+
+    my $resolved = $ipprc->file_resolve($dirinfo_uri, 'create');
+    &my_die( "failed to resolve $dirinfo_uri\n", $file_id, $PS_EXIT_UNKNOWN_ERROR) if !$resolved;
+
+    print "dirinfo resolved is: $resolved\n" if $verbose;
+
+    open OUT, ">$resolved" 
+        or &my_die( "failed to open $resolved\n", $file_id, $PS_EXIT_UNKNOWN_ERROR);
+    print OUT @$dirinfo_lines
+        or &my_die( "failed to write $resolved\n", $file_id, $PS_EXIT_UNKNOWN_ERROR);
+    close OUT
+        or &my_die( "failed to close $resolved\n", $file_id, $PS_EXIT_UNKNOWN_ERROR);
+    
+    # update the fileset to allow processing of other files
+    my $command = "$receivetool -updatefileset -fileset_id $fileset_id";
+    $command .= " -set_state new -dirinfo $dirinfo_uri";
     $command .= " -dbname $dbname" if defined $dbname;
+
     my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
         run(command => $command, verbose => $verbose);
-    die "Unable to load $fixName\n" unless $success;
-} elsif ($file =~ m|.*\.tgz$|) {
+    &my_die( "Unable to update fileset $fileset_id to\n", $file_id, $PS_EXIT_UNKNOWN_ERROR) unless $success;
+
+} elsif ($component eq "dbinfo") {
+
+    open INFILE, $filename or &my_die( "Can't open $filename\n", $file_id, $PS_EXIT_UNKNOWN_ERROR);
+
+    my @lines = (<INFILE>);
+
+    my $dbinfo = join "", @lines;
+
+    close INFILE;
+
+    my $dbinfo_uri = caturi($dir_for_info_files, basename($filename));
+    print "dbinfo_uri: $dbinfo_uri\n" if $verbose;
+
+    my $resolved = $ipprc->file_resolve($dbinfo_uri, 'create');
+    &my_die( "failed to resolve $dbinfo_uri\n", $file_id, $PS_EXIT_UNKNOWN_ERROR) if !$resolved;
+
+    open OUT, ">$resolved" 
+        or &my_die( "failed to open $resolved\n", $file_id, $PS_EXIT_UNKNOWN_ERROR);
+
+    # We process the dbinfo file (the exported run from the distribution) line by line
+    # Rather than read it as an mdc and interptet it, we do our substitutions directly
+    # This is much faster. Parsing a mdc file for a chip run takes several seconds.
+    # we are very strict about the format of the file
+    #
+    # First comes the data for the Run
+    # Next is the data for each component
+    # The component_id (class_id, skycell_id) must come before any of the paths that we edit
+
+    # The first line tells us the run type. From this we get the stage
+    #
+    my $line = $lines[0];
+    my ($runType, $multi) = split " ", $line;
+    &my_die( "unexpected first line found in $filename: $line\n", $file_id, $PS_EXIT_UNKNOWN_ERROR)
+        if !$runType or ($multi ne 'MULTI');
+
+    my $stage;
+    my $comp_name;
+    my $current_component;
+    if ($runType eq 'rawExp') {
+        $stage = 'raw';
+        $comp_name = 'class_id';
+    } elsif ($runType eq 'chipRun') {
+        $stage = 'chip';
+        $comp_name = 'class_id';
+    } elsif ($runType eq 'camRun') {
+        $stage = 'camera';
+        $comp_name = 'exposure';
+        $current_component = $comp_name;
+    } elsif ($runType eq 'fakeRun') {
+        $stage = 'fake';
+        $comp_name = 'class_id';
+    } elsif ($runType eq 'warpRun') {
+        $stage = 'warp';
+        $comp_name = 'skycell_id';
+    } elsif ($runType eq 'diffRun') {
+        $stage = 'diff';
+        $comp_name = 'skycell_id';
+    } elsif ($runType eq 'stackRun') {
+        $stage = 'stack';
+        $comp_name = 'skycell_id';
+    } else {
+        &my_die( "unexpected run type line found in $filename: $runType\n", $file_id, $PS_EXIT_UNKNOWN_ERROR);
+    }
+
+    my $new_workdir_value;
+    if ($destdir eq 'none') {
+        # this only appiles to rawExp
+        $new_workdir_value = "$workdir";
+    } else {
+        $new_workdir_value = "$workdir/$destdir";
+    }
+    my $component_dir;
+    if ($current_component) {
+        $component_dir = $components->{$current_component};
+    }
+    foreach $line (@lines) {
+        my $out_line = $line;
+
+        my ($name, $type, $value) = split " ", $line;
+        # only complete lines have things that we need to examine
+        if ($name and $type and $value) {
+            my $new_value;
+            # we have a new component id, save it and look up the corresponding
+            # component_dir
+            if ($name eq $comp_name) {
+                $current_component = $value;
+                $component_dir = $components->{$current_component};
+                &my_die( "$component_dir is null for $value in $filename: $runType\n", 
+                        $file_id, $PS_EXIT_UNKNOWN_ERROR) if !$component_dir;
+            } elsif ($name eq 'workdir') {
+                $new_value = $new_workdir_value;
+            } elsif ($name eq 'tess_id') {
+                # for tess_id strip off any directories just keep the basename.
+                # The site configuration will need to map this to a proper location
+                # XXX: Document this
+                $new_value = basename($value);
+            } elsif ((($name eq 'uri') or ($name eq 'path_base')) and ($value ne 'NULL')) {
+                &my_die( "$component_dir is null and we need it for $name", 
+                        $file_id, $PS_EXIT_PROG_ERROR) if !$component_dir;
+
+                $new_value = caturi($new_workdir_value, $component_dir, basename($value));
+            }
+
+            # if the value changed re-write the line, otherwise just print what we read
+            if ($new_value) {
+                $out_line = "   " . $name . "\t\t" . $type . "\t" . $new_value . "\n";
+            }
+        }
+
+        print OUT $out_line or &my_die( "failed to write to $resolved\n", $file_id, $PS_EXIT_UNKNOWN_ERROR);
+    }
+
+    close OUT
+        or &my_die( "failed to close $resolved\n", $file_id, $PS_EXIT_UNKNOWN_ERROR);
+
+    # update the fileset to allow processing of other files
+    my $command = "$receivetool -updatefileset -fileset_id $fileset_id";
+    $command .= " -dbinfo $dbinfo_uri";
+    $command .= " -dbname $dbname" if defined $dbname;
+
+    my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
+        run(command => $command, verbose => $verbose);
+    &my_die( "Unable to update fileset $fileset_id to\n", $file_id, $PS_EXIT_UNKNOWN_ERROR) unless $success;
+
+
+} elsif ($file =~ m|.*\.tgz$|) {        # XXX: perhaps get this off of file type ?
     # Get contents of tarball
     my @files = ();
@@ -114,5 +272,5 @@
         my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
             run(command => $command, verbose => $verbose);
-        die "Unable to get listing of tar file $filename\n" unless $success;
+        &my_die( "Unable to get listing of tar file $filename\n", $file_id, $PS_EXIT_UNKNOWN_ERROR) unless $success;
 
         my @lines = split(/\n/, join "", @$stdout_buf); # Lines from output
@@ -132,21 +290,44 @@
         my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
             run(command => $command, verbose => $verbose);
-        die "Unable to extract tar file $filename\n" unless $success;
-    }
+        &my_die( "Unable to extract tar file $filename\n", $file_id, $PS_EXIT_UNKNOWN_ERROR) unless $success;
+    }
+
+    my $component_dir = $components->{$component};
+    &my_die( "Unable to find component_dir for $component $filename\n", $file_id, $PS_EXIT_UNKNOWN_ERROR) unless $component_dir;
+
+    my $target_dir;
+    if ($destdir eq 'none') {
+        $target_dir = "$workdir";
+    } else {
+        $target_dir = "$workdir/$destdir";
+    }
+    $target_dir .= "/$component_dir";
 
     # Move files into filesystem of choice
     foreach my $file ( @files ) {
         my $from = "$tempdir/$file"; # Source for file
-        my $target = "$workdir/$file"; # Target destination for file
+        my $target = "$target_dir/$file"; # Target destination for file
+
+
+        $ipprc->file_delete ($target);
+
         my $to = $ipprc->file_create( $target ); # Target for move
-        system("mv $from $to") == 0 or die "Unable to move $file into workdir $workdir: $!\n";
+
+        if (!$to) {
+            &my_die( "failed to create: $target\n", $file_id, $PS_EXIT_UNKNOWN_ERROR);
+        }
+
+        if ( $file =~ /.+\.mdc/ ) {
+            # this file is a config dump file edit the paths
+            edit_mdc_file($file_id, $from, $to, $workdir);
+        } else {
+            system("mv $from $to") == 0 or &my_die( "Unable to move $file into workdir $workdir: $!\n", $file_id, $PS_EXIT_UNKNOWN_ERROR);
+        }
     }
 } else {
-    die "Unrecognised file: $file\n";
-}
-
-unlink $filename or die "Unable to unlink $filename\n";
+    &my_die( "Unrecognised file: $file\n", $file_id, $PS_EXIT_UNKNOWN_ERROR);
+}
+
 my $mjd_extract = DateTime->now->mjd;   # MJD of finishing extract
-
 
 # All done
@@ -170,4 +351,145 @@
 # Pau.
 
+sub read_dirinfo_file
+{
+    my $filename = shift;
+    my $file_id = shift;
+
+    my $resolved = $ipprc->file_resolve($filename);
+    &my_die("failed to resolve dirinfo file: $filename ", $file_id, $PS_EXIT_UNKNOWN_ERROR) if !$resolved;
+
+    open INFILE, $resolved or &my_die( "Can't open $resolved\n", $file_id, $PS_EXIT_UNKNOWN_ERROR);
+
+    my @lines = (<INFILE>);
+
+    my $dirinfo = join "", @lines;
+
+    close INFILE;
+
+    my $metadata = $mdcParser->parse($dirinfo) or
+        &my_die("Unable to parse metadata config doc", $file_id, $PS_EXIT_UNKNOWN_ERROR);
+
+    my $array = parse_md_list($metadata) or
+        &my_die("Unable to parse metadata list", $file_id, $PS_EXIT_UNKNOWN_ERROR);
+
+    my $dest_hash = $array->[0];
+
+    my $destdir = $dest_hash->{destdir};
+    &my_die("destdir not found in $filename", $file_id, $PS_EXIT_UNKNOWN_ERROR) if !$destdir;
+
+    my $components = $array->[1];
+
+    return ($destdir, $components, \@lines);
+}
+
+# edit a config dump file replacing the "volume" value with the new local value: $workdir
+sub edit_mdc_file
+{
+    my $file_id = shift;
+    my $src = shift;
+    my $dest = shift;
+    my $workdir = shift;
+
+    open my $IN,  "<$src" or &my_die("failed to open $src for input", $file_id, $PS_EXIT_UNKNOWN_ERROR);
+    open my $OUT, ">$dest" or &my_die("failed to open $dest for output", $file_id, $PS_EXIT_UNKNOWN_ERROR);
+
+    # Assumed file structure
+    # stuff
+    # FILES.INPUT metadata
+    # FILES.OUTPUT metadata
+    # more stuff
+    # only the paths in the FILES.* metadata are monkeyed with
+    my $done_editing = 0;
+    my $numFilesMD = 0;
+    foreach my $line (<$IN>) {
+        my $out_line = $line;
+        if (!$done_editing) {
+            my (@words) = split " ", $line;
+            if (scalar @words) {
+                # get rid of any leading blank words
+                while ((scalar @words) and !defined $words[0]) {
+                    shift @words;
+                }
+
+                if ($words[1] and $words[1] eq "METADATA") {
+                    if ( $words[0] =~ /^FILES\..+/ ) {
+                        $numFilesMD++;
+                    }
+                } elsif ($words[0] eq "END") {
+                    # when we get to the end of the second FILES metadata we're done editing
+                    if ($numFilesMD == 2) {
+                        $done_editing = 1;
+                    }
+                } elsif ($numFilesMD and ($words[1] eq "STR"))  {
+                    # we're processing one of the files metadata edit the path
+                    my $key = shift @words;
+                    my $type = shift @words;
+                    my $path = shift @words;
+                    my $extra = join " ", @words;
+
+                    $path = edit_path($file_id, $workdir, $path);
+
+                    $out_line = "\t" . $key ."\t" . "STR" . "\t" . $path;
+                    $out_line .= "\t" . $extra if $extra;
+                    $out_line .= "\n";
+                }
+            }
+        }
+        print $OUT $out_line;
+    }
+
+    close $IN;
+    close $OUT or &my_die("failed to close $dest", $file_id, $PS_EXIT_UNKNOWN_ERROR);
+}
+
+
+# XXX: this should go into a module
+# Replace 'volume portion of path with $workdir/
+# Volume is defined here by
+#   neb://volume/
+#   /xxx/xxxxx/         i.e. /data/ippxxx.y/
+#   file://xxx/xxxxx/   i.e. file://data/ippxxx.y/
+#   path://somepath/
+sub edit_path
+{
+    my $file_id = shift;
+    my $workdir = shift;
+    my $path = shift;
+
+    my $scheme = file_scheme($path);
+    my $tail;
+    if ($scheme) {
+            # strip off scheme://
+        $tail = substr($path, length($scheme) + 3);
+    } elsif (substr($path, 0, 1) eq '/') {
+        $tail = substr($path, 1);
+        $scheme = "";
+    }
+    # remove any leading / that are left
+    while ((substr($tail, 0, 1) eq '/')) {
+        $tail = substr($tail, 1);
+    }
+
+    my @segments;
+    if (($scheme eq 'neb') or ($scheme eq 'path')) {
+        my $volume;
+        ($volume, @segments) = split '/', $tail;
+
+    } elsif (!$scheme or ($scheme eq 'file')) {
+
+        # XXX Here we're assuming the /data/ipp??? structure. This won't be true when data is forwarded
+        # by remote sites. We need a way to configure this
+        my $volume;
+
+        # data/ippxxx/dirs
+        (undef, $volume, @segments) = split '/', $tail;
+    } else {
+        &my_die( "unexpected workdir value: $path\n", $file_id, $PS_EXIT_PROG_ERROR);
+    }
+
+    my $new_path = caturi($workdir, @segments);
+
+    return $new_path;
+}
 
 sub my_die