diff --git a/CTSMS/BulkProcessor/FileProcessor.pm b/CTSMS/BulkProcessor/FileProcessor.pm index 3872da3..020f792 100644 --- a/CTSMS/BulkProcessor/FileProcessor.pm +++ b/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}; diff --git a/CTSMS/BulkProcessor/Projects/ETL/EcrfImport.pm b/CTSMS/BulkProcessor/Projects/ETL/EcrfImport.pm index 3439558..fb7fa2f 100644 --- a/CTSMS/BulkProcessor/Projects/ETL/EcrfImport.pm +++ b/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) = @_; diff --git a/CTSMS/BulkProcessor/Projects/ETL/EcrfImporter/process.pl b/CTSMS/BulkProcessor/Projects/ETL/EcrfImporter/process.pl index 3e33ca8..5745413 100644 --- a/CTSMS/BulkProcessor/Projects/ETL/EcrfImporter/process.pl +++ b/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); diff --git a/CTSMS/BulkProcessor/RestConnector.pm b/CTSMS/BulkProcessor/RestConnector.pm index 7800b08..d83688b 100644 --- a/CTSMS/BulkProcessor/RestConnector.pm +++ b/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 { diff --git a/CTSMS/BulkProcessor/RestRequests/ctsms/shared/ToolsService/CompleteEcrfField.pm b/CTSMS/BulkProcessor/RestRequests/ctsms/shared/ToolsService/CompleteEcrfField.pm new file mode 100644 index 0000000..e601096 --- /dev/null +++ b/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; diff --git a/CTSMS/BulkProcessor/RestRequests/ctsms/shared/ToolsService/CompleteEcrfFieldInputField.pm b/CTSMS/BulkProcessor/RestRequests/ctsms/shared/ToolsService/CompleteEcrfFieldInputField.pm new file mode 100644 index 0000000..3d94767 --- /dev/null +++ b/CTSMS/BulkProcessor/RestRequests/ctsms/shared/ToolsService/CompleteEcrfFieldInputField.pm @@ -0,0 +1,95 @@ +package CTSMS::BulkProcessor::RestRequests::ctsms::shared::ToolsService::CompleteEcrfFieldInputField; +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_input_field +); + +my $default_restapi = \&get_ctsms_restapi; +my $get_complete_path_query = sub { + my ($field_name_infix, $limit) = @_; + my %params = (); + $params{fieldNameInfix} = $field_name_infix if defined $field_name_infix; + $params{limit} = $limit if defined $limit; + return 'tools/complete/ecrffieldinputfield/' . get_query_string(\%params); +}; + +my $fieldnames = [ + 'id', + 'name', + 'nameL10nKey', + 'externalId', + 'category', + '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_input_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->{nameL10nKey} // $self->{name} // $self->{id}; + my $value = $self->{value} // $self->{id}; + return { + value => $value, + label => $label, + }; + +} + +1;