package NeuroRx::ScanSetup;
use strict;

BEGIN {
    use Exporter ();
    use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
    $VERSION     = '1.00';
    @ISA         = qw(Exporter);
    #Give a hoot don't pollute, do not export more than needed by default
    @EXPORT      = qw(GetSystemOutput RunAndLog GetSystemOutputArray ParseHeader
                      GetDimensions GetScanDescription ParseDicom GetFileroot
                      GetUser GetPath unlink_glob);
    @EXPORT_OK   = qw(get_start_time logfilename get_pm $logger $trial
                      $email_target $scanpath);
    %EXPORT_TAGS = ();
}


#################### subroutine header begin ####################

=head2 sample_function

 Usage     : How to use this function/method
 Purpose   : What it does
 Returns   : What it returns
 Argument  : What it wants to know
 Throws    : Exceptions and other anomolies
 Comment   : This is a sample subroutine header.
           : It is polite to include more pod and fewer comments.

See Also   :

=cut

#################### subroutine header end ####################

our $trial;
our $logger;
our $email_target;
our $scanpath;

sub new{
  my ($class, %parameters) = @_;
  my $self = bless ({}, ref ($class) || $class);

  return $self;
}

my $starttime;
sub get_start_time{
  if(!$starttime){
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
    $starttime = sprintf("%04d-%02d-%02d_%02d:%02d:%02d",
                              $year+1900, $mon+1, $mday, $hour, $min, $sec);
  }
  return $starttime;
}

sub logfilename{
  return "/var/log/scansetup/scansetup_".get_start_time().".log";
}

