Fixed driver details propagation in create_lane_object method

wtsi-npg · Jan 2, 2024 · c892195 · c892195
1 parent 68fc045
commit c892195
Show file tree

Hide file tree

Showing 2 changed files with 67 additions and 30 deletions.
diff --git a/lib/st/api/lims.pm b/lib/st/api/lims.pm
@@ -1129,13 +1129,12 @@ attributes. The new object has the same driver settings as the original object.
 sub create_lane_object {
   my ($self, $id_run, $position) = @_;
   ($id_run and $position) or croak 'id_run and position are expected as arguments';
-  my %init = %{$self->_driver_arguments()};
-  $init{'driver_type'} = $self->driver_type;
-  delete $init{'tag_index'};
-  delete $init{'rpt_list'};
-  $init{'id_run'}   = $id_run;
-  $init{'position'} = $position;
-  return __PACKAGE__->new(%init);
+  my $init = $self->copy_init_args();
+  delete $init->{'tag_index'};
+  delete $init->{'rpt_list'};
+  $init->{'id_run'}   = $id_run;
+  $init->{'position'} = $position;
+  return __PACKAGE__->new(%{$init});
 }
 
 =head2 cached_samplesheet_var_name

diff --git a/t/40-st-lims-merge.t b/t/40-st-lims-merge.t
@@ -12,6 +12,67 @@ use_ok('st::api::lims');
 
 my $tmp_dir = tempdir( CLEANUP => 1 );
 
+my $class = Moose::Meta::Class->create_anon_class(roles=>[qw/npg_testing::db/]);
+my $schema_wh = $class->new_object({})->create_test_db(
+  q[WTSI::DNAP::Warehouse::Schema], q[t/data/fixtures_lims_wh]
+);
+
+subtest 'Lane object from plex object' => sub {
+  plan tests => 25;
+
+  local $ENV{NPG_CACHED_SAMPLESHEET_FILE} = 't/data/test40_lims/samplesheet_novaseq4lanes.csv';
+
+  my $l = st::api::lims->new(rpt_list => '25846:1:1;25846:2:1');
+
+  my $e = qr/id_run and position are expected as arguments/;
+  throws_ok { $l->create_lane_object() } $e, 'no arguments - error';
+  throws_ok { $l->create_lane_object(1) } $e, 'one argument - error';
+  throws_ok { $l->create_lane_object(1, 0) } $e,
+    'one of argument is false - error';
+
+  for my $p ((1,2)) {
+    my $lane_l = $l->create_lane_object(25846, $p);
+    is ($lane_l->id_run, 25846, 'run id is 25846');
+    is ($lane_l->position, $p, "position is $p");
+    is ($lane_l->rpt_list, undef, 'rpt_list is undefined');
+    is ($lane_l->tag_index, undef, 'tag index is undefined');
+    ok ($lane_l->is_pool, 'the entity is a pool');
+  }
+
+  local $ENV{NPG_CACHED_SAMPLESHEET_FILE} = q[];
+
+  my $id_run = 47995;
+  my @objects = ();
+  push @objects,  st::api::lims->new(
+    id_run           => $id_run,
+    position         => 1,
+    tag_index        => 1,
+    id_flowcell_lims => 98292,
+    driver_type      => 'ml_warehouse',
+    mlwh_schema      => $schema_wh,
+  );
+
+  $l = st::api::lims->new(
+    id_run           => $id_run,
+    id_flowcell_lims => 98292,
+    driver_type      => 'ml_warehouse',
+    mlwh_schema      => $schema_wh,
+  );
+  $l = ($l->children())[0];
+  push @objects, ($l->children())[0];
+
+  for my $l_obj (@objects) { 
+    my $lane = $l_obj->create_lane_object($id_run, 2);
+    is ($lane->driver->mlwh_schema, $schema_wh,
+      'the original db connection is retained');
+    is ($lane->id_run, $id_run, "run id is $id_run");
+    is ($lane->position, 2, "position is 2");
+    is ($lane->rpt_list, undef, 'rpt_list is undefined');
+    is ($lane->tag_index, undef, 'tag index is undefined');
+    ok ($lane->is_pool, 'the entity is a pool');
+  }
+};
+
 subtest 'Aggregation across lanes for pools' => sub {
   plan tests => 82;
 
@@ -133,29 +194,6 @@ subtest 'Aggregation across lanes for non-pools' => sub {
   _compare_properties_2($l);
 };
 
-subtest 'Aggregation across lanes for a tag' => sub {
-  plan tests => 13;
-
-  local $ENV{NPG_CACHED_SAMPLESHEET_FILE} = 't/data/test40_lims/samplesheet_novaseq4lanes.csv';
-
-  my $l = st::api::lims->new(rpt_list => '25846:1:1;25846:2:1');
-
-  my $e = qr/id_run and position are expected as arguments/;
-  throws_ok { $l->create_lane_object() } $e, 'no arguments - error';
-  throws_ok { $l->create_lane_object(1) } $e, 'one argument - error';
-  throws_ok { $l->create_lane_object(1, 0) } $e,
-    'one of argument is false - error';
-
-  for my $p ((1,2)) {
-    my $lane_l = $l->create_lane_object(25846, $p);
-    is ($lane_l->id_run, 25846, 'run id is 25846');
-    is ($lane_l->position, $p, "position is $p");
-    is ($lane_l->rpt_list, undef, 'rpt_list is undefined');
-    is ($lane_l->tag_index, undef, 'tag index is undefined');
-    ok ($lane_l->is_pool, 'the entity is a pool');
-  }
-};
-
 subtest 'Error conditions in aggregation by library' => sub {
   plan tests => 4;