bin/swap_sample_wells.pl

   1
   2 =head1 NAME
   3
   4 swap_sample_wells.pl - a script to swap samples in genotyping plates
   5
   6 =head1 DESCRIPTION
   7
   8 perl swap_sample_wells.pl -h host -D database [-t] -f file -p PW
   9
  10 The file should have the following columns, tab delimited, no header:
  11
  12 sample_stock_uniquename   old_well   new_well
  13
  14 Example:
  15
  16 iita-mas-ng-me-0011_G11 G11     H12
  17 ...
  18
  19 The script will try to change the well location in the uniquename as well as the properties col_number, row_number, and plot_number (which contains the well location, such as H12)
  20
  21 =head1 AUTHORS
  22
  23 Lukas Mueller and Guillaume Bauchet
  24
  25 =cut
  26
  27
  28
  29 use strict;
  30
  31 use Getopt::Std;
  32 use DBI;
  33 use Bio::Chado::Schema;
  34 use SGN::Model::Cvterm;
  35
  36 our ($opt_H, $opt_D, $opt_p, $opt_f, $opt_t);
  37 getopts('H:D:p:f:t');
  38
  39 my $pw = $opt_p;
  40 chomp($pw);
  41
  42 print STDERR "Connecting to database...\n";
  43 my $dsn = 'dbi:Pg:database='.$opt_D.";host=".$opt_H.";port=5432";
  44
  45 my $dbh = DBI->connect($dsn, "postgres", $pw);
  46
  47 print STDERR "Connecting to DBI schema...\n";
  48 my $schema = Bio::Chado::Schema->connect($dsn, "postgres", $pw);
  49
  50
  51 my $file = $opt_f;
  52
  53 open(my $F, "<", $file) || die "Can't open file $file.\n";
  54
  55 my $guard = $schema->txn_scope_guard();
  56
  57 my $col_number = SGN::Model::Cvterm->get_cvterm_row($schema, 'col_number', 'stock_property')->cvterm_id();
  58 my $row_number = SGN::Model::Cvterm->get_cvterm_row($schema, 'row_number', 'stock_property')->cvterm_id();
  59 my $plot_number = SGN::Model::Cvterm-> get_cvterm_row($schema,'plot number', 'stock_property')->cvterm_id();
  60 my $tissue_sample = SGN::Model::Cvterm->get_cvterm_row($schema, 'tissue_sample', 'stock_type')->cvterm_id();
  61
  62 while (<$F>) {
  63     chomp;
  64     my($sample_stock_id, $old_well, $new_well) = split /\t/;
  65
  66     print STDERR "Working on sample '$sample_stock_id'...\n";
  67
  68     my $old_row = $old_well;
  69     $old_row =~ s/(\w).*/$1/;
  70
  71     my $old_col = $old_well;
  72     $old_col =~ s/.*(\d+)/$1/;
  73
  74     my $new_row = $new_well;
  75     $new_row =~ s/(\w).*/$1/;
  76
  77     my $new_col = $new_well;
  78     $new_col =~ s/.*(\d+)/$1/;
  79
  80     my $rs = $schema->resultset("Stock::Stock")->search( { uniquename => $sample_stock_id });
  81
  82     if ($rs->count() < 1) {
  83         print STDERR "Sample $sample_stock_id does not exist! Skipping...\n";
  84         next();
  85     }
  86     elsif ($rs->count() > 1) {
  87         print STDERR "Warning! Several samples named $sample_stock_id exist in the database!\n";
  88     }
  89
  90     my $row = $rs->next();
  91     my $uniquename = $row->uniquename();
  92     my $old_uniquename = $uniquename;
  93     my $stock_id = $row->stock_id();
  94
  95     print STDERR "Fixing stock name...\n";
  96
  97     print STDERR "Old uniquename: $uniquename\n";
  98     $uniquename =~ s/$old_well/\_N\_$new_well/;
  99
 100
 101     print STDERR "New uniquename: $uniquename\n";
 102     $row->update( { uniquename => $uniquename, name => $uniquename });
 103
 104
 105     print STDERR "Fixing col location...\n";
 106
 107     $rs = $schema->resultset("Stock::Stockprop")->search( { stock_id => $stock_id, type_id => $col_number, value => $old_col });
 108
 109     if ($rs->count() > 1) {
 110         print STDERR "More than one col number associated with sample $old_uniquename\n";
 111     }
 112     elsif ($rs->count() < 1) {
 113         print STDERR  "No col number $old_col associated with sample $old_uniquename\n";
 114     }
 115     else {
 116         $row = $rs->next();
 117
 118         $row->update( { value => $new_col });
 119     }
 120
 121     print STDERR "Fixing row number...\n";
 122      $rs = $schema->resultset("Stock::Stockprop")->search( { stock_id => $stock_id, type_id => $row_number, value => $old_row });
 123
 124     if ($rs->count() > 1) {
 125         print STDERR "More than one row number associated with sample $old_uniquename\n";
 126     }
 127     elsif ($rs->count() < 1) {
 128         print STDERR  "No row number $old_row associated with sample $old_uniquename\n";
 129     }
 130
 131     else {
 132         $row = $rs->next();
 133
 134         $row->update( { value => $new_row});
 135     }
 136     print STDERR "Fixing well number...\n";
 137
 138     $rs = $schema->resultset("Stock::Stockprop")->search( { stock_id => $stock_id, type_id => $plot_number, value => $old_well });
 139
 140
 141     if ($rs->count() > 1) {
 142         die "More than one well number associated with sample $old_uniquename\n";
 143     }
 144     elsif ($rs->count() < 1) {
 145         die "No well number $old_well associated with sample $old_uniquename\n";
 146     }
 147
 148     $row = $rs->next();
 149
 150     $row->update( { value => $new_well });
 151
 152     print STDERR "Moved sample $old_uniquename ($old_well, $old_row, $old_col) to new location $uniquename ($new_well, $new_row, $new_col).\n\n";
 153 }
 154
 155 print STDERR "Committing changes... ";
 156
 157 if (!$opt_t ) { $guard->commit();}
 158 else { $guard->rollback(); }
 159
 160 print STDERR "Done!\n";
 161
 162
 163
 164
 165