sub get_pm {
  my ($which_trial) = (@_);
  $which_trial = $trial unless $which_trial;

  if ($email_target){
    return [$email_target];
  }

  my $default;

  open TRIALLIST, "/trials/quarantine/common/lists/email.list"
    or return $default;

  my %trial_pms;
  while (<TRIALLIST>) {
    next if /^\s*(#.*)?$/;
    chomp;
    my @line = split /,/;
    next if @line < 2;

    $trial_pms{$line[0]} = [@line[1..$#line]];
  }
  close TRIALLIST;

  open SUBLIST, "/trials/quarantine/common/lists/user_substitutions.list"
    or return $default;

  while (<SUBLIST>) {
    next if /^\s*(#.*)?$/;
    chomp;
    my @line = split /\./;

    my $from = $line[3];
    my $to = $line[5];
    my $until = $line[7];

    my ($sec,$min,$hour,$day,$mon,$year) = localtime(time);
    my $today = sprintf("%04d-%02d-%02d",$year+1900,$mon+1,$day);

    if ($today lt $until) {
      foreach my $pms(keys %trial_pms){
        ## Replace all usages of absent PM with substituting PM
        map {s/$from/$to/;} @{$trial_pms{$pms}};
      }
    }
  }
  close SUBLIST;

  if (defined  $trial_pms{$which_trial}){
    my @pm_emails = @{$trial_pms{$which_trial}};

    foreach my $pm_email(@pm_emails){
      $pm_email .= '@neurorx.com' unless $pm_email =~ /@/;
    }

    return \@pm_emails;
  }

  return $default;
}

use Cwd qw(getcwd);

sub GetSystemOutput{
  my ($input, $exit_codes) = @_;

  my @args = split(" ", $input);
  my $prog = which($args[0]);
  $logger -> logdie("$args[0]: program not found") unless $prog;

  my ($output, $err, $success, $code) = capture_exec($input);

  if($exit_codes){
    if(! grep(/$code/, @$exit_codes)){
      $logger -> error($err);
      $logger -> logdie("command `$input' failed with exit code $code");
    }
  }

  chomp $output;

  return wantarray ? ($output, $err) : $output;
}

sub RunAndLog{
  my @args = @_;
  my $prog = which($args[0]);
  my ($pkg, $filename, $line) = caller;
  $logger -> logdie("$args[0]: program not found") unless $prog;

  my $cmd = join(" ", @args);
  $logger -> debug($cmd);
  $logger -> debug("Called from: $filename:$line");
  my ($msg, $err) = capture_exec(@args);
  $logger -> debug($msg) if $msg;
  if($err
     ## This warning is from mincconcat and too frequent to be a warning
     && !($err =~ m/Don't use an image dimension as a loop dimension/)){
    $logger -> warn("Problem running $cmd:");
    $logger -> warn($err);
  }
}

sub GetSystemOutputArray {

  my ($InputString,@SysOut);

  $InputString = $_[0];

  open (SYSOUT, "$InputString |");
  @SysOut = <SYSOUT>;
  close(SYSOUT);
  chomp(@SysOut);

  return(@SysOut);
}

my %mincheader_cache;
sub ParseHeader {
  my ($file, $header) = @_;

  my $line;
  if (! $mincheader_cache{$file}) {
    $logger -> debug ("Cache miss! Running mincheader on $file");
    $line = GetSystemOutput("mincheader $file");
    $mincheader_cache{$file} = $line;
  }
  else{
    $line = $mincheader_cache{$file};
  }
  my @out = ($line =~ m/$header = "?([^\n;"]*)"?/);
  $out[0] =~ s/\s*$// if $out[0];
  my $out = $out[0] || "NotPresent";

  $out =~ s/\s*$//;

  return $out;

}

sub GetDimensions {
  my ($file, $dimension) = @_;

  my $line = GetSystemOutput("mincheader $file");

  my @out = ($line =~ m/$dimension = "?([^\n;"]*)"?/);
  my $out = $out[0] || "";

  $out =~ s/\s*//;

  return $out;
}

sub GetScanDescription {
  my ($file) = @_;

  my ($lines, $err, $success, $exit_code) = capture_exec("mincheader", $file);
  if($err){
    $logger -> error ($err);
  }
  if(! $success){
    $logger -> logdie ("`mincheader' failed with exit code $exit_code");
  }

  my @lines = split(/\n/, $lines);
  @lines = grep(/dicom_0x0008:el_0x103e/, @lines);

  return "NotInHeader" unless @lines;

  $lines[0] =~ m/\s+(.+);/ or return "NotInHeader";
  my $out = $1;
  $out =~ s,[/"\s],,g;

  return ($out || "NotInHeader");
}

sub ParseDicom {
  use strict;
  my ($file, $field) = @_;

  $logger -> debug("Looking for field $field in file $file");
  my ($val, $err) = capture_exec("dicomhdr", $field, $file);

  if($err){
    $val = "InvalidValue";
    $logger -> warn("Failed parsing DICOM file:");
    my @err = split(/\n/, $err);
    foreach $err(@err){
      $logger -> warn("\t$err");
    }
  }

  $logger -> debug ("Returning value: $val");
  return($val);
}

sub GetFileroot {
  my ($pwd) = @_;
  my @pwd = split(/\//,$pwd);
  $logger -> logdie("Not a trial directory: $pwd") if @pwd < 6;

  my $fileroot = $pwd[2]."_".$pwd[3]."_".$pwd[4]."_".$pwd[5];
  return($fileroot);
}

sub GetUser {
  my @outargs = getpwuid($<);
  my $user = $outargs[6];
  $user =~ s/\s/_/g;
  return $user;
}

sub GetPath {
    my ($fname) = @_;

    my @f = split(/\//,$fname);
    $fname = $f[$#f];

    my @fname = split(/_/,$fname);

    my $filepath = "/trials/".$fname[0]."/".$fname[1]."/".$fname[2]."_".$fname[3]."/".$fname[4];
    return($filepath);
}


sub unlink_glob {
  my $glob = $_[0];
  my $cwd = getcwd();

  $logger -> debug("Removing $glob from $cwd...");

  foreach my $file( glob($glob)){
    unlink($file) or die "Couldn't unlink ${file}: $!";
    $logger -> debug("Deleted $file");
  }
}

#################### main pod documentation begin ###################
## Below is the stub of documentation for your module. 
## You better edit it!


=head1 NAME

NeuroRx::ScanSetup - Converts incoming DICOM images to MINC

=head1 SYNOPSIS

  use NeuroRx::ScanSetup;
  blah blah blah


=head1 DESCRIPTION



=head1 USAGE



=head1 BUGS



=head1 SUPPORT



=head1 AUTHOR

    Samson Antel
    CPAN ID: MODAUTHOR
    NeuroRx
    samson@neurorx.com

=head1 COPYRIGHT

This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the
LICENSE file included with this module.


=head1 SEE ALSO

perl(1).

=cut

#################### main pod documentation end ###################


1;