################################################################################
#
#  kPerl Dictyostelium ReadWatch Concept
#  Object Library for Database Object 'Clone Library Plate'
#
#  copyright (c)
#    Institute of Molecular Biotechnology Jena, Dept. Genome Analysis, 1999-2000
#  author
#    Karol Szafranski, karol.szafranski@leibniz-fli.de
#
################################################################################
#
#  DESCRIPTION
#
# - individual description of functions at the beginning of the code blocks
#
################################################################################
#
#  OBJECT OPERATORS
#
#  *** NONE ***
#
#
#  OBJECT METHODS  for external access
#
# - ...
#
#
#  OBJECT DATA STRUCTURE
#
#  switch         hash reference for object switches
#                 hash reference for switches
#    -debug       print debug protocol to STDERR
#    -timer       print time performance diagnostics to STDERR
#
#  id             plate identifier (target+library+plate)
#  idfield        reference to hash of identifier fields,
#                 see &SeqLab::SeqFormat::ReadidToFields() for appropriate keys
#  PathPlate      path of folder which is the physical mirror of the object
#  PathLib        path of folder physically representing library
#
#  ReadIndex      reference to global read index
#                 The instance of this object should be held unique for the
#                 whole process to prevent an overhang of loading/construction
#                 efforts. It's originally located pointed out by
#                 $main::GlobStore{ReadIndex}.
#  ExperList      stored list of Experiment file paths as recently (see ExperListTime)
#                 selected from global read index
#  ExperListTime  actuality time of stored list of Experiment file paths
#
################################################################################
#
#  FUNCTIONS, DATA
#
#   @ISA
#   %_LibParam (not exported)
#
# - housekeeping
#   &new  see MainLib::DefaultObjHash.pm
#   &ini
#   &_LocalSwitch  see MainLib::DefaultObjHash.pm
#
# - database physics
#   $_LibParam{physics}
#   &Path
#   &FolderValidate
#   &FolderExists
#   &FolderCreate
#   &FolderDelete
#
# - social interconnection
#   &ReadIndex
#   &ExperList
#   &Exists
#
# - data analysis
#   $_LibParam{call}, $_LibParam{physics}
#   &BlastReptDo
#
################################################################################
#
#  DEBUG, CHANGES, ADDITIONS
#
# - As we manage the ReadIndex through a global reference in module "main",
#   there can be only a single ReadIndex at a time.
#
# - look also for notes in the header of each function block
#
################################################################################

package ReadWatch::PlateObj;

# includes
#use strict;  # OK 2003xxxx use warnings;
use MainLib::DefaultObjHash;
use MainLib::Path qw(%CorePath);
use MainLib::FileAccAsync;
use ReadWatch::Read;
use ReadWatch::ReadIndex;

# inheritance
our @ISA;
push @ISA, qw(MainLib::DefaultObjHash);

# package-wide constants and variables
my %_LibParam;


################################################################################
# basics
################################################################################


# parametric initialization
#
# INTERFACE
# - argument 1: plate identifier
# - options:    instance parameter options
# - return val: - instance reference
#               - undef if an error occurred
#
sub ini {

  # function and instance parameters
  my ($this) = shift @_;
  ($this->{id}, %{$this->{switch}}) = @_;

  # plate identifier
  $this->{id} or return undef;
  $this->Path() or return undef;

  # successful initialization
  return $this;
}


################################################################################
# database physics
################################################################################


$_LibParam{physics} = {
  'home' => $CorePath{ReadWatch}{home} .'/gel',
  'mask' => 0750,
  };


# path of folder physically representing database object
#
# INTERFACE
# - options:
#   -debug      print debug protocol to STDERR
#
# - return val: path of folder physically representing the database object
#
# DESCRIPTION
# - The method not only returns the path of the folder path but also defined
#   the object values $this->{PathLib} and $this->{PathPlate}
# - This method is part of the object initialization procedure
#
sub Path {
  my ($this) = @_;
  my ($debug);
  my ($PathBase);

  # function parameters
#  $debug = $this->{switch}{-debug} || $opt{-debug} || 1;

  # don't do this work multiple times
  # what if $his->{id} has been changed => everything goes wrong
  unless ($this->{PathPlate}) {

    # derive identifier fields
    $this->{idfield} = &ReadidToFields ($this->{id}.'a01.s1', -hash=>1) or return undef;
    if ($debug) {
      printf STDERR "%s. derived ID fields:\n", (caller(0))[3];
      foreach (keys %{$this->{idfield}}) {
      printf STDERR "%s=>%s, ", $_, $this->{idfield}{$_};
      }
      print  STDERR "\n";
    }

    # ...
    $PathBase  = $_LibParam{physics}{base};
    $this->{PathLib}   = $PathBase          .'/'. $this->{idfield}{lib2};
    $this->{PathPlate} = $this->{PathLib} .'/'. $this->{idfield}{plt};
  }

  # return result    
  return $this->{PathPlate};
}


# validate existence of physical database object folder
#
# INTERFACE
# - return val: boolean
#
sub FolderValidate {
  my ($this) = @_;

  unless ($this->FolderExists()) {
    $this->FolderCreate();
  }
}


