#!/usr/bin/perl
#
# Copyleft 2022 O. Sotolongo <asqwerty@gmail.com>
#
use strict;
use warnings;
use File::Temp qw(:mktemp tempdir);
use Data::Dump qw(dump);
# Get input
my $xprj = 'unidad';
my $ilist;
while (@ARGV and $ARGV[0] =~ /^-/) {
        $_ = shift;
        last if /^--$/;
        if (/^-x/) {$xprj = shift; chomp($xprj);}
        if (/^-i/) {$ilist = shift; chomp($ilist);}
}
die "Should supply XNAT project" unless $xprj;

#Read config files
my $xconf_file = $ENV{'HOME'}.'/.xnatapic/xnat.conf';
my %xconf;
open IDF, "<$xconf_file";
while (<IDF>){
        if (/^#.*/ or /^\s*$/) { next; }
        my ($n, $v) = /(.*)=(.*)/;
        $xconf{$n} = $v;
}
close IDF;

my $sqlconf_file = $ENV{'HOME'}.'/.sqlcmd';
my %sqlconf;
open IDF, "<$sqlconf_file";
while (<IDF>){
        if (/^#.*/ or /^\s*$/) { next; }
        my ($n, $v) = /(.*)=(.*)/;
        $sqlconf{$n} = $v;
}
close IDF;

my $tmp_dir = tempdir(TEMPLATE => $ENV{TMPDIR}.'/xnat_data.XXXXXX', CLEANUP => 1);
my $sbj_file = $tmp_dir.'/all_subjects.csv';
# me conecto y genero mi JSESSIONID
my $q = 'curl -f -X POST -u "'.$xconf{'USER'}.':'.$xconf{'PASSWORD'}.'" "'.$xconf{'HOST'}.'/data/JSESSION" 2>/dev/null';
my $jid = qx/$q/;
# Saco los sujetos del proyecto
$q = 'curl -f -b JSESSIONID='.$jid.' "'.$xconf{'HOST'}.'/data/projects/unidad/subjects?format=csv" > '.$sbj_file.' 2>/dev/null';
system($q);
my @slist;
if ($ilist) {
        open IDF, "<$ilist";
        @slist = <IDF>;
        close IDF;
}
my %subjects;
open IDF, "<$sbj_file";
while (<IDF>){
        if(/^XNAT/){
                my ($xid,$xlabel) = /(XNAT.*),.*,(\d*),.*,.*,.*$/;
                #print "$xid -> $xlabel\n";
                if(!$ilist or grep( /^$xlabel$/, @slist)){
                        $subjects{$xid}{'label'} = $xlabel;
                        print "$xlabel\n";
                }
        }
}
close IDF;
#dump %subjects;
foreach my $subject (sort keys %subjects){
        my $sconn = 'sqlcmd -U '.$sqlconf{'USER'}.' -P '.$sqlconf{'PASSWORD'}.' -S '.$sqlconf{'HOST'}.' -s "," -W -Q "SELECT his_interno, xfecha_nac, xsexo_id FROM [UNIT4_DATA].[imp].[vh_pac_gral] WHERE his_interno = \'"'.$subjects{$subject}{'label'}.'"\';" | grep '.$subjects{$subject}{'label'};
        my $rdata = qx/$sconn/;
        my ($xdob, $xgender) = $rdata =~ /${subjects{$subject}{'label'}}\s*,\s*(\d{4}-\d{2}-\d{2}).*,(\d)$/;
        if($xdob and $xgender){
                $subjects{$subject}{'dob'} = $xdob;
                $subjects{$subject}{'gender'} = $xgender==1?'male':'female';
        }
}
my $ofile = $xprj.'_dob_gender.csv';
my $sbj_header = 'ID,label,dob,gender';
open ODF, ">$ofile";
print ODF "$sbj_header\n";
foreach my $subject (sort keys %subjects){
        if (exists($subjects{$subject}{'dob'}) and exists($subjects{$subject}{'gender'})){
                print ODF "$subject,$subjects{$subject}{'label'},$subjects{$subject}{'dob'},$subjects{$subject}{'gender'}\n";
        }
}
close ODF;