From ead2a134087839b6435662fd6abeeccca16a37c5 Mon Sep 17 00:00:00 2001 From: Marina Gourtovaia Date: Wed, 27 Sep 2023 16:02:21 +0100 Subject: [PATCH] Deleted the xml driver for st::api::lims. --- lib/st/api/lims.pm | 14 +- lib/st/api/lims/xml.pm | 990 ----------------------------------- t/40-st-lims-insert_size.t | 108 ---- t/40-st-lims-samplesheet.t | 2 +- t/40-st-lims.t | 945 +++++---------------------------- t/45-st-api-lims-traversal.t | 111 ---- 6 files changed, 149 insertions(+), 2021 deletions(-) delete mode 100644 lib/st/api/lims/xml.pm delete mode 100755 t/40-st-lims-insert_size.t delete mode 100644 t/45-st-api-lims-traversal.t diff --git a/lib/st/api/lims.pm b/lib/st/api/lims.pm index 0cf31e44..4d5e77da 100644 --- a/lib/st/api/lims.pm +++ b/lib/st/api/lims.pm @@ -139,9 +139,9 @@ Readonly::Hash my %METHODS_PER_CATEGORY => { 'request' => [qw/ request_id /], }; -Readonly::Array my @METHODS => sort map { @{$_} } values %METHODS_PER_CATEGORY; -Readonly::Array my @DELEGATED_METHODS => sort map { @{$METHODS_PER_CATEGORY{$_}} } - grep {$_ ne 'primary'} keys %METHODS_PER_CATEGORY; +Readonly::Array my @METHODS => sort map { @{$_} } values %METHODS_PER_CATEGORY; +Readonly::Array my @DELEGATED_METHODS => sort map { @{$METHODS_PER_CATEGORY{$_}} } + grep {$_ ne 'primary'} keys %METHODS_PER_CATEGORY; has '_driver_arguments' => ( isa => 'HashRef', @@ -247,7 +247,7 @@ foreach my $object_type (keys %ATTRIBUTE_LIST_METHODS) { =head2 driver_type -Driver type (xml, etc), currently defaults to xml +Driver type, currently defaults to 'samplesheet' =cut has 'driver_type' => ( isa => 'Str', @@ -257,7 +257,7 @@ has 'driver_type' => ( isa => 'Str', ); sub _build_driver_type { my $self = shift; - if($self->has_driver && $self->driver){ + if ($self->has_driver && $self->driver){ my $type = ref $self->driver; my $prefix = __PACKAGE__ . q(::); $type =~ s/\A\Q$prefix\E//smx; @@ -273,7 +273,7 @@ sub _build_driver_type { =head2 driver -Driver object (xml, warehouse, mlwarehouse, samplesheet ...) +Driver object (mlwarehouse, samplesheet) =cut has 'driver' => ( 'isa' => 'Maybe[Object]', @@ -530,7 +530,7 @@ sub _build_tags { =head2 required_insert_size Read-only accessor, not possible to set from the constructor. -Returns a has reference of expected insert sizes. +Returns a hash reference of expected insert sizes. =cut has 'required_insert_size' => (isa => 'HashRef', diff --git a/lib/st/api/lims/xml.pm b/lib/st/api/lims/xml.pm deleted file mode 100644 index 7b6db528..00000000 --- a/lib/st/api/lims/xml.pm +++ /dev/null @@ -1,990 +0,0 @@ -package st::api::lims::xml; - -use Carp; -use English qw(-no_match_vars); -use Moose; -use MooseX::StrictConstructor; -use XML::LibXML; -use Readonly; - -use st::api::batch; -use npg_tracking::util::types; - -with qw/ npg_tracking::glossary::run - npg_tracking::glossary::lane - npg_tracking::glossary::tag - /; - -our $VERSION = '0'; - -=head1 NAME - -st::api::lims::xml - -=head1 SYNOPSIS - - $lims = st::api::lims::xml->new(batch_id => 222) #run (batch) level object - $lims = st::api::lims::xml->new(batch_id => 222, position => 3) # lane level object - $lims = st::api::lims::xml->new(batch_id => 222, position => 3, tag_index => 44) # plex level object - -=head1 DESCRIPTION - -Gateway to Sequencescape LIMS. - -=head1 SUBROUTINES/METHODS - -=cut - -Readonly::Scalar our $BAD_SAMPLE_ID => 4; -Readonly::Array our @LIMS_OBJECTS => qw/sample study project/; - -Readonly::Hash our %DELEGATION => { - 'sample' => { - sample_name => 'name', - organism_taxon_id => 'taxon_id', - organism => 'organism', - sample_common_name => 'common_name', - sample_public_name => 'public_name', - sample_accession_number => 'accession_number', - sample_consent_withdrawn => 'consent_withdrawn', - sample_description => 'description', - }, - 'study' => { - study_name => 'name', - email_addresses => 'email_addresses', - email_addresses_of_managers => 'email_addresses_of_managers', - email_addresses_of_followers => 'email_addresses_of_followers', - email_addresses_of_owners => 'email_addresses_of_owners', - study_alignments_in_bam => 'alignments_in_bam', - study_accession_number => 'accession_number', - study_title => 'title', - study_description => 'description', - study_separate_y_chromosome_data => 'separate_y_chromosome_data', - }, - 'project' => { - project_name => 'name', - project_cost_code => 'project_cost_code', - }, -}; - -=head2 id_run - -Run id, optional attribute, redundant, retained for compatibility -with old code and tests. - -=cut -has '+id_run' => (required => 0,); - -=head2 position - -Position, optional attribute. - -=cut -has '+position' => (required => 0,); - -=head2 batch_id - -Batch id. This attribute is kept as optional to retain compatibility -with old code and tests. To retrieve LIMS data, the attribute should -be set by the caller. - -=cut -has 'batch_id' => (isa => 'NpgTrackingPositiveInt', - is => 'ro', - lazy_build => 1, - ); -sub _build_batch_id { - my $self = shift; - croak q[Cannot build batch_id]; -} - -has 'purpose' => (isa => 'Str', is => 'ro', default => 'standard'); - -has '_lane_elements' => (isa => 'ArrayRef', - is => 'ro', - init_arg => undef, - lazy_build => 1, - ); -sub _build__lane_elements { - my $self = shift; - my $doc = st::api::batch->new({id => $self->batch_id,})->read(); - if(!$doc) { - croak q[Failed to load XML for batch] . $self->batch_id; - } - my $lanes = $doc->getElementsByTagName(q[lanes])->[0]; - if (!$lanes) { - croak q[Lanes element is not defined in batch ] . $self->batch_id; - } - my @nodes = $lanes->getElementsByTagName(q[lane]); - return \@nodes; -} - -=head2 _associated_lims - -Private accessor, not possible to set from the constructor. -Use associated_lims method. - -=cut -has '_associated_lims' => (isa => 'Maybe[ArrayRef]', - is => 'ro', - init_arg => undef, - lazy_build => 1, - clearer => 'free_children', - ); -sub _build__associated_lims { - my $self = shift; - - my $lims = []; - - if (!defined $self->position) { - foreach my $lane_el (@{$self->_lane_elements}) { - my $position = $lane_el->getAttribute(q[position]); - if (!$position) { - croak q[Position is not defined for one of the lanes in batch ] . $self->batch_id; - } - - my $h = { - batch_id => $self->batch_id, - position => $position, - _lane_xml_element => $lane_el, - }; - if (defined $self->id_run) { $h->{id_run} = $self->id_run; } - push @{$lims}, st::api::lims::xml->new($h); - } - } else { - if ($self->is_pool && !$self->tag_index) { #now use XPath to find tag indexes for lane...: - foreach my $tag_index (sort {$a <=> $b} map{$_->textContent}$self->_lane_xml_element->findnodes(q(*/sample/tag/index))) { - my $h = { - batch_id => $self->batch_id, - position => $self->position, - tag_index => $tag_index, - _lane_xml_element => $self->_lane_xml_element, - }; - if (defined $self->id_run) { $h->{id_run} = $self->id_run; } - push @{$lims}, st::api::lims::xml->new($h); - } - } - } - return $lims; -} - -=head2 _lane_xml_element - -Private accessor. XML::LibXML::Element fragment of batch xml representing a lane. -Build only if the position accessor is set. - -=cut -has '_lane_xml_element' => (isa => 'Maybe[XML::LibXML::Element]', - is => 'ro', - lazy_build => 1, - ); -sub _build__lane_xml_element { - my $self = shift; - - if (!defined $self->position) { return; } - - foreach my $lane_el (@{$self->_lane_elements}) { - if($self->position == $lane_el->getAttribute(q[position])) { - return $lane_el; - } - } - croak q[Lane ] . $self->position . q[ is not defined in ] . $self->to_string; -} - -=head2 _entity_xml_element - -Private accessor. XML::LibXML::Element fragment of batch xml representing a low-lelel entity, -such as library, whether a whole lane, a plex, a control, or spiked phix. -Build only if the position accessor is set. - -=cut -has '_entity_xml_element' => (isa => 'Maybe[XML::LibXML::Element]', - is => 'ro', - init_arg => undef, - lazy_build => 1, - ); -sub _build__entity_xml_element { - my $self = shift; - - if (!$self->_lane_xml_element) { return; } - - my $element; - my $is_control = $self->_lane_xml_element->getChildrenByTagName(q[control]) ? 1 : 0; - my $has_pool_element = $self->_lane_xml_element->getChildrenByTagName(q[pool]) ? 1 :0; - my $is_pool = ! defined $self->tag_index && $has_pool_element ? 1 :0; - - my $plexes = - $has_pool_element ? $self->_lane_xml_element->getElementsByTagName(q[sample]) : undef; - if ($self->tag_index) { - if (!$plexes || !@{$plexes}) { - croak 'No plexes defined for lane ' . $self->position . q[ in batch ] . $self->batch_id; - } - if ($plexes) { - foreach my $plex (@{$plexes}) { - my $iel = $plex->getElementsByTagName(q[index]); - if ($iel) { - my $index = $iel->[0]->textContent(); - if($self->tag_index == $index) { - $element = $plex; - $is_control ||= $plex->parentNode->nodeName() eq q{hyb_buffer} ? 1 : 0; - last; - } - } - } - } - - if (!$element) { - my $buffer = $self->_lane_xml_element->getChildrenByTagName(q[hyb_buffer]); - if ($buffer) { - $buffer = $buffer->[0]; - my $el = $buffer->getElementsByTagName(q[index]); - if ($el) { - if ($el->[0]->textContent() == $self->tag_index) { - $is_control = 1; - $element = $buffer; - } - } - } - } - - if (!$element) { - croak q[No tag with index ] . $self->tag_index . q[ in lane ] . $self->position . q[ batch ] . $self->batch_id; - } - } else { - $is_pool = $plexes ? 1 : 0; - my $control = $self->_lane_xml_element->getChildrenByTagName(q[control]); - if ($control && @{$control}) { - $element = $control->[0]; - $is_control = 1; - } else { - my $ename = $is_pool ? q[pool] : q[library]; - $element = $self->_lane_xml_element->getChildrenByTagName($ename)->[0]; - } - } - - $self->_set_is_control($is_control); - $self->_set_is_pool($is_pool); - - return $element; -} - -=head2 _subentity_xml_element - -Private accessor. XML::LibXML::Element fragment of batch xml representing a sample element -(where available) within _entity_xml_element. -Build only if the position accessor is set. - -=cut -has '_subentity_xml_element' => (isa => 'Maybe[XML::LibXML::Element]', - is => 'ro', - init_arg => undef, - lazy_build => 1, - ); -sub _build__subentity_xml_element { - my $self = shift; - - if (!$self->_entity_xml_element || $self->is_pool || defined $self->tag_index) { return; } - my $subentity = $self->_entity_xml_element->getChildrenByTagName(q[sample])->[0] || undef; - return $subentity; -} - -=head2 default_tag_sequence - -Read-only string accessor, not possible to set from the constructor. -Undefined on a lane level and for zero tag_index. - -=cut -has 'default_tag_sequence' => (isa => 'Maybe[Str]', - is => 'ro', - init_arg => undef, - lazy_build => 1, - ); -sub _build_default_tag_sequence { - my $self = shift; - return $self->_get_tag_sequence('tag_id'); -} - -=head2 default_tag2_sequence - -Read-only string accessor, not possible to set from the constructor. -Undefined on a lane level and for zero tag_index. - -=cut -has 'default_tagtwo_sequence' => (isa => 'Maybe[Str]', - is => 'ro', - init_arg => undef, - lazy_build => 1, - ); -sub _build_default_tagtwo_sequence { - my $self = shift; - return $self->_get_tag_sequence('tag2_id'); -} - -sub _get_tag_sequence { - my ($self, $tag_sequence_name) = @_; - - if (!$tag_sequence_name) { - croak 'Need tag sequence element name'; - } - - my $seq; - if ($self->tag_index) { - if ($self->_entity_xml_element) { - - my @tag_elts = grep { $_->hasAttribute($tag_sequence_name) } $self->_entity_xml_element->getElementsByTagName(q[tag]); - if (scalar @tag_elts > 1) { - croak "Multiple tag entries for $tag_sequence_name"; - } - if (@tag_elts) { - my $sel = $tag_elts[0]->getElementsByTagName(q[expected_sequence]); - if ($sel) { - $seq = $sel->[0]->textContent(); - } - } - } - } - - return $seq; -} - -=head2 spiked_phix_tag_index - -Read-only integer accessor, not possible to set from the constructor. -Defined for a lane and all tags, including tag zero - -=cut -has 'spiked_phix_tag_index' => (isa => 'Maybe[NpgTrackingTagIndex]', - is => 'ro', - init_arg => undef, - lazy_build => 1, - ); -sub _build_spiked_phix_tag_index { - my $self = shift; - - if ($self->_lane_xml_element) { - my $buffer = $self->_lane_xml_element->getElementsByTagName(q[hyb_buffer]); - if ($buffer) { - my $el = $buffer->[0]->getElementsByTagName(q[index]); - if ($el) { - return $el->[0]->textContent(); - } else { - croak 'should be spiked phix, but tag index is not defined'; - } - } - } - return; -} - -=head2 is_control - -Read-only boolean accessor, not possible to set from the constructor. -True for a control lane and for the spiked phix plex, otherwise false. - -=cut -has 'is_control' => (isa => 'Bool', - is => 'ro', - init_arg => undef, - lazy_build => 1, - writer => '_set_is_control', - ); -sub _build_is_control { - my $self = shift; - return $self->_entity_xml_element ? $self->is_control : 0; -} - -=head2 is_pool - -Read-only boolean accessor, not possible to set from the constructor. -True for a pooled lane on a lane level, otherwise false. - -=cut -has 'is_pool' => (isa => 'Bool', - is => 'ro', - init_arg => undef, - lazy_build => 1, - writer => '_set_is_pool', - ); -sub _build_is_pool { - my $self = shift; - return $self->_entity_xml_element ? $self->is_pool : 0; -} - -has 'bait_name' => (isa => 'Maybe[Str]', - is => 'ro', - init_arg => undef, - lazy_build => 1, - ); - -=head2 bait_name - -Read-only accessor, not possible to set from the constructor. -Returns the name of the bait if given. For a pooled lane, for a control of if no bait given, -returns undefined value. - -=cut -sub _build_bait_name { - my $self = shift; - - my $bait_name; - if (!$self->is_pool && !$self->is_control && $self->_entity_xml_element) { - my $be = $self->_entity_xml_element->getElementsByTagName(q[bait]); - if ($be) { - $be = $be->[0]->getElementsByTagName('name'); - if ($be) { - $bait_name = $be->[0]->textContent(); - } - } - } - $bait_name ||= undef; - return $bait_name; -} - -=head2 lane_id - -For a lane level object returns the unique id (asset id) of the lane, -for other levels undefined. Read-only accessor, not possible to set from the constructor. - -=cut -has 'lane_id' => ( isa => 'Maybe[Int]', - is => 'ro', - init_arg => undef, - lazy_build => 1, - ); -sub _build_lane_id { - my $self = shift; - - my $id; - if ( defined $self->position() && !defined $self->tag_index() ) { - $id = $self->_lane_xml_element()->getAttribute('id'); - } - $id ||= undef; - return $id; -} - -=head2 lane_priority - -For a lane level object returns this lane priority, -for other levels undefined. Read-only accessor, not possible to set from the constructor. - -=cut -has 'lane_priority' => ( isa => 'Maybe[Int]', - is => 'ro', - init_arg => undef, - lazy_build => 1, - ); -sub _build_lane_priority { - my $self = shift; - - my $id = undef; - if ( defined $self->position() && !defined $self->tag_index() ) { - $id = $self->_lane_xml_element()->getAttribute('priority'); - } - return $id; -} - -=head2 library_id - -Read-only accessor, not possible to set from the constructor. - -=cut -has 'library_id' => (isa => 'Maybe[Int]', - is => 'ro', - init_arg => undef, - lazy_build => 1, - ); -sub _build_library_id { - my $self = shift; - - if(!$self->_xml_element_exists(q[entity])) { return; } - - my $id = $self->_entity_xml_element->getAttribute('id'); - if (!$id) { - $id = $self->_entity_xml_element->getAttribute('library_id'); - } - $id ||= undef; - return $id; -} - -=head2 library_name - -Read-only accessor, not possible to set from the constructor. - -=cut -has 'library_name' => (isa => 'Maybe[Str]', - is => 'ro', - init_arg => undef, - lazy_build => 1, - ); -sub _build_library_name { - my $self = shift; - - if(!$self->_xml_element_exists(q[entity])) { return; } - - my $name; - my $element = $self->_entity_xml_element; - if ($self->is_pool) { - $name = $element->getAttribute(q[name]); - } else { - if (!$self->tag_index) { - $element = $self->_subentity_xml_element; - } - if ($element) { - $name = $element->getAttribute(q[library_name]); - } - } - $name ||= undef; - return $name; -} - -=head2 default_library_type - -Read-only accessor, not possible to set from the constructor. - -=cut -has 'default_library_type' => (isa => 'Maybe[Str]', - is => 'ro', - init_arg => undef, - lazy_build => 1, - ); -sub _build_default_library_type { - my $self = shift; - - if(!$self->_xml_element_exists(q[entity]) || $self->is_pool) { return; } - - my $element = $self->tag_index ? $self->_entity_xml_element : $self->_subentity_xml_element; - my $type; - if ($element) { - $type = $element->getAttribute(q[library_type]); - } - $type ||= undef; - return $type; -} - -=head2 sample_id - -Read-only accessor, not possible to set from the constructor. - -=cut -has 'sample_id' => (isa => 'Maybe[Int]', - is => 'ro', - init_arg => undef, - lazy_build => 1, - ); -sub _build_sample_id { - my $self = shift; - - if(!$self->_xml_element_exists(q[entity])) { return; } - - my $sample_id = $self->_entity_xml_element->getAttribute(q[sample_id]); - if (!$sample_id && $self->_subentity_xml_element) { - $sample_id = $self->_subentity_xml_element->getAttribute(q[sample_id]); - } - if ($sample_id && $sample_id == $BAD_SAMPLE_ID) { - warn qq[Resetting magic sample id $BAD_SAMPLE_ID to undef\n]; - $sample_id = undef; - } - $sample_id ||= undef; - return $sample_id; -} - -=head2 study_id - -Read-only accessor, not possible to set from the constructor. - -=cut -has 'study_id' => (isa => 'Maybe[Int]', - is => 'ro', - init_arg => undef, - lazy_build => 1, - ); -sub _build_study_id { - my $self = shift; - if(!$self->_xml_element_exists(q[entity])) { return; } - my $study_id = $self->_entity_xml_element->getAttribute(q[study_id]); - if (!$study_id && $self->_subentity_xml_element) { - $study_id = $self->_subentity_xml_element->getAttribute(q[study_id]); - } - $study_id ||= undef; - return $study_id; -} - -=head2 project_id - -Read-only accessor, not possible to set from the constructor. - -=cut -has 'project_id' => (isa => 'Maybe[Int]', - is => 'ro', - init_arg => undef, - lazy_build => 1, - ); -sub _build_project_id { - my $self = shift; - - if(!$self->_xml_element_exists(q[entity])) { return; } - my $project_id = $self->_entity_xml_element->getAttribute(q[project_id]); - if (!$project_id && $self->_subentity_xml_element) { - $project_id = $self->_subentity_xml_element->getAttribute(q[project_id]); - } - $project_id ||= undef; - return $project_id; -} - -=head2 request_id - -Read-only accessor, not possible to set from the constructor. - -=cut -has 'request_id' => (isa => 'Maybe[Int]', - is => 'ro', - init_arg => undef, - lazy_build => 1, - ); -sub _build_request_id { - my $self = shift; - - if(!$self->_xml_element_exists(q[entity])) { return; } - my $request_id = $self->_entity_xml_element->getAttribute(q[request_id]) || undef; - return $request_id; -} - -=head2 qc_state - -Read-only accessor, not possible to set from the constructor. - -=cut -has 'qc_state' => (isa => 'Maybe[Str]', - is => 'ro', - init_arg => undef, - lazy_build => 1, - ); -sub _build_qc_state { - my $self = shift; - if ($self->_xml_element_exists(q[entity])) { - return $self->_entity_xml_element->getAttribute(q[qc_state]); - } - return; -} - -sub _build__library_object { - my $self = shift; - return $self->_lims_object(q[library]); -} -sub _build__sample_object { - my $self = shift; - return $self->_lims_object(q[sample]); -} -sub _build__study_object { - my $self = shift; - return $self->_lims_object(q[study]); -} -sub _build__project_object { - my $self = shift; - return $self->_lims_object(q[project]); -} -sub _build__request_object { - my $self = shift; - return $self->_lims_object(q[request]); -} - -foreach my $object_type ( @LIMS_OBJECTS ) { - - my $st_type = $object_type eq q[library] ? q[asset] : $object_type; - my $isa = q{Maybe[st::api::} . $st_type . q{]}; - my $attr_name = join q[_], q[], $object_type, q[object]; - has $attr_name => ( is => 'ro', isa => $isa, init_arg => undef, lazy_build => 1, handles => $DELEGATION{$object_type}); - - if (scalar keys %{$DELEGATION{$object_type}} == 0) { next; } - for my $func (keys %{$DELEGATION{$object_type}}) { - around $func => sub { - my ($orig, $self) = @_; - return $self->$attr_name ? $self->$orig() : undef; - }; - } -} - -=head2 required_insert_size_range - -Read-only accessor, not possible to set from the constructor. -Returns a has reference of expected insert sizes. - -=cut -has 'required_insert_size_range' => (isa => 'HashRef', - is => 'ro', - init_arg => undef, - lazy_build => 1, - ); -sub _build_required_insert_size_range { - my $self = shift; - - my $is_hash = {}; - if (!$self->is_control) { - my $is_element = $self->_entity_xml_element->getElementsByTagName(q[insert_size]); - if ($is_element) { - $is_element = $is_element->[0]; - } - if ($is_element) { - foreach my $key (qw/to from/) { - my $value = $is_element->getAttribute($key); - if ($value) { - $is_hash->{$key} = $value; - } - } - } - } - return $is_hash; -} - -=head2 sample_reference_genome - -Read-only accessor, not possible to set from the constructor. -Returns sample reference genome - -=cut -has 'sample_reference_genome' => (isa => 'Maybe[Str]', - is => 'ro', - init_arg => undef, - lazy_build => 1, - ); -sub _build_sample_reference_genome { - my $self = shift; - my $rg; - if ($self->_sample_object) { - $rg = $self->_sample_object->reference_genome; - } - return $rg; -} - -=head2 study_reference_genome - -Read-only accessor, not possible to set from the constructor. -Returns study reference genome - -=cut -has 'study_reference_genome' => (isa => 'Maybe[Str]', - is => 'ro', - init_arg => undef, - lazy_build => 1, - ); -sub _build_study_reference_genome { - my $self = shift; - my $rg; - if ($self->_study_object) { - $rg = $self->_study_object->reference_genome; - } - return $rg; -} - -=head2 study_contains_nonconsented_human - -Read-only accessor, not possible to set from the constructor. -For a library, control on non-zero plex returns the value of the -contains_nonconsented_human on the relevant study object. For a pool -or a zero plex returns 1 if any of the studies in the pool -contein unconcented human. - -On a batch level or if no associated study found, returns 0. - -=cut -has 'study_contains_nonconsented_human' => (isa => 'Bool', - is => 'ro', - init_arg => undef, - lazy_build => 1, - ); -sub _build_study_contains_nonconsented_human { - my $self = shift; - - my $cuh = 0; - if ($self->position && $self->_study_object) { - $cuh = $self->_study_object->contains_nonconsented_human; - } - if (!$cuh) { $cuh = 0; } - return $cuh; -} - -=head2 study_contains_nonconsented_xahuman - -Read-only accessor, not possible to set from the constructor. -For a library, control on non-zero plex returns the value of the -contains_nonconsented_xahuman on the relevant study object. For a pool -or a zero plex returns 1 if any of the studies in the pool -contain unconcented X and autosomal human. - -On a batch level or if no associated study found, returns 0. - -=cut -has 'study_contains_nonconsented_xahuman' => (isa => 'Bool', - is => 'ro', - init_arg => undef, - lazy_build => 1, - ); -sub _build_study_contains_nonconsented_xahuman { - my $self = shift; - - my $cuh = 0; - if ($self->position && $self->_study_object) { - $cuh = $self->_study_object->contains_nonconsented_xahuman; - } - if (!$cuh) { $cuh = 0; } - return $cuh; -} - -=head2 children - -Method returning a list of st::api::lims::xml objects that are associated with this object -and belong to the next (one lower) level. An empty list for a non-pool lane and for a plex. -For a pooled lane contains plex-level objects. On a batch level, when the position -accessor is not set, returns lane level objects. - -=cut -sub children { - my $self = shift; - return @{$self->_associated_lims}; -} - - -=head2 method_list - -Method returning a sorted list of useful accessors and methods. - -=cut -sub method_list { - my $self = shift; - my @attrs = (); - foreach my $name (__PACKAGE__->meta->get_attribute_list) { - if ($name =~ /^\_/smx) { - next; - } - push @attrs, $name; - } - - foreach my $object_type ( @LIMS_OBJECTS ) { - my @functions = keys %{$DELEGATION{$object_type}}; - if (@functions) { - push @attrs, @functions; - } - } - - @attrs = sort @attrs; - return @attrs; -} - -sub _lims_object { - my ($self, $object_type) = @_; - - my $class = q[st::api::] . $object_type; - my $method = join q[_], $object_type, q[id]; - my $id = $self->$method; - - if ($id) { - ## no critic (ProhibitStringyEval RequireCheckingReturnValueOfEval) - eval "require $class"; - ## use critic - return $class->new({id => $id,}); - } - return; -} - -sub _xml_element_exists { - my ($self, $el_type) = @_; - - if ($el_type ne q[lane] && $el_type ne q[entity]) { - croak qq[Unknown xml element type $el_type in _validate_xml_element]; - } - - my $attr = join q[_], q[], $el_type, q[xml], q[element]; - if(!$self->$attr) { - if ($self->position) { - croak qq[$attr attribute not defined in ] . $self->to_string; - } - return 0; - } - return 1; -} - -=head2 to_string - -Human friendly description of the object - -=cut -sub to_string { - my $self = shift; - - my $s = __PACKAGE__ . q[ object for batch ] . $self->batch_id; - if (defined $self->position) { - $s .= q[ position ] . $self->position; - } - if (defined $self->tag_index) { - $s .= q[ tag_index ] . $self->tag_index; - } - return $s; -} - -__PACKAGE__->meta->make_immutable; -no Moose; - -1; -__END__ - -=head1 DIAGNOSTICS - -=head1 CONFIGURATION AND ENVIRONMENT - -=head1 DEPENDENCIES - -=over - -=item Moose - -=item MooseX::StrictConstructor - -=item Carp - -=item English - -=item Readonly - -=item XML::LibXML - -=item npg::api::run - -=item st::api::batch - -=item npg_tracking::util::types - -=item npg_tracking::glossary::run - -=item npg_tracking::glossary::lane - -=item npg_tracking::glossary::tag - -=back - -=head1 INCOMPATIBILITIES - -=head1 BUGS AND LIMITATIONS - -=head1 AUTHOR - -Marina Gourtovaia Emg8@sanger.ac.ukE - -=head1 LICENSE AND COPYRIGHT - -Copyright (C) 2013,2014,2015,2016,2021 Genome Research Ltd. - -This file is part of NPG. - -NPG is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or -(at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with this program. If not, see . - -=cut diff --git a/t/40-st-lims-insert_size.t b/t/40-st-lims-insert_size.t deleted file mode 100755 index 2fde2793..00000000 --- a/t/40-st-lims-insert_size.t +++ /dev/null @@ -1,108 +0,0 @@ -use strict; -use warnings; -use Test::More tests => 40; -use Test::Exception; - -local $ENV{NPG_WEBSERVICE_CACHE_DIR} = q[t/data/test40_lims_edited]; - -use_ok('st::api::lims'); - -{ - my $lims = st::api::lims->new( - batch_id => 4775, position => 1, driver_type => 'xml'); - my $lid = $lims->library_id; - - my $is_available = 0; - my $is = {}; - $lims->_entity_required_insert_size($lims, $is, \$is_available); - is (keys %{$is}, 1, 'one entry in the insert size hash'); - is ($is->{$lid}->{q[from]}, 300, 'required FROM insert size'); - is ($is->{$lid}->{q[to]}, 400, 'required TO insert size'); - is ($is_available, 1, 'is reported as available'); - - $is_available = 1; - $lims->_entity_required_insert_size($lims, $is, \$is_available); - is ($is_available, 1, 'is reported as available'); - - $lims = st::api::lims->new( - batch_id => 4775, position => 2, driver_type => 'xml'); - $is = {}; - $is_available = 0; - $lims->_entity_required_insert_size($lims, $is, \$is_available); - is (keys %{$is}, 0, 'the insert size hash is empty'); - is ($is_available, 0, 'is reported as not available'); - - $is_available = 1; - $lims->_entity_required_insert_size($lims, $is, \$is_available); - is ($is_available, 1, 'is reported as available'); - - $lims = st::api::lims->new( - batch_id => 4775, position => 3, driver_type => 'xml'); - $is = {}; - $is_available = 0; - $lims->_entity_required_insert_size($lims, $is, \$is_available); - is (keys %{$is}, 0, 'the insert size hash is empty'); - is ($is_available, 0, 'is reported as not available'); -} - -{ - my $lims = st::api::lims->new( - batch_id => 4775, position => 1, driver_type => 'xml'); - my $lid = $lims->library_id; - my $insert_size; - lives_ok {$insert_size = $lims->required_insert_size} 'insert size for the first lane lives'; - is (keys %{$insert_size}, 1, 'one entry in the insert size hash'); - is ($insert_size->{$lid}->{q[from]}, 300, 'required FROM insert size'); - is ($insert_size->{$lid}->{q[to]}, 400, 'required TO insert size'); - - $lims = st::api::lims->new( - batch_id => 4775, position => 3, driver_type => 'xml'); - lives_ok {$insert_size = $lims->required_insert_size} 'insert size for the third lane where empty is hash is returned lives'; - is (keys %{$insert_size}, 0, 'no entries in the insert size hash'); - - $lims = st::api::lims->new( - batch_id => 4775, position => 4, driver_type => 'xml'); - lives_ok {$insert_size = $lims->required_insert_size} 'insert size for the control lane lives'; - is (keys %{$insert_size}, 0, 'no entries in the insert size hash'); - - $lims = st::api::lims->new( - batch_id => 4775, position => 8, driver_type => 'xml'); - ok ($lims ->is_pool, 'lane is a pool'); - lives_ok {$insert_size = $lims->required_insert_size} 'insert size for the pool where empty is hash is returned lives'; - is (keys %{$insert_size}, 0, 'no entries in the insert size hash'); - - $lims = st::api::lims->new( - batch_id => 4775, position => 7, driver_type => 'xml'); - ok ($lims ->is_pool, 'lane is a pool'); - lives_ok {$insert_size = $lims->required_insert_size} 'insert size for the pool lives'; - is (keys %{$insert_size}, 2, 'two entries in the insert size hash'); - is ($insert_size->{2798524}->{q[from]}, 40, 'required FROM insert size'); - is ($insert_size->{2798524}->{q[to]}, 50, 'required TO insert size'); - ok (!exists $insert_size->{2798525}->{q[from]}, 'no required FROM insert size'); - is ($insert_size->{2798525}->{q[to]}, 500, 'required TO insert size'); - - $lims = st::api::lims->new( - batch_id => 4775, position => 7, tag_index => 2, driver_type => 'xml'); - lives_ok {$insert_size = $lims->required_insert_size} 'insert size for the plex lives'; - is (keys %{$insert_size}, 1, 'one entry in the insert size hash'); - is ($insert_size->{2798524}->{q[from]}, 40, 'required FROM insert size'); - is ($insert_size->{2798524}->{q[to]}, 50, 'required TO insert size'); -} - -{ - my $lims = st::api::lims->new( - driver_type => 'xml', batch_id => 14706, position => 1, tag_index => 2); - my $insert_size; - lives_ok {$insert_size = $lims->required_insert_size} 'insert size for the plex without lib id lives'; - is ($insert_size->{2}->{q[from]}, 200, 'required FROM insert size'); - is ($insert_size->{2}->{q[to]}, 400, 'required TO insert size'); - - $lims = st::api::lims->new( - driver_type => 'xml', batch_id => 14706, position => 2); - lives_ok {$insert_size = $lims->required_insert_size} 'insert size for the pool with plexes without lib ids lives'; - is (join(q[ ], sort keys %{$insert_size}), '1 2 3 4 5', 'tag index entries in the insert size hash'); - is ($insert_size->{5}->{q[from]}, 200, 'required FROM insert size'); - is ($insert_size->{4}->{q[to]}, 400, 'required TO insert size'); -} - -1; diff --git a/t/40-st-lims-samplesheet.t b/t/40-st-lims-samplesheet.t index c3a10f1e..78c785ed 100644 --- a/t/40-st-lims-samplesheet.t +++ b/t/40-st-lims-samplesheet.t @@ -337,7 +337,7 @@ subtest 'Multiple NovaSeq runs - top-up merge support' => sub { } }; -subtest 'multiple lanes, comparison of xml and samplesheet drivers' => sub { +subtest 'multiple lanes' => sub { plan tests => 5; my $path = 't/data/samplesheet/4pool4libs_extended.csv'; diff --git a/t/40-st-lims.t b/t/40-st-lims.t index 8a9b0193..80a41911 100644 --- a/t/40-st-lims.t +++ b/t/40-st-lims.t @@ -1,6 +1,6 @@ use strict; use warnings; -use Test::More tests => 30; +use Test::More tests => 14; use Test::Exception; use Test::Warn; use File::Temp qw/ tempdir /; @@ -11,19 +11,8 @@ local $ENV{'http_proxy'} = 'http://wibble.com'; use_ok('st::api::lims'); -my %dr = (driver_type =>'xml',); - -subtest 'Class methods' => sub { - plan tests => 10; - - is(st::api::lims->cached_samplesheet_var_name, 'NPG_CACHED_SAMPLESHEET_FILE', - 'correct name of the cached samplesheet env var'); - - is(scalar st::api::lims->driver_method_list(), $num_delegated_methods, 'driver method list length'); - is(scalar st::api::lims::driver_method_list_short(), $num_delegated_methods, 'short driver method list length'); - is(scalar st::api::lims->driver_method_list_short(), $num_delegated_methods, 'short driver method list length'); - is(scalar st::api::lims::driver_method_list_short(qw/sample_name/), $num_delegated_methods-1, 'one method removed from the list'); - is(scalar st::api::lims->driver_method_list_short(qw/sample_name study_name/), $num_delegated_methods-2, 'two methods removed from the list'); +subtest 'Test trim' => sub { + plan tests => 4; my $value = 'some other'; is(st::api::lims->_trim_value($value), $value, 'nothing trimmed'); @@ -32,77 +21,95 @@ subtest 'Class methods' => sub { is(st::api::lims->_trim_value(" "), undef, 'white space string trimmed to undef'); }; -subtest 'Setting return value for primary attributes' => sub { - plan tests => 51; +subtest 'Driver type, methods and driver build' => sub { + plan tests => 27; - local $ENV{NPG_WEBSERVICE_CACHE_DIR} = 't/data/st_api_lims_new'; + my $ss_path = 't/data/samplesheet/miseq_default.csv'; + local $ENV{NPG_CACHED_SAMPLESHEET_FILE} = $ss_path; + my $l; + lives_ok {$l = st::api::lims->new(id_run => 10262,)} + 'no error creating an object with samplesheet file defined in env var'; + is ($l->driver_type, 'samplesheet', 'driver type is built as samplesheet'); + is ($l->path, $ss_path, 'correct path is built'); + is (ref $l->driver, 'st::api::lims::samplesheet', 'correct driver object type'); + is ($l->driver->path, $ss_path, 'correct path assigned to the driver object'); - my @other = qw/path id_flowcell_lims flowcell_barcode/; + local $ENV{NPG_CACHED_SAMPLESHEET_FILE} = 't/data/samplesheet'; + ok (-d $ENV{NPG_CACHED_SAMPLESHEET_FILE}); + lives_ok {$l = st::api::lims->new(id_run => 10262,)} + 'no error creating an object with samplesheet file defined in env var'; + is ($l->driver_type, 'samplesheet', 'driver type is samplesheet'); + throws_ok { $l->path } + qr/Attribute \(path\) does not pass the type constraint/, + 'samplesheet cannot be a directory'; - my $lims = st::api::lims->new( - %dr, id_run => 6551, batch_id => 12141, position => 2); - my $lane_lims = $lims; - for my $attr (@other) { - is ($lims->$attr, undef, "$attr is undefined"); - } - is ($lims->id_run, 6551, 'id run is set correctly'); - is ($lims->batch_id, 12141, 'batch id is set correctly'); - is ($lims->position, 2, 'position is set correctly'); - is ($lims->tag_index, undef, 'tag_index is undefined'); - ok ($lims->is_pool, 'lane is a pool'); + local $ENV{NPG_CACHED_SAMPLESHEET_FILE} = 't/data/samplesheet/non-existing'; + ok (not -e $ENV{NPG_CACHED_SAMPLESHEET_FILE}); + lives_ok {$l = st::api::lims->new(id_run => 10262,)} + 'no error creating an object with samplesheet file defined in env var'; + is ($l->driver_type, 'samplesheet', 'driver type is samplesheet'); + throws_ok {$l->children} + qr/Attribute \(path\) does not pass the type constraint/, + 'samplesheet file should exist'; - my @children = $lims->children(); - $lims = shift @children; - for my $attr (@other) { - is ($lims->$attr, undef, "$attr is undefined"); - } - is ($lims->id_run, 6551, 'id run is set correctly'); - is ($lims->batch_id, 12141, 'batch id is set correctly'); - is ($lims->position, 2, 'position is set correctly'); - is ($lims->tag_index, 1, 'tag_index is set to 1'); - - $lims = st::api::lims->new( - %dr, id_run => 6551, batch_id => 12141, position => 2, tag_index => 0); - for my $attr (@other) { - is ($lims->$attr, undef, "$attr is undefined"); - } - is ($lims->id_run, 6551, 'id run is set correctly'); - is ($lims->batch_id, 12141, 'batch id is set correctly'); - is ($lims->position, 2, 'position is set correctly'); - is ($lims->tag_index, 0, 'tag_index is set to zero'); - ok ($lims->is_pool, 'tag zero is a pool'); + local $ENV{NPG_CACHED_SAMPLESHEET_FILE} = 't/data/samplesheet/non-existing'; + lives_ok {$l = st::api::lims->new(id_run => 10262, path => $ss_path)} + 'no error creating an object with samplesheet file defined in env var and path given'; + is ($l->driver_type, 'samplesheet', 'driver type is samplesheet'); + lives_ok {$l->children} 'given path takes precedence'; - $lims = st::api::lims->new(driver => $lane_lims->driver(), - id_run => 6551, batch_id => 12141, position => 2, tag_index => 0); - is ($lims->id_run, 6551, 'id run is set correctly'); - is ($lims->batch_id, 12141, 'batch id is set correctly'); - is ($lims->position, 2, 'position is set correctly'); - is ($lims->tag_index, 0, 'tag_index is set to zero'); - ok ($lims->is_pool, 'tag zero is a pool'); + throws_ok { st::api::lims->new( + id_run => 6551, driver_type => 'some') } + qr/Can\'t locate st\/api\/lims\/some\.pm in \@INC/, + 'unknown driver type specified - error'; - $lims = st::api::lims->new( - %dr, id_run => 6551, batch_id => 12141, position => 2, tag_index => 2); - is ($lims->tag_index, 2, 'tag_index is set correctly'); + is (st::api::lims->cached_samplesheet_var_name, 'NPG_CACHED_SAMPLESHEET_FILE', + 'get name of the cached samplesheet env var via a class method'); - my $path = 't/data/samplesheet/miseq_default.csv'; - local $ENV{NPG_CACHED_SAMPLESHEET_FILE} = $path; + local $ENV{NPG_CACHED_SAMPLESHEET_FILE} = 't/data/samplesheet/miseq_default.csv'; + $l = st::api::lims->new(id_run => 6551); + is($l->driver_type, 'samplesheet'); + isa_ok ($l->driver(), 'st::api::lims::samplesheet'); - $lims = st::api::lims->new(id_run => 6551, position => 1, tag_index => 0); - is ($lims->driver_type, 'samplesheet', 'samplesheet driver'); + use_ok('st::api::lims::samplesheet'); + $l = st::api::lims->new(id_run => 6551, + driver => st::api::lims::samplesheet->new( + id_run => 6551, + path => $ENV{NPG_CACHED_SAMPLESHEET_FILE})); + is($l->driver_type, 'samplesheet', 'driver type from the driver object'); - push @other, 'batch_id'; - shift @other; + is(scalar st::api::lims->driver_method_list(), $num_delegated_methods, + 'driver method list length'); + is(scalar st::api::lims::driver_method_list_short(), $num_delegated_methods, + 'short driver method list length'); + is(scalar st::api::lims->driver_method_list_short(), $num_delegated_methods, + 'short driver method list length'); + is(scalar st::api::lims::driver_method_list_short(qw/sample_name/), + $num_delegated_methods-1, 'one method removed from the list'); + is(scalar st::api::lims->driver_method_list_short(qw/sample_name study_name/), + $num_delegated_methods-2, 'two methods removed from the list'); +}; + +subtest 'Setting return value for primary attributes' => sub { + plan tests => 23; + + my @other = qw/batch_id id_flowcell_lims flowcell_barcode/; + my $ss_path = 't/data/samplesheet/miseq_default.csv'; + local $ENV{NPG_CACHED_SAMPLESHEET_FILE} = $ss_path; + + my $lims = st::api::lims->new(id_run => 6551, position => 1, tag_index => 0); + is ($lims->driver_type, 'samplesheet', 'samplesheet driver'); for my $attr (@other) { is ($lims->$attr, undef, "$attr is undefined"); } is ($lims->id_run, 6551, 'id run is set correctly'); - is ($lims->path, $path, 'path is set correctly'); + is ($lims->path, $ss_path, 'path is set correctly'); is ($lims->position, 1, 'position is set correctly'); is ($lims->tag_index, 0, 'tag_index is set to zero'); ok ($lims->is_pool, 'tag zero is a pool'); - $lane_lims = st::api::lims->new(id_run => 6551, position => 1); + my $lane_lims = st::api::lims->new(id_run => 6551, position => 1); $lims = st::api::lims->new(driver => $lane_lims->driver(), id_run => 6551, position => 1, @@ -112,6 +119,10 @@ subtest 'Setting return value for primary attributes' => sub { is ($lims->tag_index, 0, 'tag_index is set to zero'); ok ($lims->is_pool, 'tag zero is a pool'); ok (!$lims->is_composition, 'tag zero is not a composition'); + is($lims->to_string, + 'st::api::lims object, driver - samplesheet, id_run 6551, ' . + 'path t/data/samplesheet/miseq_default.csv, position 1, tag_index 0', + 'object as string'); $lims = st::api::lims->new(rpt_list => '6551:1'); my @a = @other; @@ -123,631 +134,6 @@ subtest 'Setting return value for primary attributes' => sub { } }; -local $ENV{NPG_WEBSERVICE_CACHE_DIR} = 't/data/st_api_lims_new'; - -my @libs_6551_1 = ('PhiX06Apr11','SS109114 2798524','SS109305 2798523','SS117077 2798526','SS117886 2798525','SS127358 2798527','SS127858 2798529','SS128220 2798530','SS128716 2798531','SS129050 2798528','SS129764 2798532','SS130327 2798533','SS131636 2798534'); -my @samples_6551_1 = qw/phiX_for_spiked_buffers SS109114 SS109305 SS117077 SS117886 SS127358 SS127858 SS128220 SS128716 SS129050 SS129764 SS130327 SS131636/; -my @accessions_6551_1 = qw/ERS024591 ERS024592 ERS024593 ERS024594 ERS024595 ERS024596 ERS024597 ERS024598 ERS024599 ERS024600 ERS024601 ERS024602/; -my @studies_6551_1 = ('Illumina Controls','Discovery of sequence diversity in Shigella sp.'); - -subtest 'Driver type and driver build' => sub { - plan tests => 11; - - throws_ok { st::api::lims->new( - id_run => 6551, batch_id => 12141, driver_type => 'some') } - qr/Can\'t locate st\/api\/lims\/some\.pm in \@INC/, - 'unknown driver type specified - error'; - - isa_ok (st::api::lims->new( - id_run => 6551, batch_id => 12141, driver_type => 'xml')->driver(), - 'st::api::lims::xml'); - - is (st::api::lims->cached_samplesheet_var_name, 'NPG_CACHED_SAMPLESHEET_FILE', - 'get name of the cached samplesheet env var via a class method'); - - my $l = st::api::lims->new(id_run => 6551); - is($l->driver_type, 'samplesheet'); - is($l->cached_samplesheet_var_name, 'NPG_CACHED_SAMPLESHEET_FILE', - 'get name of the cached samplesheet env var via an instance method'); - lives_ok { $l->driver() } 'can instantiate samplesheet driver'; - throws_ok { $l->num_children() } - qr/Attribute \(path\) does not pass the type constraint/, - 'no samplesheet file - error invoking a method'; - - local $ENV{NPG_CACHED_SAMPLESHEET_FILE} = 't/data/samplesheet/miseq_default.csv'; - $l = st::api::lims->new(id_run => 6551); - is($l->driver_type, 'samplesheet'); - isa_ok ($l->driver(), 'st::api::lims::samplesheet'); - - use_ok('st::api::lims::samplesheet'); - $l = st::api::lims->new(id_run => 6551, - driver => st::api::lims::samplesheet->new( - id_run => 6551, - path => $ENV{NPG_CACHED_SAMPLESHEET_FILE})); - is($l->driver_type, 'samplesheet', 'driver type from the driver object'); -}; - -subtest 'Run-level object' => sub { - plan tests => 18; - - my $lims = st::api::lims->new(%dr, id_run => 6551, batch_id => 12141); - is(scalar $lims->driver_method_list_short(), $num_delegated_methods, 'short driver method list lenght from an object'); - is(scalar $lims->driver_method_list_short(qw/sample_name other_name/), $num_delegated_methods-1, 'one method removed from the list'); - is($lims->lane_id(), undef, q{lane_id undef for id_run 6551, not a lane} ); - is($lims->batch_id, 12141, 'batch id is 12141'); - is($lims->is_control, 0, 'not control'); - is($lims->is_pool, 0, 'not pool'); - is($lims->library_id, undef, 'no lib id'); - is($lims->seq_qc_state, undef, 'no seq qc state'); - is($lims->tag_sequence, undef, 'tag_sequence undefined'); - is($lims->tags, undef, 'tags undefined'); - is($lims->spiked_phix_tag_index, undef, 'spiked phix tag index undefined'); - is(scalar $lims->descendants, 185, '185 descendant lims'); - is(scalar $lims->children, 8, '8 child lims'); - is($lims->to_string, 'st::api::lims object, driver - xml, batch_id 12141, id_run 6551', 'object as string'); - is(scalar($lims->library_names), 0, 'batch-level library_names list empty'); - is(scalar($lims->sample_names), 0, 'batch-level sample_names list empty'); - is(scalar($lims->sample_accession_numbers), 0, 'batch-level sample_accession_numbers list empty'); - is(scalar($lims->study_names), 0, 'batch-level study_names list empty'); -}; - -subtest 'Lane-level object' => sub { - plan tests => 103; - - my @lims_list = (); - push @lims_list, st::api::lims->new( - %dr, id_run => 6551, batch_id => 12141, position => 1); - my @comps = (); - foreach my $tag ((1 .. 12)) { - push @comps, "6551:1:${tag}"; - } - my $rpt_list = join q[;], @comps; - push @lims_list, - st::api::lims->new(%dr, batch_id => 12141, rpt_list => $rpt_list); - my $count = 0; - foreach my $lims (@lims_list) { - is($lims->rpt_list, $count ? $rpt_list : undef, 'rpt list value'); - is($lims->id_run, $count ? undef : 6551, 'id_run value'); - is($lims->position, $count ? undef : 1, 'position value'); - is($lims->lane_id(), $lims->rpt_list ? undef : 3065552, 'lane id'); - is($lims->batch_id, 12141, 'batch id'); - is($lims->is_control, 0, 'entity is not control'); - is($lims->is_pool, $lims->rpt_list ? undef : 1, 'pool flag value'); - is($lims->is_composition, $lims->rpt_list ? 1 : 0, 'composition flag value'); - - is($lims->library_id, $lims->rpt_list ? undef : 2988920, 'lib id'); - is($lims->library_name, $lims->rpt_list ? undef : '297p11', 'pool lib name'); - is($lims->seq_qc_state, $lims->rpt_list ? undef : 1, 'seq qc passed'); - is($lims->tag_sequence, undef, 'tag_sequence undefined'); - is(scalar keys %{$lims->tags}, $lims->rpt_list ? 12 : 13, '13 tags defined'); - is($lims->spiked_phix_tag_index, $lims->rpt_list ? undef : 168, - 'spiked phix tag index 168'); - if (!$lims->rpt_list) { - is($lims->tags->{$lims->spiked_phix_tag_index}, - 'ACAACGCAAT', 'tag_sequence for phix'); - } - is(scalar $lims->children, $lims->rpt_list ? 12 : 13, 'number of children'); - is($lims->num_children, $lims->rpt_list ? 12 : 13, 'number of children'); - - is($lims->sample_supplier_name, undef, 'supplier sample name undefined'); - is($lims->sample_cohort, undef, 'supplier sample cohort undefined'); - is($lims->sample_donor_id, undef, 'supplier sample donor id undefined'); - ok($lims->study_alignments_in_bam, 'alignment_in_bam is true'); - - my $plexes_hash = $lims->children_ia(); - my $k1 = $lims->rpt_list ? '6551:1:1' : 1; - my $k6 = $lims->rpt_list ? '6551:1:6' : 6; - my $p1 = $plexes_hash->{$k1}; - my $p6 = $plexes_hash->{$k6}; - is($p1->id_run, 6551, 'plex id_run'); - is($p1->position, 1, 'plex position'); - is($p1->tag_index, 1, 'plex tag index'); - ok(!$p1->is_pool, 'not a pool'); - ok(!$p1->is_composition, 'not a composition'); - is ($p1->default_tag_sequence, 'ATCACGTTAT', 'plex tag sequence'); - is($p1->sample_supplier_name, undef, 'supplier sample name undefined'); - is($p1->sample_cohort, undef, 'supplier sample cohort undefined'); - is($p1->sample_donor_id, undef, 'supplier sample donor id undefined'); - is ($p6->tag_index, 6, 'plex tag index'); - is ($p6->default_tag_sequence, 'GCCAATGTAT', 'plex tag sequence'); - - is($lims->to_string, $lims->rpt_list ? - "st::api::lims object, batch_id 12141, rpt_list $rpt_list" : - 'st::api::lims object, driver - xml, batch_id 12141, id_run 6551, position 1', - 'string respresentation of the object'); - - my @libs = @libs_6551_1; - my @samples = @samples_6551_1; - my @studies = @studies_6551_1; - if ($lims->rpt_list) { - shift @libs; - shift @samples; - shift @studies; - } - - is(join(q[,], $lims->library_names), join(q[,], sort @libs), - 'top level library_names list'); - is(join(q[,], $lims->sample_names), join(q[,], sort @samples), - 'top level sample_names list'); - is(join(q[,], $lims->sample_accession_numbers), join(q[,], sort @accessions_6551_1), - 'top level sample_accession_numbers list'); - is(join(q[,], $lims->study_names), join(q[,], sort @studies), - 'top level study_names list'); - - my $with_spiked_phix = 1; - my @lib_ids = qw/2798523 2798524 2798525 2798526 2798527 2798528 - 2798529 2798530 2798531 2798532 2798533 2798534/; - is_deeply([$lims->library_ids($with_spiked_phix)], - $lims->rpt_list ? [@lib_ids] : [2389196, @lib_ids], - 'top level library_ids list $with_spiked_phix = 1'); - is(join(q[,], $lims->library_names($with_spiked_phix)), join(q[,], sort @libs), - 'top level library_names list $with_spiked_phix = 1'); - - my @sample_ids = qw/1093818 1093819 1093820 1093821 1093822 1093823 - 1093824 1093825 1093826 1093827 1093828 1093829/; - is_deeply([$lims->sample_ids($with_spiked_phix)], - $lims->rpt_list ? [@sample_ids] : [@sample_ids, 1255141], - 'top level sample_names list $with_spiked_phix = 1'); - is(join(q[,], $lims->sample_names($with_spiked_phix)), join(q[,], sort @samples), - 'top level sample_names list $with_spiked_phix = 1'); - is(join(q[,], $lims->sample_accession_numbers($with_spiked_phix)), - join(q[,], sort @accessions_6551_1), - 'top level sample_accession_number list $with_spiked_phix = 1'); - - is(join(q[,], $lims->study_names($with_spiked_phix)), join(q[,], sort @studies), - 'top level study_names list $with_spiked_phix = 1'); - is(join(q[,], $lims->study_ids($with_spiked_phix)), - $lims->rpt_list ? '297' : '198,297', - 'top level study_ids list $with_spiked_phix = 1'); - is(join(q[,], $lims->project_ids($with_spiked_phix)), '297', - 'top level project_ids list $with_spiked_phix = 1'); - - $with_spiked_phix = 0; - if (!$lims->rpt_list) { - shift @libs; - shift @samples; - shift @studies; - } - is(join(q[,], $lims->library_names($with_spiked_phix)), join(q[,], sort @libs), - 'top level library_names list $with_spiked_phix = 0;'); - is(join(q[,], $lims->sample_names($with_spiked_phix)), join(q[,], sort @samples), - 'top level sample_names list $with_spiked_phix = 0;'); - is(join(q[,], $lims->sample_accession_numbers($with_spiked_phix)), - join(q[,], sort @accessions_6551_1), - 'top level sample_accession_number list $with_spiked_phix = 0'); - is(join(q[,], $lims->study_names($with_spiked_phix)), join(q[,], sort @studies), - 'top level study_names list $with_spiked_phix = 0;'); - is(join(q[,], $lims->library_types()), 'Standard', 'top level library types list'); - - is($lims->sample_consent_withdrawn, undef, 'consent withdrawn false'); - is($lims->any_sample_consent_withdrawn, 0, 'any consent withdrawn false'); - - $count++; - } -}; - -subtest 'Object for tag zero' => sub { - plan tests => 27; - - my $lims = st::api::lims->new( - %dr, id_run => 6551, batch_id => 12141, position => 1, tag_index => 0); - is($lims->lane_id(), undef, q{lane_id undef for id_run 6551, position 1, tag_index defined} ); - is($lims->batch_id, 12141, 'batch id is 12141 for lane 1'); - is($lims->is_control, 0, 'lane 1 is not control'); - is($lims->is_pool, 1, 'lane 1 is pool'); - is($lims->library_id, 2988920, 'lib id'); - is($lims->library_name, '297p11', 'pool lib name'); - is($lims->contains_nonconsented_human, 0, 'does not contain nonconsented human'); - is($lims->contains_unconsented_human, 0, 'does not contain unconsented human (back compat)'); - is($lims->contains_nonconsented_xahuman, 0, 'does not contain nonconsented X and autosomal human'); - is($lims->tag_sequence, undef, 'tag_sequence undefined'); - is(scalar keys %{$lims->tags}, 13, '13 tags defined'); - is($lims->spiked_phix_tag_index, 168, 'spiked phix tag index'); - is(scalar $lims->descendants, 13, '13 descendant lims'); - is(scalar $lims->children, 13, '13 child lims'); - is($lims->to_string, 'st::api::lims object, driver - xml, batch_id 12141, id_run 6551, position 1, tag_index 0', 'object as string'); - is(join(q[,], $lims->library_names), join(q[,], sort @libs_6551_1), 'tag 0 library_names list'); - is(join(q[,], $lims->sample_names), join(q[,], sort @samples_6551_1), 'tag 0 sample_names list'); - is(join(q[,], $lims->sample_accession_numbers), join(q[,], sort @accessions_6551_1), 'tag 0 sample_accession_numbers list'); - is(join(q[,], $lims->study_names), join(q[,], sort @studies_6551_1), 'tag 0 study_names list'); - - my $with_spiked_phix = 1; - is(join(q[,], $lims->library_names($with_spiked_phix)), join(q[,], sort @libs_6551_1), 'tag 0 library_names list $with_spiked_phix = 1'); - is(join(q[,], $lims->sample_names($with_spiked_phix)), join(q[,], sort @samples_6551_1), 'tag 0 sample_names list $with_spiked_phix = 1'); - is(join(q[,], $lims->sample_accession_numbers($with_spiked_phix)), join(q[,], sort @accessions_6551_1), 'tag 0 sample_accession_numbers list $with_spiked_phix = 1'); - is(join(q[,], $lims->study_names($with_spiked_phix)), join(q[,], sort @studies_6551_1), 'tag 0 study_names list $with_spiked_phix = 1'); - - $with_spiked_phix = 0; - my @libs = @libs_6551_1; shift @libs; - my @samples = @samples_6551_1; shift @samples; - my @studies = @studies_6551_1; shift @studies; - is(join(q[,], $lims->library_names($with_spiked_phix)), join(q[,], sort @libs), 'tag 0 library_names list $with_spiked_phix = 0;'); - is(join(q[,], $lims->sample_names($with_spiked_phix)), join(q[,], sort @samples), 'tag 0 sample_names list $with_spiked_phix = 0;'); - is(join(q[,], $lims->sample_accession_numbers($with_spiked_phix)), join(q[,], sort @accessions_6551_1), 'tag 0 sample_accession_numbers list $with_spiked_phix = 0'); - is(join(q[,], $lims->study_names($with_spiked_phix)), join(q[,], sort @studies), 'tag 0 study_names list $with_spiked_phix = 0;'); -}; - -subtest 'Object for spiked phix tag' => sub { - plan tests => 24; - - my $lims = st::api::lims->new( - %dr, id_run => 6551, batch_id => 12141, position => 1, tag_index => 168); - is($lims->is_control, 1, 'tag 1/168 is control'); - is($lims->is_pool, 0, 'tag 1/168 is not a pool'); - is($lims->contains_nonconsented_human, 0, 'does not contain nonconcented human'); - is($lims->contains_nonconsented_xahuman, 0, 'does not contain nonconsented X and autosomal human'); - my $lib_id = 2389196; - is($lims->library_id, $lib_id, 'hyb buffer lib id'); - my $lib_name = 'PhiX06Apr11'; - is($lims->library_name, $lib_name, 'hyb buffer lib name'); - my $sample_id = 1255141; - is($lims->sample_id, $sample_id, 'hyb buffer sample id'); - my $study_id = 198; - is($lims->study_id, $study_id, 'hyb buffer study id'); - is($lims->reference_genome, undef, 'reference genome not set'); - is($lims->tag_sequence, 'ACAACGCAAT', 'tag_sequence for phix'); - is($lims->tags, undef, 'tags undefined'); - is($lims->seq_qc_state, undef, 'no seq qc state'); - is($lims->spiked_phix_tag_index, 168, 'spiked phix tag index returned'); - is(scalar $lims->associated_lims, 0, 'no associated lims'); - is(scalar $lims->descendants, 0, 'no descendant lims'); - is(scalar $lims->associated_child_lims, 0, 'no associated child lims'); - is(scalar $lims->children, 0, 'no child lims'); - is(join(q[ ], $lims->library_names), $libs_6551_1[0], 'tag 168 library_names list'); - is(join(q[ ], $lims->sample_names), $samples_6551_1[0], 'tag 168 sample_names list'); - is(join(q[ ], $lims->sample_accession_numbers), q[], 'tag 168 sample_accession_numbers list (no accession for phiX)'); - is(join(q[ ], $lims->study_names), $studies_6551_1[0], 'tag 168 study_names list'); - - my $with_spiked_phix = 0; - is(join(q[ ], $lims->library_names($with_spiked_phix)), $libs_6551_1[0], 'tag 168 library_names list'); - is(join(q[ ], $lims->sample_names($with_spiked_phix)), $samples_6551_1[0], 'tag 168 sample_names list'); - is(join(q[ ], $lims->study_names($with_spiked_phix)), $studies_6551_1[0], 'tag 168 study_names list'); -}; - -subtest 'Object for a tag' => sub { - plan tests => 32; - - my $lims = st::api::lims->new( - %dr, id_run => 6551, batch_id => 12141, position => 1, tag_index => 1); - is($lims->is_control, 0, 'tag 1/1 is not control'); - is($lims->is_pool, 0, 'tag 1/1 is not a pool'); - is($lims->contains_nonconsented_human, 0, 'does not contain nonconcented human'); - is($lims->contains_nonconsented_xahuman, 0, 'does not contain nonconsented X and autosomal human'); - is($lims->spiked_phix_tag_index, 168, 'spiked phix tag index returned'); - is(join(q[ ], $lims->library_names), 'SS109305 2798523', 'tag 1 library_names list'); - is(join(q[ ], $lims->sample_names), 'SS109305', 'tag 1 sample_names list'); - is(join(q[ ], $lims->sample_accession_numbers), 'ERS024591', 'tag 1 sample_accession_numbers list'); - is(join(q[ ], $lims->study_names), $studies_6551_1[1], 'tag 1 study_names list'); - - my $with_spiked_phix = 0; - is(join(q[ ], $lims->library_names($with_spiked_phix)), 'SS109305 2798523', 'tag 1 library_names list $with_spiked_phix = 0'); - is(join(q[ ], $lims->sample_names($with_spiked_phix)), 'SS109305', 'tag 1 sample_names list $with_spiked_phix = 0'); - is(join(q[ ], $lims->sample_accession_numbers($with_spiked_phix)), 'ERS024591', 'tag 1 sample_accession_numbers list $with_spiked_phix = 0'); - is(join(q[ ], $lims->study_names($with_spiked_phix)), $studies_6551_1[1], 'tag 1 study_names list $with_spiked_phix = 0'); - - $lims = st::api::lims->new( - %dr, id_run => 6607, batch_id => 12378, position => 5, tag_index => 1); - is($lims->batch_id, 12378, 'batch id for lane 5 tag 1'); - is($lims->tag_index, 1, 'tag index 1'); - is($lims->is_control, 0, 'plex 5/1 is not control'); - is($lims->is_pool, 0, 'plex 5/1 is not pool'); - is($lims->library_id, 3111679, 'lib id'); - is($lims->sample_id, 1132331, 'sample id'); - is($lims->study_id, 429, 'study id'); - is($lims->project_id, 429, 'project id'); - is($lims->request_id, undef, 'request id'); - is($lims->library_name, 'HiC_H_ON_DCJ 3111679', 'lib name'); - is($lims->sample_name, 'HiC_H_ON_DCJ', 'sample name undefined'); - is($lims->study_name, '3C and HiC of Plasmodium falciparum IT', 'study name'); - my $project_name = q[3C and HiC of Plasmodium falciparum IT]; - is($lims->project_name, $project_name, 'project name'); - is($lims->tag_sequence, 'ATCACGTT', 'tag_sequence'); - is($lims->tags, undef, 'tags undefined'); - is($lims->spiked_phix_tag_index, undef, 'spiked phix tag index undefined'); - ok(!$lims->alignments_in_bam, 'no bam alignment'); - is($lims->seq_qc_state, undef, 'no seq qc state'); - is(scalar $lims->associated_lims, 0, 'no associated lims'); -}; - -subtest 'Object for a non-pool lane' => sub { - plan tests => 99; - - my $lims = st::api::lims->new( - %dr, id_run => 6607, batch_id => 12378, position => 1); - isa_ok($lims, 'st::api::lims'); - is($lims->batch_id, 12378, 'batch id for lane 1'); - is($lims->is_control, 0, 'lane 1 is not control'); - is($lims->is_pool, 0, 'lane 1 is not pool'); - is($lims->library_id, 3033734, 'lib id'); - is($lims->sample_id, 1121926, 'sample id'); - is($lims->study_id, 1811, 'study id'); - is($lims->project_id, 810, 'project id'); - is($lims->contains_nonconsented_human, 0, 'does not contain nonconcented human'); - is($lims->contains_nonconsented_xahuman, 0, 'does not contain nonconsented X and autosomal human'); - is($lims->request_id, 3156170, 'request id'); - is($lims->library_name, 'BS_3hrsomuleSm_202790 3033734', 'lib name'); - is($lims->sample_name, 'BS_3hrsomuleSm_202790', 'sample name'); - is($lims->study_name, 'Schistosoma mansoni methylome', 'study name'); - is($lims->project_name, 'Schistosoma mansoni methylome', 'project name'); - is($lims->tag_sequence, undef, 'tag_sequence undefined'); - is($lims->tags, undef, 'tags undefined'); - is($lims->spiked_phix_tag_index, undef, 'spiked phix tag index undefined'); - is($lims->tag_sequence, undef, 'tag_sequence undefined'); - is($lims->seq_qc_state, undef, 'seq qc not set'); - is(scalar $lims->associated_lims, 0, 'no associated lims'); - - my @methods; - lives_ok {@methods = $lims->method_list} 'list of attributes generated'; - foreach my $method (@methods) { - lives_ok {$lims->$method} qq[invoking method or attribute $method does not throw an error]; - } - - is(join(q[ ], $lims->library_names), 'BS_3hrsomuleSm_202790 3033734', 'non-pool lane library_names list'); - is(join(q[ ], $lims->sample_names), 'BS_3hrsomuleSm_202790', 'non-pool lane sample_names list'); - is(join(q[ ], $lims->sample_accession_numbers), 'ERS028649', 'non-pool lane sample_accession_numbers list'); - is(join(q[ ], $lims->study_names), 'Schistosoma mansoni methylome', 'non-pool lane study_names list'); -}; - -subtest 'Priority and seqqc state' => sub { - plan tests => 8; - - my $lims = st::api::lims->new( - %dr, id_run => 6607, batch_id => 12378, position => 2); # non-pool lane - is($lims->seq_qc_state, undef, 'seq qc not set for pending'); - is($lims->lane_priority, 0, 'priority 0'); - $lims = st::api::lims->new( - %dr, id_run => 6607, batch_id => 12378, position => 3); - is($lims->seq_qc_state, 1, 'seq qc 1 for pass'); - is($lims->lane_priority, 1, 'priority 1'); - $lims = st::api::lims->new( - %dr, id_run => 6607, batch_id => 12378, position => 4); - is($lims->seq_qc_state, 0, 'seq qc 0 for fail'); - $lims = st::api::lims->new( - %dr, id_run => 6607, batch_id => 12378, position => 5); - throws_ok {$lims->seq_qc_state} qr/Unexpected value 'some' for seq qc state/, - 'error for unexpected qc state'; - $lims = st::api::lims->new( - %dr, id_run => 6607, batch_id => 12378, position => 5, tag_index => 1); - is($lims->lane_priority, undef, 'priority undefined on plex level'); - $lims = st::api::lims->new(%dr, id_run => 6607, batch_id => 12378); - is($lims->lane_priority, undef, 'priority undefined on batch level'); -}; - -subtest 'Object for a not spiked pool' => sub { - plan tests => 26; - - my $lims = st::api::lims->new( - %dr, id_run => 6607, batch_id => 12378, position => 5); - is($lims->batch_id, 12378, 'batch id for lane 5'); - is($lims->tag_index, undef, 'tag index undefined'); - is($lims->is_control, 0, 'lane 5 is not control'); - is($lims->is_pool, 1, 'lane 5 is pool'); - is($lims->library_id, 3111688, 'lib id'); - is($lims->sample_id, undef, 'sample id undefined'); - is($lims->study_id, 429, 'study id'); - is($lims->project_id, 429, 'project id'); - is($lims->request_id, 3259935, 'request id'); - is($lims->library_name, '3C_HiC_Pool3', 'lib name'); - is($lims->sample_name, undef, 'sample name undefined'); - is($lims->study_name, '3C and HiC of Plasmodium falciparum IT', 'study name'); - my $description = q[Illumina sequencing of chromatin conformation capture and its derivatives is being carried out to study nuclear architecture in antigenically selected lines of Plasmodium falciparum. This data is part of a pre-publication release. For information on the proper use of pre-publication data shared by the Wellcome Trust Sanger Institute (including details of any publication moratoria), please see http://www.sanger.ac.uk/datasharing/]; - is($lims->study_description, $description, 'study description'); - is($lims->project_name, '3C and HiC of Plasmodium falciparum IT', 'project name'); - my $expected_tags = {1=>'ATCACGTT', 2=>'CGATGTTT', 3=>'TTAGGCAT', 4=>'TGACCACT', 5=>'ACAGTGGT', 6=>'GCCAATGT', 7=>'CAGATCTG', - 8 => 'ACTTGATG', 9=>'GATCAGCG',}; - is_deeply($lims->tags, $expected_tags, 'tags mapping'); - is($lims->spiked_phix_tag_index, undef, 'spiked phix tag index undefined'); - is($lims->tag_sequence, undef, 'tag_sequence undefined'); - is($lims->to_string, 'st::api::lims object, driver - xml, batch_id 12378, id_run 6607, position 5', 'object as string'); - - my $libs = 'HIC_M_B15C2 3111683,HiC_H_Dd2 3111680,HiC_H_LT3D7 3111687,HiC_H_OFF_DCJ 3111682,HiC_H_ON_DCJ 3111679,HiC_H_PQP1 3111681,HiC_M_3D7 3111685,HiC_M_ER3D7 3111686,HiC_M_Rev1 3111684'; - my $samples = 'HIC_M_B15C2,HiC_H_Dd2,HiC_H_LT3D7,HiC_H_OFF_DCJ,HiC_H_ON_DCJ,HiC_H_PQP1,HiC_M_3D7,HiC_M_ER3D7,HiC_M_Rev1'; - my $accessions = 'ERS033158,ERS033160,ERS033162,ERS033168,ERS033170,ERS033172,ERS033174,ERS033176,ERS033178'; - my $study = '3C and HiC of Plasmodium falciparum IT'; - is(join(q[,], $lims->library_names), $libs, 'pooled not-spiked lane library_names list'); - is(join(q[,], $lims->sample_names), $samples, 'pooled not-spiked lane sample_names list'); - is(join(q[,], $lims->sample_accession_numbers), $accessions, 'pooled not-spiked lane sample_accession_numbers list'); - is(join(q[,], $lims->study_names), $study, 'pooled not-spiked lane study_names list'); - - my $with_spiked_phix = 0; - is(join(q[,], $lims->library_names($with_spiked_phix)), $libs, 'pooled not-spiked lane library_names list $with_spiked_phix = 0'); - is(join(q[,], $lims->sample_names($with_spiked_phix)), $samples, 'pooled not-spiked lane sample_names list $with_spiked_phix = 0'); - is(join(q[,], $lims->sample_accession_numbers($with_spiked_phix)), $accessions, 'pooled not-spiked lane sample_accession_numbers list $with_spiked_phix = 0'); - is(join(q[,], $lims->study_names($with_spiked_phix)), $study, 'pooled not-spiked lane study_names list $with_spiked_phix = 0'); -}; - -{ - my $lims = st::api::lims->new(%dr, batch_id => 13410, position => 1); - ok(!$lims->is_control, 'lane is not a control (despite having a control tag within its hyb buffer tag)'); -} - -subtest 'Library types' => sub { - plan tests => 6; - - my $lims = st::api::lims->new(%dr, id_run => 6607, batch_id => 12378,); - is($lims->library_type, undef, 'library type undefined on a batch level'); - $lims = st::api::lims->new( - %dr, id_run => 6607, batch_id => 12378, position => 2); # non-pool lane - is($lims->library_type, 'Illumina cDNA protocol', 'library type'); - $lims = st::api::lims->new( - %dr, id_run => 6607, batch_id => 12378, position => 5); - is($lims->library_type, undef, 'library type undefined for a pool'); - $lims = st::api::lims->new( - %dr, id_run => 6607, batch_id => 12378, position => 5, tag_index => 0); - is($lims->library_type, undef, 'library type undefined for tag 0'); - $lims = st::api::lims->new( - %dr, id_run => 6607, batch_id => 12378, position => 5, tag_index => 1); - is($lims->library_type, 'Custom', 'library type'); - $lims = st::api::lims->new( - %dr, id_run => 6607, batch_id => 12378, position => 6, tag_index => 8); - is($lims->library_type, 'Standard', 'library type'); -}; - -subtest 'Unconcented human and xahuman' => sub { - plan tests => 11; - - local $ENV{NPG_WEBSERVICE_CACHE_DIR} = 't/data/npg_api'; - - my $lims = st::api::lims->new(%dr, batch_id => 1536, position => 5); - ok(!$lims->is_pool, 'lane is not a pool'); - is($lims->contains_nonconsented_human, 1, 'contains nonconsented human'); - is($lims->contains_unconsented_human, 1, 'contains unconsented human (back compat)'); - - $lims = st::api::lims->new(%dr, batch_id => 13861, position => 2); - ok($lims->is_pool, 'lane is a pool'); - ok($lims->contains_nonconsented_human, 'pool contains unconsented human'); - - $lims = st::api::lims->new( - %dr, batch_id => 13861, position => 2, tag_index => 0); - ok($lims->contains_nonconsented_human, 'tag 0 contains unconsented human'); - - local $ENV{NPG_WEBSERVICE_CACHE_DIR} = 't/data/st_api_lims_new'; - - $lims = st::api::lims->new(%dr, id_run => 8260, batch_id => 17763); - is($lims->contains_nonconsented_xahuman, 0, - 'run does contain nonconsented X and autosomal human does not propagate to run level'); - - $lims = st::api::lims->new( - %dr, id_run => 8260, batch_id => 17763, position => 2); - is($lims->contains_nonconsented_xahuman, 0, 'lane 2 does not contain nonconsented X and autosomal human'); - $lims = st::api::lims->new( - %dr, id_run => 8260, batch_id => 17763, position => 8); - is($lims->contains_nonconsented_xahuman, 1, 'lane 8 does contain nonconsented X and autosomal human'); - $lims = st::api::lims->new( - %dr, id_run => 8260, batch_id => 17763, position => 2, tag_index => 33); - is($lims->contains_nonconsented_xahuman, 0, 'plex 33 lane 2 does not contain nonconsented X and autosomal human'); - $lims = st::api::lims->new( - %dr, id_run => 8260, batch_id => 17763, position => 8, tag_index => 57); - is($lims->contains_nonconsented_xahuman, 1, 'plex 57 lane 8 does contain nonconsented X and autosomal human'); -}; - -subtest 'Bait name' => sub { - plan tests => 11; - - local $ENV{NPG_WEBSERVICE_CACHE_DIR} = 't/data/npg_api'; - my $lims = st::api::lims->new(%dr, batch_id => 16442); - is($lims->bait_name, undef, 'bait name undefined on a batch level'); - $lims = st::api::lims->new(%dr, batch_id => 16442, position => 1); - is($lims->bait_name, undef, 'bait name undefined on a pool level'); - $lims = st::api::lims->new( - %dr, batch_id => 16442, position => 1, tag_index=> 2); - is($lims->bait_name,'Human all exon 50MB', 'bait name for a plex'); - $lims = st::api::lims->new( - %dr, batch_id => 16442, position => 1, tag_index=> 3); - is($lims->bait_name,'Fox bait', 'bait name for another plex'); - $lims = st::api::lims->new( - %dr, batch_id => 16442, position => 8, tag_index=> 5); - is($lims->bait_name,'Mouse some exon', 'bait name for yet another plex'); - $lims = st::api::lims->new( - %dr, batch_id => 16442, position => 1, tag_index=> 4); - is($lims->bait_name, undef, 'bait name undefined if no bait element'); - $lims = st::api::lims->new( - %dr, batch_id => 16442, position => 1, tag_index=> 5); - is($lims->bait_name, undef, 'bait name undefined if no bait name tag is empty'); - $lims = st::api::lims->new( - %dr, batch_id => 16442, position => 1, tag_index=> 168); - is($lims->bait_name, undef, 'bait name undefined for hyp buffer'); - - $lims = st::api::lims->new(%dr, batch_id => 3022, position => 1); - is($lims->bait_name,'Mouse all exon', 'bait name for a non-pool lane'); - $lims = st::api::lims->new(%dr, batch_id => 3022, position => 2); - is($lims->bait_name, undef, 'bait name undefined for a non-pool lane if there is no bait element'); - $lims = st::api::lims->new(%dr, batch_id => 3022, position => 4); - is($lims->bait_name, undef, 'bait name undefined for a control lane despite the presence of the bait element'); -}; - -subtest 'Study attributes' => sub { - plan tests => 11; - - local $ENV{NPG_WEBSERVICE_CACHE_DIR} = 't/data/st_api_lims_new'; - - my $lims = st::api::lims->new(%dr, batch_id=>17763, position=>1,tag_index=>1); - is( $lims->study_title(), 'hifi test', q{study title} ); - is( $lims->study_name(), 'Kapa HiFi test', 'study name'); - is( $lims->study_accession_number(), undef, q{no study accession obtained} ); - is( $lims->study_publishable_name(), q{hifi test}, q{study title returned as publishable name} ); - - $lims = st::api::lims->new(%dr, batch_id=>17763, position=>1,tag_index=>2); - ok(! $lims->alignments_in_bam, 'no alignments in BAM when false in corresponding XML in study'); - is( $lims->study_title(), 'Genetic variation in Kuusamo', q{study title obtained} ); - is( $lims->study_accession_number(), 'EGAS00001000020', q{study accession obtained} ); - is( $lims->study_publishable_name(), 'EGAS00001000020', q{accession returned as study publishable name} ); - is( $lims->sample_publishable_name(), q{ERS003242}, q{sample publishable name returns accession} ); - ok(! $lims->separate_y_chromosome_data, 'do not separate y chromosome data'); - - $lims = st::api::lims->new(%dr, batch_id => 22061, position =>1, tag_index=>66); - ok($lims->separate_y_chromosome_data, 'separate y chromosome data'); -}; - -subtest 'Tag sequence and library type from sample description' => sub { - plan tests => 15; - - my $sample_description = 'AB GO (grandmother) of the MGH meiotic cross. The same DNA was split into three aliquots (of which this'; - is(st::api::lims::_tag_sequence_from_sample_description($sample_description), undef, q{tag undefined for a description containing characters in round brackets} ); - $sample_description = "3' end enriched mRNA from morphologically abnormal embryos from dag1 knockout incross 3. A 6 base indexing sequence (GTAGAC) is bases 5 to 11 of read 1 followed by polyT. More information describing the mutant phenotype can be found at the Wellcome Trust Sanger Institute Zebrafish Mutation Project website http://www.sanger.ac.uk/cgi-bin/Projects/D_rerio/zmp/search.pl?q=zmp_phD"; - is(st::api::lims::_tag_sequence_from_sample_description($sample_description), q{GTAGAC}, q{correct tag from a complex description} ); - $sample_description = "^M"; - is(st::api::lims::_tag_sequence_from_sample_description($sample_description), undef, q{tag undefined for a description with carriage return} ); - - local $ENV{NPG_WEBSERVICE_CACHE_DIR} = 't/data/tag_from_sample_description'; - #diag q[Tests for deducing tags from batch 19158 (associated with run 3905 by hand)]; - my $lims8 = st::api::lims->new(%dr, batch_id => 19158, position => 8); - my @alims8 = $lims8->associated_lims; - is(scalar @alims8, 7, 'Found 7 plexes in position 8'); - - my @tags = $lims8->tags(); - is(scalar @tags, 1, 'Found 1 tags array'); - - cmp_ok($tags[0]->{5}, q(ne), q(ACAGTGGT), 'Do not use expected_sequence sequence for tag'); - cmp_ok($tags[0]->{5}, q(eq), q(GTAGAC), 'Use sample_description sequence for tag'); - - my $lims1 = st::api::lims->new(%dr, batch_id => 19158, position => 1); - my @alims1 = $lims1->associated_lims; - is(scalar @alims1, 6, 'Found 6 plexes in position 1'); - - my @tags1 = $lims1->tags(); - is(scalar @tags1, 1, 'Found 1 tags array'); - - cmp_ok($tags1[0]->{144}, q(eq), q(CCTGAGCA), 'Use expected_sequence sequence for tag'); - - my $lims85 = st::api::lims->new( - %dr, batch_id => 19158, position => 8, tag_index => 5); - is($lims85->library_type, '3 prime poly-A pulldown', 'library type'); - is($lims85->tag_sequence, 'GTAGAC', 'plex tag sequence from sample description'); - ok($lims85->sample_description =~ /end enriched mRNA/sm, 'sample description available'); - - my $lims1144 = st::api::lims->new( - %dr, batch_id => 19158, position => 1, tag_index => 144); - isnt($lims1144->library_type, '3 prime poly-A pulldown', 'library type'); - is($lims1144->tag_sequence, 'CCTGAGCA', 'plex tag sequence directly from batch xml'); -}; - -subtest 'Inline index' => sub { - plan tests => 14; - - my $lims = st::api::lims->new( - %dr, id_run=>10638, batch_id=>22829, position=>5); - is ($lims->id_run(), 10638, "Found the run"); - my @children = $lims->children(); - isnt (scalar @children, 0, "We have children"); - is($lims->inline_index_exists,1,'Found an inline index'); - is($lims->inline_index_start,7,'found correct inline index start'); - is($lims->inline_index_end,12,'found correct inline index end'); - is($lims->inline_index_read,2,'found correct inline index read'); - is($lims->tag_sequence,undef,'tag sequence undefined for lane level'); - - $lims = st::api::lims->new( - %dr, id_run=>10638, batch_id=>22829, position=>6); - is ($lims->id_run(), 10638, "Found the run"); - @children = $lims->children(); - isnt (scalar @children, 0, "We have children"); - is($lims->inline_index_exists,1,'Found an inline index'); - is($lims->inline_index_start,6,'found correct inline index start'); - is($lims->inline_index_end,10,'found correct inline index end'); - is($lims->inline_index_read,1,'found correct inline index read'); - is($lims->tag_sequence,undef,'tag sequence undefined for lane level'); -}; - subtest 'Run-level object via samplesheet driver' => sub { plan tests => 36; @@ -806,42 +192,31 @@ subtest 'Run-level object via samplesheet driver' => sub { }; subtest 'Lane-level object via samplesheet driver' => sub { - plan tests => 16; + plan tests => 14; my $path = 't/data/samplesheet/miseq_default.csv'; lives_ok {st::api::lims->new(id_run => 10262, position =>2, path => $path, driver_type => 'samplesheet')} 'no error instantiation an object for a non-existing lane'; throws_ok {st::api::lims->new(id_run => 10262, position =>2, path => $path, driver_type => 'samplesheet')->library_id} qr/Position 2 not defined in/, 'error invoking a driver method on an object for a non-existing lane'; - lives_ok {st::api::lims->new(id_run => 10262, position =>2, driver_type => 'samplesheet')} 'no error instantiation an object without path'; - throws_ok {st::api::lims->new(id_run => 10262, position =>2, driver_type => 'samplesheet')->library_id} - qr/Attribute \(path\) does not pass the type constraint/, 'error invoking a driver method on an object with path undefined'; # NPG_CACHED_SAMPLESHEET_FILE is unset - - my $nopath = join q[/], tempdir( CLEANUP => 1 ), 'xxx'; - throws_ok {st::api::lims->new(id_run => 10262, path => $nopath, position =>2, driver_type => 'samplesheet')->library_id} - qr/Validation failed for 'NpgTrackingReadableFile'/, 'error invoking a driver method on an object with non-existing path'; - - { - local $ENV{NPG_CACHED_SAMPLESHEET_FILE} = $path; - - my $ss=st::api::lims->new(id_run => 10262, position =>1, driver_type => 'samplesheet'); - is ($ss->path, $path, 'samplesheet path captured from NPG_CACHED_SAMPLESHEET_FILE') or diag explain $ss; - is ($ss->position, 1, 'correct position'); - is ($ss->is_pool, 1, 'lane is a pool'); - is ($ss->library_id, undef, 'pool lane library_id undefined'); - is (scalar $ss->children, 96, '96 plexes returned'); - } - - my $ss=st::api::lims->new(id_run => 10262, position =>1, tag_index => 0, path => $path, driver_type => 'samplesheet'); + my $ss=st::api::lims->new(id_run => 10262, position =>1, tag_index => 0, path => $path); is (scalar $ss->children, 96, '96 children returned for tag zero'); is ($ss->is_pool, 1, 'tag zero is a pool'); is ($ss->library_id, undef, 'tag_zero library_id undefined'); is ($ss->default_tag_sequence, undef, 'default tag sequence undefined'); is ($ss->tag_sequence, undef, 'tag sequence undefined'); is ($ss->purpose, undef, 'purpose'); + + local $ENV{NPG_CACHED_SAMPLESHEET_FILE} = $path; + $ss=st::api::lims->new(id_run => 10262, position =>1); + is ($ss->path, $path, 'samplesheet path captured from NPG_CACHED_SAMPLESHEET_FILE') or diag explain $ss; + is ($ss->position, 1, 'correct position'); + is ($ss->is_pool, 1, 'lane is a pool'); + is ($ss->library_id, undef, 'pool lane library_id undefined'); + is (scalar $ss->children, 96, '96 plexes returned'); }; subtest 'Plex-level object via samplesheet driver' => sub { @@ -959,75 +334,7 @@ subtest 'Samplesheet driver for arbitrary compositions' => sub { is ($ss->tag_index, 4, 'correct tag_index'); }; -subtest 'Instantiating a samplesheet driver' => sub { - plan tests => 16; - - my $ss_path = 't/data/samplesheet/miseq_default.csv'; - local $ENV{NPG_CACHED_SAMPLESHEET_FILE} = $ss_path; - my $l; - lives_ok {$l = st::api::lims->new(id_run => 10262,)} - 'no error creating an object with samplesheet file defined in env var'; - is ($l->driver_type, 'samplesheet', 'driver type is built as samplesheet'); - is ($l->path, $ss_path, 'correct path is built'); - is (ref $l->driver, 'st::api::lims::samplesheet', 'correct driver object type'); - is ($l->driver->path, $ss_path, 'correct path assigned to the driver object'); - - local $ENV{NPG_CACHED_SAMPLESHEET_FILE} = 't/data/samplesheet'; - ok (-d $ENV{NPG_CACHED_SAMPLESHEET_FILE}); - lives_ok {$l = st::api::lims->new(id_run => 10262,)} - 'no error creating an object with samplesheet file defined in env var'; - is ($l->driver_type, 'samplesheet', 'driver type is samplesheet'); - throws_ok { $l->path } - qr/Attribute \(path\) does not pass the type constraint/, - 'samplesheet cannot be a directory'; - - local $ENV{NPG_CACHED_SAMPLESHEET_FILE} = 't/data/samplesheet/non-existing'; - ok (not -e $ENV{NPG_CACHED_SAMPLESHEET_FILE}); - lives_ok {$l = st::api::lims->new(id_run => 10262,)} - 'no error creating an object with samplesheet file defined in env var'; - is ($l->driver_type, 'samplesheet', 'driver type is samplesheet'); - throws_ok {$l->children} - qr/Attribute \(path\) does not pass the type constraint/, - 'samplesheet file should exist'; - - local $ENV{NPG_CACHED_SAMPLESHEET_FILE} = 't/data/samplesheet/non-existing'; - lives_ok {$l = st::api::lims->new(id_run => 10262, path => $ss_path)} - 'no error creating an object with samplesheet file defined in env var and path given'; - is ($l->driver_type, 'samplesheet', 'driver type is samplesheet'); - lives_ok {$l->children} 'given path takes precedence'; -}; - -subtest 'Dual index' => sub { - plan tests => 16; - - local $ENV{NPG_CACHED_SAMPLESHEET_FILE} = 't/data/samplesheet/dual_index_extended.csv'; - my $l = st::api::lims->new(id_run => 6946); - my @lanes = $l->children; - is (scalar @lanes, 2, 'two lanes'); - my @plexes = $lanes[0]->children; - is (scalar @plexes, 3, 'three samples in lane 1'); - my $plex = $plexes[0]; - is($plex->default_tag_sequence, 'CGATGTTT', 'first index'); - is($plex->default_tagtwo_sequence, 'AAAAAAAA', 'second index'); - is($plex->tag_sequence, 'CGATGTTTAAAAAAAA', 'combined tag sequence'); - $plex = $plexes[2]; - is($plex->default_tag_sequence, 'TGACCACT', 'first index'); - is($plex->default_tagtwo_sequence, 'AAAAAAAA', 'second index'); - is($plex->tag_sequence, 'TGACCACTAAAAAAAA', 'combined tag sequence'); - @plexes = $lanes[1]->children; - is (scalar @plexes, 3, 'three samples in lane 2'); - $plex = $plexes[0]; - is($plex->default_tag_sequence, 'GCTAACTC', 'first index'); - is($plex->default_tagtwo_sequence, 'GGGGGGGG', 'second index'); - is($plex->tag_sequence, 'GCTAACTCGGGGGGGG', 'combined tag sequence'); - $plex = $plexes[2]; - is($plex->default_tag_sequence, 'GTCTTGGC', 'first index'); - is($plex->default_tagtwo_sequence, 'GGGGGGGG', 'second index'); - is($plex->tag_sequence, 'GTCTTGGCGGGGGGGG', 'combined tag sequence'); - is($plex->purpose, 'standard', 'purpose'); -}; - -subtest 'aggregation across lanes for pools' => sub { +subtest 'Aggregation across lanes for pools' => sub { plan tests => 85; local $ENV{NPG_CACHED_SAMPLESHEET_FILE} = 't/data/test40_lims/samplesheet_novaseq4lanes.csv'; @@ -1205,7 +512,7 @@ subtest 'aggregation across lanes for pools' => sub { 'sample names including spiked phix'); }; -subtest 'aggregation across lanes for non-pools' => sub { +subtest 'Aggregation across lanes for non-pools' => sub { plan tests => 13; local $ENV{NPG_CACHED_SAMPLESHEET_FILE} = 't/data/test40_lims/samplesheet_rapidrun_nopool.csv'; @@ -1240,27 +547,7 @@ subtest 'aggregation across lanes for non-pools' => sub { } }; -subtest 'creating tag zero object' => sub { - plan tests => 4; - - local $ENV{NPG_CACHED_SAMPLESHEET_FILE} = 't/data/test40_lims/samplesheet_novaseq4lanes.csv'; - - my $l = st::api::lims->new(id_run => 25846); - throws_ok { $l->create_tag_zero_object() } qr/Position should be defined/, - 'method cannot be called on run-level object'; - $l = st::api::lims->new(rpt_list => '25846:2:1'); - throws_ok { $l->create_tag_zero_object() } qr/Position should be defined/, - 'method cannot be called on an object for a composition'; - - my $description = 'st::api::lims object, driver - samplesheet, id_run 25846, ' . - 'path t/data/test40_lims/samplesheet_novaseq4lanes.csv, position 3, tag_index 0'; - $l = st::api::lims->new(id_run => 25846, position => 3); - is ($l->create_tag_zero_object()->to_string(), $description, 'created from lane-level object'); - $l = st::api::lims->new(id_run => 25846, position => 3, tag_index => 5); - is ($l->create_tag_zero_object()->to_string(), $description, 'created from plex-level object'); -}; - -subtest 'creating lane object' => sub { +subtest 'Aggregation across lanes for a tag' => sub { plan tests => 13; local $ENV{NPG_CACHED_SAMPLESHEET_FILE} = 't/data/test40_lims/samplesheet_novaseq4lanes.csv'; @@ -1283,4 +570,54 @@ subtest 'creating lane object' => sub { } }; +subtest 'Creating tag zero object' => sub { + plan tests => 4; + + local $ENV{NPG_CACHED_SAMPLESHEET_FILE} = 't/data/test40_lims/samplesheet_novaseq4lanes.csv'; + + my $l = st::api::lims->new(id_run => 25846); + throws_ok { $l->create_tag_zero_object() } qr/Position should be defined/, + 'method cannot be called on run-level object'; + $l = st::api::lims->new(rpt_list => '25846:2:1'); + throws_ok { $l->create_tag_zero_object() } qr/Position should be defined/, + 'method cannot be called on an object for a composition'; + + my $description = 'st::api::lims object, driver - samplesheet, id_run 25846, ' . + 'path t/data/test40_lims/samplesheet_novaseq4lanes.csv, position 3, tag_index 0'; + $l = st::api::lims->new(id_run => 25846, position => 3); + is ($l->create_tag_zero_object()->to_string(), $description, 'created from lane-level object'); + $l = st::api::lims->new(id_run => 25846, position => 3, tag_index => 5); + is ($l->create_tag_zero_object()->to_string(), $description, 'created from plex-level object'); +}; + +subtest 'Dual index' => sub { + plan tests => 16; + + local $ENV{NPG_CACHED_SAMPLESHEET_FILE} = 't/data/samplesheet/dual_index_extended.csv'; + my $l = st::api::lims->new(id_run => 6946); + my @lanes = $l->children; + is (scalar @lanes, 2, 'two lanes'); + my @plexes = $lanes[0]->children; + is (scalar @plexes, 3, 'three samples in lane 1'); + my $plex = $plexes[0]; + is($plex->default_tag_sequence, 'CGATGTTT', 'first index'); + is($plex->default_tagtwo_sequence, 'AAAAAAAA', 'second index'); + is($plex->tag_sequence, 'CGATGTTTAAAAAAAA', 'combined tag sequence'); + $plex = $plexes[2]; + is($plex->default_tag_sequence, 'TGACCACT', 'first index'); + is($plex->default_tagtwo_sequence, 'AAAAAAAA', 'second index'); + is($plex->tag_sequence, 'TGACCACTAAAAAAAA', 'combined tag sequence'); + @plexes = $lanes[1]->children; + is (scalar @plexes, 3, 'three samples in lane 2'); + $plex = $plexes[0]; + is($plex->default_tag_sequence, 'GCTAACTC', 'first index'); + is($plex->default_tagtwo_sequence, 'GGGGGGGG', 'second index'); + is($plex->tag_sequence, 'GCTAACTCGGGGGGGG', 'combined tag sequence'); + $plex = $plexes[2]; + is($plex->default_tag_sequence, 'GTCTTGGC', 'first index'); + is($plex->default_tagtwo_sequence, 'GGGGGGGG', 'second index'); + is($plex->tag_sequence, 'GTCTTGGCGGGGGGGG', 'combined tag sequence'); + is($plex->purpose, 'standard', 'purpose'); +}; + 1; diff --git a/t/45-st-api-lims-traversal.t b/t/45-st-api-lims-traversal.t deleted file mode 100644 index 981d50a0..00000000 --- a/t/45-st-api-lims-traversal.t +++ /dev/null @@ -1,111 +0,0 @@ -use strict; -use warnings; -use Test::More tests => 41; -use Test::Deep; -use Test::Exception; -use Try::Tiny; - -sub _positions { - my @lims = @_; - my @positions = (); - foreach my $lims (@lims) { - if (!defined $lims->tag_index) { - push @positions, $lims->position; - } - } - return sort @positions; -} - -use_ok('st::api::lims'); - -foreach my $pa ((['using mocked data', q[t/data/test45], 'xml'])) -{ - my $do_test = 1; - my $reason = q[]; - my $driver = $pa->[2]; - my $test_data_dir = $pa->[1]; - diag($pa->[0], ", $driver driver"); - local $ENV{NPG_WEBSERVICE_CACHE_DIR} = $test_data_dir; - my $lfield = 'batch_id'; - - { - my $lims = st::api::lims->new($lfield => 4775, driver_type => $driver); - isa_ok($lims, 'st::api::lims', 'lims isa'); - my @alims = $lims->associated_lims; - is(scalar @alims, 8, '8 associated lims objects'); - my @positions = _positions(@alims); - is(scalar @positions, 8, '8 lanes in a batch'); - is(join(q[ ],@positions), '1 2 3 4 5 6 7 8', 'all positions'); - - my $lims1 = st::api::lims->new($lfield => 4775, position => 1, driver_type => $driver); - is($lims1->is_control, 0, 'first st lane has no control'); - is($lims1->is_pool, 0, 'first st lane has no pool'); - is(scalar $lims1->associated_lims, 0, 'no associated lims for a lane'); - cmp_ok($lims1->library_id, q(==), 57440, 'lib id from first st lane'); - my $expected_name = $driver eq 'xml' ? 'PD3918a 1' : '57440'; - cmp_ok($lims1->library_name, q(eq), $expected_name, 'lib name from first st lane'); - - my $insert_size; - lives_ok {$insert_size = $lims1->required_insert_size} 'insert size for the first lane'; - is (keys %{$insert_size}, 1, 'one entry in the insert size hash'); - is ($insert_size->{$lims1->library_id}->{q[from]}, 300, 'required FROM insert size'); - is ($insert_size->{$lims1->library_id}->{q[to]}, 400, 'required TO insert size'); - - ok(!$lims1->sample_consent_withdrawn(), 'sample consent not withdrawn'); - ok(!$lims1->any_sample_consent_withdrawn(), 'not any sample consent withdrawn'); - - my $lims4 = st::api::lims->new($lfield => 4775, position => 4, driver_type => $driver); - is($lims4->is_control, 1, 'first st lane has control'); - is($lims4->is_pool, 0, 'first st lane has no pool'); - cmp_ok($lims4->library_id, q(==), 79577, 'control id from fourth st lane'); - if ($driver eq 'xml') { - cmp_ok($lims4->library_name, q(eq), 'phiX CT1462-2 1', 'control name from fourth st lane'); - } else { - cmp_ok($lims4->library_name, q(==), 79577, 'control library id from fourth st lane'); - } - cmp_ok($lims4->sample_id, q(==), 9836, 'sample id from fourth st lane'); - ok(!$lims4->study_id, 'study id from fourth st lane undef'); - ok(!$lims4->project_id, 'project id from fourth st lane undef'); - my $request_id = $lims4->request_id; - $request_id ||= 0; - my $expected_request_id = $driver eq 'xml' ? 43779 : 0; - cmp_ok($request_id, q(==), $expected_request_id, 'request id from fourth st lane'); - is_deeply($lims4->required_insert_size, {}, 'no insert size for control lane'); - - my $lims6 = st::api::lims->new($lfield => 4775, position => 6, driver_type => $driver); - is($lims6->study_id, 333, 'study id'); - cmp_ok($lims6->study_name, q(eq), q(CLL whole genome), 'study name'); - - cmp_bag($lims6->email_addresses,[qw(dg10@sanger.ac.uk las@sanger.ac.uk pc8@sanger.ac.uk sm2@sanger.ac.uk)],'All email addresses'); - cmp_bag($lims6->email_addresses_of_managers,[qw(sm2@sanger.ac.uk)],'Managers email addresses'); - is_deeply($lims6->email_addresses_of_followers,[qw(dg10@sanger.ac.uk las@sanger.ac.uk pc8@sanger.ac.uk)],'Followers email addresses'); - is_deeply($lims6->email_addresses_of_owners,[qw(sm2@sanger.ac.uk)],'Owners email addresses'); - - is($lims6->alignments_in_bam, 1,'do bam alignments'); - - my $lims7 = st::api::lims->new($lfield => 16249, position => 1, driver_type => $driver); - is($lims7->reference_genome, 'Homo_sapiens (1000Genomes)', - 'reference genome when common for whole pool'); - is($lims7->bait_name, 'Human all exon 50MB', 'bait name when common for whole pool'); - $lims7 = st::api::lims->new($lfield => 16249, position => 1, tag_index => 2, driver_type => $driver); - is($lims7->bait_name, 'Human all exon 50MB', 'bait name for a plex'); - $lims7 = st::api::lims->new($lfield => 16249, position => 1, tag_index => 168, driver_type => $driver); - is($lims7->bait_name, undef, 'bait name undefined for spiked phix plex'); - - $lims7 = st::api::lims->new($lfield => 16249, position => 1, tag_index => 0, driver_type => $driver); - is($lims7->reference_genome, 'Homo_sapiens (1000Genomes)', - 'tag zero reference genome when common for whole pool'); - my $lims8 = st::api::lims->new($lfield =>15728, position=>2, tag_index=>3, driver_type => $driver); - ok( $lims8->sample_consent_withdrawn(), 'sample 1299723 consent withdrawn' ); - ok( $lims8->any_sample_consent_withdrawn(), 'any sample (1299723) consent withdrawn' ); - - my $lims9 = st::api::lims->new($lfield =>15728, position=>2, tag_index=>0, driver_type => $driver); - ok( $lims9->any_sample_consent_withdrawn(), 'any sample consent withdrawn' ); - - my $lims10 = st::api::lims->new($lfield =>43500, position=>1, tag_index=>1, driver_type => $driver); - is($lims10->purpose,'standard','Purpose'); - - } -} - -1;