# check existence of physical database object folder
#
# INTERFACE
# - return val: flag for existence of folder (boolean)
#
sub FolderExists {
  my ($this) = @_;

  # check for existence of folder
  return (-d $this->Path());
}


# create physical database object folder
#
# INTERFACE
# - options:
#   -debug      print debug protocol to STDERR
#
# DESCRIPTION
# - the only proof done here is to check whether the folder already exists.
#
sub FolderCreate {
  my ($this, %opt) = @_;
  my ($debug);

  # function parameters
  $debug = $this->{switch}{-debug} || $opt{-debug};
  $this->Path() or return undef;

  # validate existence of data folders
  unless (-d $this->{PathPlate}) {
    unless (-d $this->{PathLib}) {
      if (! mkdir ($this->{PathLib}, $_LibParam{physics}{mask}) and $debug) {
        printf STDERR "%s. ERROR: failed to create folder %s, message: %s\n", (caller(0))[3],
          $this->{PathLib}||"''", $!;
      }
    }
    if (! mkdir ($this->{PathPlate}, $_LibParam{physics}{mask}) and $debug) {
      printf STDERR "%s. ERROR: failed to create folder %s, message: %s\n", (caller(0))[3],
        $this->{PathPlate}||"''", $!;
    }
  }

}


# delete physical database object folder
#
sub FolderDelete {
}


################################################################################
# social interconnection
################################################################################


# reference to global read index
#
# INTERFACE
# - return val: reference to index object
#
sub ReadIndex {
  my ($this) = @_;
  my ($debug);

  # function parameters
  $debug = $this->{switch}{-debug};

  # validate existence of ReadIndex instance, return reference
  $this->{ReadIndex} ||= $main::GlobStore{ReadIndex} ||=
    ReadWatch::ReadIndex->new();
  # $this->ReadIndex()->load() is done automatically

  # return reference
  return $this->{ReadIndex};
}


# return list of Experiment files derived from the current plate
#
# INTERFACE
# - options:
#   -debug      print debug protocol to STDERR
#
# - return val: list of Experiment files
#
sub ExperList {
  my ($this, %opt) = @_;
  my (%lopt, $debug);
  my ($select);

  # function parameters
  %lopt = $this->_LocalSwitch(%opt);
  $debug = $lopt{-debug};

  # no available information entry, or expiry of stored information?
  # a read name selection from established index needs around 2.0 CPU s on sarton!
  if (! $this->ReadIndex()->{time} or
      $this->{ExperListTime} < $this->ReadIndex()->{time}) {

    # select reads from the read index that accord to the present plate
    $select = '^'. $this->{id};
    @{$this->{ExperList}} = $this->ReadIndex()->Retrieve('ExperFull',$select);
    $this->{ExperListTime} = time;
    if ($debug) {
      printf STDERR "%s. ID list method 1:\n%s\n", (caller(0))[3],
        join (' ', @{$this->{ExperList}});
    }

    # expand paths of Experiment files
    # ...
  }

  # return reference
  return @{$this->{ExperList}};
}


# sequence reads from library plate exist => library plate exists
#
# INTERFACE
# - return val: flag for existence of plate (boolean)
#
sub Exists {
  my ($this) = @_;
  my ($exists);

  # confirm existence
  $exists = $this->ExperList() ? 1 : 0;

  # mirror existence to the physical database structure
  if ($exists) {
    $this->FolderValidate();
  } elsif ($this->FolderExists()) {
    print  STDERR "ERROR: plate %s doesn't exist, but physical DB object does\n", $this->{id};
  }

  # return existence flag
  return $exists;
}



################################################################################
# data analysis
################################################################################


$_LibParam{call}{BlastRept} = $ProgParam{folder}{PerlHome} . 'Blast.pl -all2all -db=dicty.mask -param=ReptFPrint -MaskPoly=10';
$_LibParam{physics}{BlastRept} = 'BlastRept.bll';


# BLAST all reads against contamination/repeat sequences
#
# INTERFACE
# - return val: success status (boolean)
#
sub BlastReptDo {
  my ($this, %opt) = @_;
  my (%lopt, $debug, $dbg2);
  my (@ExperList, $call, $pAction, $success);

  # function parameters
  %lopt = $this->_LocalSwitch(%opt);
  $debug = $lopt{-debug};
  $dbg2  = $debug ? $debug-1 : 0;

  # list of Experiment files belonging to this particular plate
  @ExperList = $this->ExperList();

  # output file
  $target = $this->Path() . $_LibParam{physics}{BlastRept};
  
  # do BLAST, output via access control
  $call = sprintf ("$_LibParam{call}{BlastRept} %s > $target", join(' ',@ExperList) );
  $pAction = sub { return (! int (system (join(' ',@_)) / 256)); };
  $success = &PhysicalAccessCtrl ($target, -mode=>'func',
    -func    => $pAction,
    -FuncArg => [$call],
    -debug   => $dbg2);

  # return
  return $success;
}


1;
# $Id: PlateObj.pm,v 1.11 2018/06/05 18:02:56 szafrans Exp $
