ecrf importer converter

CTSMS/BulkProcessor/FileProcessor.pm

@@ -96,6 +96,13 @@ sub init_reader_context {
 
 }
 
+sub get_sheet_names {
+    # CSV and other single-stream formats have no worksheets;
+    # return one undef entry so callers can foreach once.
+    my ($self,$file) = @_;
+    return (undef);
+}
+
 sub _extractlines {
     my ($context,$buffer_ref,$lines) = @_;
     my $separator = $context->{instance}->{line_separator};

CTSMS/BulkProcessor/Projects/ETL/EcrfImport.pm

@@ -9,6 +9,13 @@ use threads::shared qw();
 use utf8;
 use Encode qw();
 
+use CTSMS::BulkProcessor::Globals qw(
+    $system_name
+    $system_version
+    $system_instance_label
+    $local_fqdn
+);
+
 use CTSMS::BulkProcessor::Projects::ETL::EcrfSettings qw(
     $skip_errors
     $timezone
@@ -55,10 +62,12 @@ use CTSMS::BulkProcessor::Logging qw (
     getlogger
     processing_info
     processing_debug
+    scriptinfo
 );
 use CTSMS::BulkProcessor::LogError qw(
     rowprocessingerror
     rowprocessingwarn
+    scripterror
 );
 
 use CTSMS::BulkProcessor::RestRequests::ctsms::trial::TrialService::Trial qw();
@@ -73,6 +82,7 @@ use CTSMS::BulkProcessor::RestRequests::ctsms::trial::TrialService::ProbandListE
 
 use CTSMS::BulkProcessor::RestRequests::ctsms::proband::ProbandService::Proband qw();
 use CTSMS::BulkProcessor::RestRequests::ctsms::shared::SelectionSetService::ProbandCategory qw();
+use CTSMS::BulkProcessor::RestRequests::ctsms::shared::FileService::File qw();
 
 use CTSMS::BulkProcessor::RestRequests::ctsms::shared::SelectionSetService::CriterionTie qw();
 use CTSMS::BulkProcessor::RestRequests::ctsms::shared::SelectionSetService::CriterionRestriction qw();
@@ -128,16 +138,21 @@ use CTSMS::BulkProcessor::Projects::ETL::Import qw(
 );
 
 use CTSMS::BulkProcessor::Array qw(array_to_map contains);
-use CTSMS::BulkProcessor::Utils qw( stringtobool trim chopstring );
+use CTSMS::BulkProcessor::Utils qw( stringtobool trim chopstring getscriptpath );
 
 use CTSMS::BulkProcessor::ConnectorPool qw(
     get_ctsms_restapi_last_error
 );
 
+use File::Basename qw();
+use Cwd qw();
+
 require Exporter;
 our @ISA = qw(Exporter);
 our @EXPORT_OK = qw(
     import_ecrf_data_horizontal
+    convert_ecrf_data
+    publish_converted_intermediate_file
 );
 
 my @header_row :shared = ();
@@ -149,6 +164,102 @@ my $value_count :shared = 0;
 
 my $comment_char = '#';
 
+sub convert_ecrf_data {
+    my ($file,$converter) = @_;
+
+    my $convert_code = _load_converter($converter);
+    my $infile = get_input_filename($file,$ecrf_import_filename);
+    # convert() returns $outfile (no upload), or ($outfile, $file_in) to upload both
+    # the original job/input file and the intermediate outfile with the same File %in scaffold.
+    my ($outfile,$file_in) = &$convert_code($infile);
+    my @uploaded;
+    if (length($outfile)) {
+        scriptinfo("converter '$converter' wrote intermediate file $outfile",getlogger(__PACKAGE__));
+        if (ref($file_in) eq 'HASH') {
+            push(@uploaded,publish_converted_intermediate_file($infile,$file_in));
+            push(@uploaded,publish_converted_intermediate_file($outfile,$file_in));
+        }
+    }
+    return ($outfile,@uploaded);
+}
+
+sub publish_converted_intermediate_file {
+    my ($outfile,$file_in) = @_;
+
+    scripterror('no intermediate file to publish',getlogger(getscriptpath()))
+        unless length($outfile);
+    scripterror("intermediate file not found: $outfile",getlogger(getscriptpath()))
+        unless -f $outfile;
+    scripterror('File %in scaffold required to publish intermediate file',getlogger(getscriptpath()))
+        unless (ref($file_in) eq 'HASH');
+    my $logical_path = $file_in->{logicalPath};
+    scripterror('logicalPath required to publish intermediate file',getlogger(getscriptpath()))
+        unless length($logical_path);
+    scripterror('trial id required to publish intermediate file',getlogger(getscriptpath()))
+        unless (defined $ecrf_data_trial_id and length($ecrf_data_trial_id));
+
+    my $filename = File::Basename::basename($outfile);
+    my $mimetype = _converted_file_mimetype($outfile);
+    my $in = {
+        "active" => \0,
+        "publicFile" => (exists $file_in->{publicFile} ? $file_in->{publicFile} : \0),
+        "comment" => $system_name . ' ' . $system_version . ' (' . $system_instance_label . ') [' . $local_fqdn . ']',
+        "trialId" => $ecrf_data_trial_id,
+        "module" => $CTSMS::BulkProcessor::RestRequests::ctsms::shared::FileService::File::TRIAL_FILE_MODULE,
+        "logicalPath" => $logical_path,
+        "title" => $filename,
+    };
+    my $out = CTSMS::BulkProcessor::RestRequests::ctsms::shared::FileService::File::upload(
+        $in,
+        $outfile,
+        $filename,
+        $mimetype,
+    );
+    scripterror("failed to upload intermediate file '$filename'",getlogger(getscriptpath()))
+        unless $out;
+    scriptinfo("uploaded intermediate file '$filename' (file ID $out->{id}) to trial id $ecrf_data_trial_id path '$logical_path'",getlogger(__PACKAGE__));
+    return $out;
+}
+
+sub _converted_file_mimetype {
+    my ($outfile) = @_;
+    return 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet' if $outfile =~ /\.xlsx$/i;
+    return 'application/vnd.ms-excel' if $outfile =~ /\.xls$/i;
+    return 'text/csv' if $outfile =~ /\.csv$/i;
+    return 'text/plain' if $outfile =~ /\.txt$/i;
+    return 'application/octet-stream';
+}
+
+sub _load_converter {
+    my ($spec) = @_;
+    scripterror('converter module required (e.g. --converter=Converter::MyConverter)',getlogger(getscriptpath()))
+        unless length($spec);
+    scripterror("invalid converter module name '$spec'",getlogger(getscriptpath()))
+        unless $spec =~ /\A[A-Za-z_][A-Za-z0-9_]*(?:::[A-Za-z_][A-Za-z0-9_]*)*\z/;
+
+    # Converters live next to process.pl: EcrfImporter/Converter/*.pm
+    my $importer_dir = Cwd::abs_path(File::Basename::dirname(__FILE__) . '/EcrfImporter');
+    (my $rel_path = $spec) =~ s|::|/|g;
+    my $module_file = $importer_dir . '/' . $rel_path . '.pm';
+    scripterror("converter module not found: $module_file",getlogger(getscriptpath()))
+        unless -f $module_file;
+    $module_file = Cwd::abs_path($module_file);
+    scripterror("converter module not found: $spec",getlogger(getscriptpath()))
+        unless (defined $module_file and length($module_file) and -f $module_file);
+
+    eval {
+        require $module_file;
+        1;
+    } or do {
+        scripterror("failed to load converter '$spec': " . ($@ // 'unknown error'),getlogger(getscriptpath()));
+    };
+
+    my $convert_code = $spec->can('convert') || $spec->can('process');
+    scripterror("converter '$spec' must expose convert() or process()",getlogger(getscriptpath()))
+        unless $convert_code;
+    return $convert_code;
+}
+
 sub import_ecrf_data_horizontal {
 
     my ($file) = @_;

CTSMS/BulkProcessor/Projects/ETL/EcrfImporter/process.pl

@@ -80,16 +80,21 @@
 
 use CTSMS::BulkProcessor::Projects::ETL::EcrfImport qw(
     import_ecrf_data_horizontal
+    convert_ecrf_data
 );
 
 my @TASK_OPTS = ();
 
 my $tasks = [];
 my $file;
+my $converter;
 
 my $cleanup_task_opt = 'cleanup';
 push(@TASK_OPTS,$cleanup_task_opt);
 
+my $convert_task_opt = 'convert';
+push(@TASK_OPTS,$convert_task_opt);
+
 my $import_ecrf_data_horizontal_task_opt = 'import_ecrf_data_horizontal';
 push(@TASK_OPTS,$import_ecrf_data_horizontal_task_opt);
 
@@ -118,6 +123,7 @@ sub init {
         "jid=i" => \$job_id,
         "auth=s" => \$auth,
         "file=s" => \$file,
+        "converter=s" => \$converter,
         "tz=s" => \$timezone,
     );
 
@@ -167,6 +173,11 @@ sub main {
             if (lc($cleanup_task_opt) eq lc($task)) {
                 $result &= cleanup_task(\@messages) if taskinfo($cleanup_task_opt,\$result);
 
+            } elsif (lc($convert_task_opt) eq lc($task)) {
+                $result &= convert_task(\@messages) if taskinfo($convert_task_opt,\$result,
+                    ecrf_data_trial_id_required => 1,
+                );
+
             } elsif (lc($import_ecrf_data_horizontal_task_opt) eq lc($task)) {
                 $result &= import_ecrf_data_horizontal_task(\@messages) if taskinfo($import_ecrf_data_horizontal_task_opt,\$result,
                     ecrf_data_trial_id_required => 1,
@@ -269,6 +280,35 @@ sub cleanup_task {
     }
 }
 
+sub convert_task {
+    my ($messages) = @_;
+    my $result = 0;
+    my $outfile;
+    my @uploaded;
+    eval {
+        ($outfile,@uploaded) = convert_ecrf_data($file,$converter);
+        $result = (length($outfile) and -f $outfile and -r $outfile and -s $outfile) ? 1 : 0;
+        if ($result) {
+            # subsequent import_ecrf_data_horizontal uses the converted intermediate file
+            $file = $outfile;
+        }
+    };
+    my $err = $@;
+    if ($err) {
+        push(@$messages,'convert error: ' . $err);
+        return 0;
+    } elsif (!$result) {
+        push(@$messages,'convert error: no intermediate file produced');
+        return 0;
+    } else {
+        push(@$messages,"- convert ok ($converter → $outfile)");
+        foreach my $uploaded (@uploaded) {
+            push(@$messages,"- file '$uploaded->{title}' (file ID $uploaded->{id}) added to the '$uploaded->{trial}->{name}' trial");
+        }
+        return 1;
+    }
+}
+
 sub import_ecrf_data_horizontal_task {
     my ($messages) = @_;
     my ($result, $warning_count) = (0,0);

CTSMS/BulkProcessor/RestConnector.pm

@@ -704,7 +704,7 @@ sub get_username_from_jwt {
     my ($jwt) = @_;
     my $payload = _decode_jwt_payload($jwt);
     return undef unless defined $payload && 'HASH' eq ref $payload;
-    return $payload->{sub} // $payload->{username};
+    return $payload->{username}; # // $payload->{sub};
 }
 
 sub jwt_needs_refresh {

CTSMS/BulkProcessor/RestRequests/ctsms/shared/ToolsService/CompleteEcrfField.pm

@@ -0,0 +1,96 @@
+package CTSMS::BulkProcessor::RestRequests::ctsms::shared::ToolsService::CompleteEcrfField;
+use strict;
+
+## no critic
+
+use CTSMS::BulkProcessor::ConnectorPool qw(
+    get_ctsms_restapi
+);
+
+use CTSMS::BulkProcessor::RestProcessor qw(
+    copy_row
+    get_query_string
+);
+
+use CTSMS::BulkProcessor::RestConnectors::CtsmsRestApi qw(_get_api);
+use CTSMS::BulkProcessor::RestItem qw();
+
+require Exporter;
+our @ISA = qw(Exporter CTSMS::BulkProcessor::RestItem);
+our @EXPORT_OK = qw(
+    complete_ecrf_field
+);
+
+my $default_restapi = \&get_ctsms_restapi;
+my $get_complete_path_query = sub {
+    my ($name_infix, $limit) = @_;
+    my %params = ();
+    $params{nameInfix} = $name_infix if defined $name_infix;
+    $params{limit} = $limit if defined $limit;
+    return 'tools/complete/ecrffield/' . get_query_string(\%params);
+};
+
+my $fieldnames = [
+    'id',
+    'name',
+    'uniqueName',
+    'title',
+    'titleL10nKey',
+    'externalId',
+    'value',
+    'label',
+];
+
+sub new {
+
+    my $class = shift;
+    my $self = CTSMS::BulkProcessor::RestItem->new($class,$fieldnames);
+
+    copy_row($self,shift,$fieldnames);
+
+    return $self;
+
+}
+
+sub complete_ecrf_field {
+
+    my ($name_infix, $limit, $load_recursive,$restapi,$headers) = @_;
+    my $api = _get_api($restapi,$default_restapi);
+    return builditems_fromrows($api->get(&$get_complete_path_query($name_infix, $limit),$headers),$load_recursive,$restapi);
+
+}
+
+sub builditems_fromrows {
+
+    my ($rows,$load_recursive,$restapi) = @_;
+
+    my $item;
+
+    if (defined $rows and ref $rows eq 'ARRAY') {
+        my @items = ();
+        foreach my $row (@$rows) {
+            $item = __PACKAGE__->new($row);
+            push @items,$item;
+        }
+        return \@items;
+    } elsif (defined $rows and ref $rows eq 'HASH') {
+        $item = __PACKAGE__->new($rows);
+        return $item;
+    }
+    return undef;
+
+}
+
+sub TO_JSON {
+
+    my $self = shift;
+    my $label = $self->{label} // $self->{uniqueName} // $self->{title} // $self->{name} // $self->{id};
+    my $value = $self->{value} // $self->{id};
+    return {
+        value => $value,
+        label => $label,
+    };
+
+}
+
+1;