diff --git a/lib/st/api/lims.pm b/lib/st/api/lims.pm index e0e7a2f8..e8367094 100644 --- a/lib/st/api/lims.pm +++ b/lib/st/api/lims.pm @@ -167,7 +167,6 @@ sub BUILD { my %dargs=(); my %pargs=(); my %primary_arg_type = map {$_ => 1} @{$METHODS_PER_CATEGORY{'primary'}}; - my $driver_class=$self->_driver_package_name; foreach my$k (grep {defined && $_ !~ /^_/smx} map{ $_->has_init_arg ? $_->init_arg : $_->name} @@ -198,6 +197,28 @@ sub BUILD { return; } +=head2 copy_init_args + +Returns a hash reference that can be used to initialise st::api::lims +objects similar to this object. The driver details, if present in this +object, are returned under the 'driver_type' key and, if relevant, +'mlwh_schema' key. + +=cut +sub copy_init_args { + my $self = shift; + + my %init = %{$self->_driver_arguments()}; + if ($self->driver_type()) { + $init{'driver_type'} = $self->driver_type(); + if (!$init{'mlwh_schema'} && $init{'driver_type'} =~ /warehouse/smx) { + $init{'mlwh_schema'} = $self->driver()->mlwh_schema; + } + } + + return \%init; +} + # Mapping of LIMS object types to attributes for which methods are to # be generated. These generated methods are 'plural' methods which # return an array of that attributes e.g. $lims->library_ids (returns @@ -724,7 +745,7 @@ sub _build__cached_children { my $self = shift; my @children = (); - my @basic_attrs = qw/id_run position tag_index/; + my @basic_attrs = @{$METHODS_PER_CATEGORY{'primary'}}; my $driver_type = $self->driver_type; if ($self->driver) { @@ -760,7 +781,9 @@ sub _build__cached_children { my %init = %{$self->_driver_arguments()}; $init{'driver_type'} = $driver_type; foreach my $attr (@basic_attrs) { - $init{$attr} = $component->$attr; + if ($component->can($attr)) { + $init{$attr} = $component->$attr; + } } push @children, __PACKAGE__->new(\%init); } @@ -874,9 +897,8 @@ sub aggregate_xlanes { return; }; # End of test function - my %init = %{$self->_driver_arguments()}; - $init{'driver_type'} = $self->driver_type; - delete $init{'id_run'}; + my $init = $self->copy_init_args(); + delete $init->{'id_run'}; my $lims4compisitions = {}; my @test_attrs = qw/sample_id library_id/; @@ -885,7 +907,7 @@ sub aggregate_xlanes { if (!@pools) { $can_merge->(\@lanes, @test_attrs); # Test consistency - push @aggregated, __PACKAGE__->new(%init, rpt_list => $lanes_rpt_list); + push @aggregated, __PACKAGE__->new(%{$init}, rpt_list => $lanes_rpt_list); } else { my @sizes = uniq (map { $_->num_children } @lanes); if (@sizes != 1) { # Test consistency @@ -902,11 +924,11 @@ sub aggregate_xlanes { my $ea = each_arrayref map { [$_->children()] } @lanes; while ( my @plexes = $ea->() ) { $can_merge->(\@plexes, @test_attrs, 'tag_index'); # Test consistency - push @aggregated, __PACKAGE__->new(%init, + push @aggregated, __PACKAGE__->new(%{$init}, rpt_list => npg_tracking::glossary::rpt->deflate_rpts(\@plexes)); } # Add object for tag zero - push @aggregated, __PACKAGE__->new(%init, + push @aggregated, __PACKAGE__->new(%{$init}, rpt_list => npg_tracking::glossary::rpt->tag_zero_rpt_list($lanes_rpt_list)); } @@ -953,7 +975,7 @@ This method can be used both as instance and as a class method. =cut -sub aggregate_libraries() { +sub aggregate_libraries { my ($self, $lane_lims_array) = @_; # This restriction might be lifted in future. @@ -975,9 +997,9 @@ sub aggregate_libraries() { # to create objects for merged entities. # Do not use $self for copying the driver arguments in order to retain # ability to use this method as a class method. - my %init = %{$lane_lims_array->[0]->_driver_arguments()}; - delete $init{position}; - delete $init{id_run}; + my $init = $lane_lims_array->[0]->copy_init_args(); + delete $init->{position}; + delete $init->{id_run}; my $merges = {}; my $lane_set_delim = q[,]; @@ -1005,7 +1027,7 @@ sub aggregate_libraries() { ->new(rpt_list => $rpt_list)->create_composition() ->freeze2rpt(); $merges->{$lane_set}->{$tag_index} = __PACKAGE__->new( - %init, rpt_list => $rpt_list + %{$init}, rpt_list => $rpt_list ); } } @@ -1045,7 +1067,7 @@ sub aggregate_libraries() { return $all_lims_objects; } -sub _check_merge_correctness{ +sub _check_merge_correctness { my $lib_lims = shift; my @lanes = uniq map {$_->position} @{$lib_lims}; if (@lanes != @{$lib_lims}) { @@ -1069,7 +1091,7 @@ sub _check_value_is_unique { =head2 create_tag_zero_object -Using id_run and position values of this object, creates and returns +Using run ID and position values of this object, creates and returns st::api::lims object for tag zero. The new object has the same driver settings as the original object. @@ -1086,10 +1108,9 @@ sub create_tag_zero_object { if (!defined $self->position) { croak 'Position should be defined'; } - my %init = %{$self->_driver_arguments()}; - $init{'driver_type'} = $self->driver_type; - $init{'tag_index'} = 0; - return __PACKAGE__->new(%init); + my $init = $self->copy_init_args(); + $init->{'tag_index'} = 0; + return __PACKAGE__->new(%{$init}); } =head2 create_lane_object @@ -1106,13 +1127,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 index 78f8cf8c..4fd4aa7c 100644 --- a/t/40-st-lims-merge.t +++ b/t/40-st-lims-merge.t @@ -1,20 +1,139 @@ use strict; use warnings; -use Test::More tests => 9; +use Test::More tests => 11; use Test::Exception; use List::MoreUtils qw/all none/; use File::Slurp; use File::Temp qw/tempdir/; +use Moose::Meta::Class; use_ok('npg_tracking::glossary::rpt'); 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 'Create 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'; + + my $test_lane = sub { + my ($lane_l, $id_run, $position) = @_; + is ($lane_l->id_run, $id_run, "run id is $id_run"); + is ($lane_l->position, $position, "position is $position"); + 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'); + }; + + for my $p ((1,2)) { + my $lane = $l->create_lane_object(25846, $p); + $test_lane->($lane, 25846, $p); + } + + 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'); + $test_lane->($lane, $id_run, 2); + } +}; + +subtest 'Create tag zero object' => sub { + plan tests => 10; + + 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 tag zero object 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 tag zero object from plex-level object'); + + 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, + 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 $t0 = $l_obj->create_tag_zero_object(); + is ($t0->driver->mlwh_schema, $schema_wh, + 'the original db connection is retained'); + my @names = $t0->sample_names(); + is (@names, 18, '18 sample names are retrieved'); + is ($names[0], '6751STDY13219539', 'first sample name is correct'); + } +}; + subtest 'Aggregation across lanes for pools' => sub { - plan tests => 82; + plan tests => 89; - local $ENV{NPG_CACHED_SAMPLESHEET_FILE} = 't/data/test40_lims/samplesheet_novaseq4lanes.csv'; + local $ENV{NPG_CACHED_SAMPLESHEET_FILE} = + 't/data/test40_lims/samplesheet_novaseq4lanes.csv'; my $l = st::api::lims->new(rpt_list => '25846:1:3'); throws_ok { $l->aggregate_xlanes() } qr/Not run-level object/, @@ -117,6 +236,35 @@ subtest 'Aggregation across lanes for pools' => sub { 'sample names including spiked phix'); is (join(q[:], $tag_zero->sample_names(1)), join(q[:], @sample_names), 'sample names including spiked phix'); + + local $ENV{NPG_CACHED_SAMPLESHEET_FILE} = q[]; + + my $id_run = 47995; + $l = st::api::lims->new( + id_run => $id_run, + id_flowcell_lims => 98292, + driver_type => 'ml_warehouse', + mlwh_schema => $schema_wh, + ); + + @merged = $l->aggregate_xlanes(qw/1 2/); + is (scalar @merged, 19, 'number of aggregates is number of tags plus two'); + $tag_zero = pop @merged; + $tag_spiked = pop @merged; + $tag_last = pop @merged; + $tag_first = shift @merged; + is ($tag_zero->rpt_list, "$id_run:1:0;$id_run:2:0", + 'rpt list for tag zero object'); + my @tag_zero_sample_names = $tag_zero->sample_names(); + is (@tag_zero_sample_names, 18, '18 sample names are retrieved'); + is ($tag_zero_sample_names[0], '6751STDY13219539', + 'first sample name is correct'); + is ($tag_spiked->rpt_list, "$id_run:1:888;$id_run:2:888", + 'rpt list for spiked in tag object'); + is ($tag_last->rpt_list, "$id_run:1:17;$id_run:2:17", + 'rpt list for tag 21 object'); + is ($tag_first->rpt_list, "$id_run:1:1;$id_run:2:1", + 'rpt list for tag 1 object'); }; subtest 'Aggregation across lanes for non-pools' => sub { @@ -132,29 +280,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; @@ -367,6 +492,32 @@ subtest 'Multiple lane sets in aggregation by library' => sub { 'merges list - correct object, correct sort order'); }; +subtest 'mlwarehouse driver in aggregation by library' => sub { + plan tests => 5; + + 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] + ); + + my $id_run = 47995; + my @lane_lims = st::api::lims->new( + id_run => $id_run, + id_flowcell_lims => 98292, + driver_type => 'ml_warehouse', + mlwh_schema => $schema_wh, + )->children(); + my $lims = st::api::lims->aggregate_libraries(\@lane_lims); + # Test that lims objects are viable, ie it is possible to retrieve + # their properties. + is (@{$lims->{'singles'}}, 8, 'list of singles contains 8 objects'); + lives_ok { $lims->{'singles'}->[0]->sample_name } 'can retrieve sample name'; + is (@{$lims->{'merges'}}, 87, 'list of merges contains 87 objects'); + lives_ok { $lims->{'merges'}->[0]->sample_name } 'can retrieve sample name'; + lives_ok { $lims->{'merges'}->[86]->sample_name } 'can retrieve sample name'; +}; + + sub _generate_rpt_lists { my ($id_run, $positions, $tag_indexes) = @_; my @expected_rpt_lists = (); diff --git a/t/40-st-lims-mlwarehouse.t b/t/40-st-lims-mlwarehouse.t index 483421fa..7bddaf15 100644 --- a/t/40-st-lims-mlwarehouse.t +++ b/t/40-st-lims-mlwarehouse.t @@ -1,6 +1,6 @@ use strict; use warnings; -use Test::More tests => 6; +use Test::More tests => 7; use Test::Exception; use_ok('st::api::lims'); @@ -164,4 +164,29 @@ subtest 'sample controls' => sub { } }; +subtest 'using rpt_list argument' => sub { + plan tests => 14; + + my $lims = st::api::lims->new( + rpt_list => '47995:1:3;47995:2:3', + id_flowcell_lims => 98292, + driver_type => 'ml_warehouse', + mlwh_schema => $schema_wh, + ); + my $sample_name = '6751STDY13219555'; + is ($lims->sample_name, $sample_name, 'correct sample name'); + my @children = $lims->children(); + is (@children, 2, 'two child objects'); + for my $i ((0, 1)) { + my $child = $children[$i]; + is ($child->driver_type, 'ml_warehouse', 'child driver type is correct'); + is ($child->driver->mlwh_schema, $schema_wh, + q[child's driver is using the original db connection]); + is ($child->id_run, 47995, 'child run is is correct'); + is ($child->tag_index, 3, 'child tag index is is correct'); + is ($child->position, $i+1, 'child position is is correct'); + is ($child->sample_name, $sample_name, 'child sample name is correct'); + } +}; + 1; diff --git a/t/40-st-lims.t b/t/40-st-lims.t index 242f5662..b2c9f61d 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 => 16; +use Test::More tests => 15; use Test::Exception; use Test::Warn; use Moose::Meta::Class; @@ -342,26 +342,6 @@ subtest 'Samplesheet driver for arbitrary compositions' => sub { is ($ss->tag_index, 4, 'correct tag_index'); }; -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;