lib/CXGN/Stock/StockTemplate.pm

   1
   2 package CXGN::Stock::StockTemplate;
   3
   4
   5 =head1 NAME
   6
   7 CXGN::Stock::StockTemplate - an object to handle SGN stock data uploaded from a spreadsheet template
   8
   9 =head1 USAGE
  10
  11  my $sbt = CXGN::Stock::Stocktemplate->new({ schema => $schema} );
  12
  13
  14 =head1 DESCRIPTION
  15
  16
  17 =head1 AUTHORS
  18
  19  Naama Menda (nm249@cornell.edu)
  20
  21 =cut
  22
  23 use strict;
  24 use warnings;
  25 use Moose;
  26 use Bio::Chado::Schema;
  27 use Try::Tiny;
  28 use Digest::MD5;
  29 use File::Basename qw | basename dirname|;
  30 use Spreadsheet::ParseExcel;
  31 use SGN::Model::Cvterm;
  32
  33
  34 has 'schema' => (
  35     is  => 'rw',
  36     isa =>  'DBIx::Class::Schema',
  37     );
  38
  39 has 'metadata_schema' => (
  40     is  => 'rw',
  41     isa =>  'DBIx::Class::Schema',
  42     );
  43
  44 has 'phenome_schema' => (
  45     is  => 'rw',
  46     isa =>  'DBIx::Class::Schema',
  47     );
  48
  49 has 'parsed_data' => (
  50     is => 'rw'
  51     );
  52
  53 has 'parsed_header' => (
  54     is => 'rw'
  55     );
  56
  57 has 'parse_errors' => (
  58     is => 'rw'
  59     );
  60
  61 has 'verify_errors' => (
  62     is => 'rw'
  63     );
  64
  65 has 'warnings' => (
  66     is => 'rw'
  67     );
  68
  69 has 'store_error' => (
  70     is => 'rw'
  71     );
  72
  73 has 'store_message' => (
  74     is => 'rw'
  75     );
  76
  77 has 'filename' => (
  78     is => 'rw',
  79     isa => 'Str',
  80     );
  81
  82 has 'tmp_filename' => (
  83     is => 'rw',
  84     isa => 'Str',
  85     );
  86
  87 has 'user_id' => (
  88     is => 'rw',
  89     isa => 'Int',
  90     );
  91
  92
  93 sub parse {
  94 ################################
  95     my $self = shift;
  96     my @errors;
  97     my ($file , $metadata, $identifier_prefix, $db_name ) = @_;
  98     my $hashref; #hashref of hashrefs for storing the uploaded data , to be used for checking the fields
  99     my %header_hash;
 100
 101 #Expected format:
 102 #A. Spreadsheet identifier: B. $spreadsheet_unique_id
 103 #A. trial name B. $name
 104 #A. $trial_description
 105 #A. plants per plot: B. $plants_per_plot
 106 #A. Operator: B. $operator (user input)
 107 #A. Date: B. $date (user input)
 108 #G... $trait_name [units]
 109 #1.. A. $row_number B. $clone_name C. $block D. $plot_id E. $rep F. $number_of_surviving_plants G. $trait_ontology_id
 110
 111     my $parser   = Spreadsheet::ParseExcel->new();
 112     my $workbook = $parser->parse($file); # $file is an Excel file
 113     if ( !defined $workbook ) {
 114         push @errors,  $parser->error();
 115         $self->parse_errors(\@errors);
 116         #die;
 117         return;
 118     }
 119     my $worksheet = ( $workbook->worksheets() )[0]; #support only one worksheet
 120     my ( $row_min, $row_max ) = $worksheet->row_range();
 121     my ( $col_min, $col_max ) = $worksheet->col_range();
 122     print STDERR "$row_min $row_max $col_min $col_max \n";
 123     if ($col_max < 2 || $row_max < 8 ) {#must have header and at least one row of phenotypes
 124       push @errors, "Spreadsheet is missing header";
 125       $self->parse_errors(\@errors);
 126       return;
 127     }
 128     #hash for column headers
 129     my %headers;
 130     #metadata is stored in rows 1..6
 131     my $spreadsheet_id  = $worksheet->get_cell(0,1);
 132     my $trial_name      = $worksheet->get_cell(1,1);
 133     my $trial_desc      = $worksheet->get_cell(2,0);
 134     my $plants_per_plot = $worksheet->get_cell(3,1);
 135     my $operator        = $worksheet->get_cell(4,1);
 136     my $date            = $worksheet->get_cell(5,1);
 137     if (!$spreadsheet_id) {
 138       push @errors, "Spreadsheet ID is missing from the header";
 139     }
 140     if (!$trial_name) {
 141       push @errors, "Trial name is missing from the header";
 142     }
 143     #add function to check that the trial name exists?
 144     if (!$operator) {
 145       push @errors, "The name of the operator is missing from the header";
 146     }
 147     #add function to check if the operator name exists in the database and matches the logged in user?
 148     if (!$date) {
 149       push @errors, "The date is missing from the header";
 150     }
 151     #add a check to make sure that the header data is valid?
 152     if (@errors) {
 153       $self->parse_errors(\@errors);
 154       return;
 155     }
 156     $header_hash{'operator'} = $operator;
 157     $header_hash{'trial_name'} = $trial_name;
 158
 159     # Row #7 can be skipped, as it contains trait names just for human readability
 160 #    for my $row ( 8 .. $row_max ) {
 161     for my $col ( $col_min .. $col_max ) {
 162         my $cell;
 163         $cell = $worksheet->get_cell( 7, $col );
 164         next unless $cell;
 165         my $value  =  $cell->value() ;
 166         my $unformatted_value = $cell->unformatted() ;
 167         ## read the header row, make a hash of names to column numbers, then in the data rows, get_cell($row, $col_for_header{'SomeHeader'})
 168         $headers{$value} = $col;
 169         print STDERR "cell value: $value\n";
 170     }
 171     for my $row ( 8 .. $row_max ) { # phenotypes should be from row 9 and on
 172         # got the row number, now look at the column headers
 173         my $plot_stock_id =  $worksheet->get_cell ($row , $headers{'PLOT'} )->value();
 174         my $replicate = $worksheet->get_cell ($row , $headers{'REP'})->value();
 175         my $clone_name = $worksheet->get_cell ($row , $headers{'DESIG'})->value();
 176         my $block = $worksheet->get_cell ($row , $headers{'BLOCK'})->value();
 177         my $planted_plants = $worksheet->get_cell ($row , $headers{'NOPLT'})->value();
 178         my $surv_plants = $worksheet->get_cell ($row , $headers{'NOSV'})->value;
 179         foreach my $header (keys %headers) {
 180               print STDERR "header loop header: $header\n";
 181             if ($header =~ m/^CO_\d\{1-4\}:\d{7}/ ) {
 182               print STDERR "has header: $header row: $row col: ".$headers{$header}."\n";
 183               my $value = $worksheet->get_cell( $row , $headers{$header} )->value();
 184               print STDERR "has value: $value\n";
 185                 ## remove spaces
 186                 $value =~ s/^\s+//;
 187                 $value =~ s/\s+$//;
 188                 ###
 189                 my ($full_accession, $full_unit ) = split(/\|/, $header); # do we support units in a spreadsheet upload?
 190                 my ($value_type, $unit_value) = split(/\:/, $full_unit);
 191                 my ($db_name, $accession) = split (/\:/ , $full_accession);
 192                 #print STDERR "db_name = '$db_name' sp_accession = '$sp_accession'\n";
 193                 next() if (!$accession);
 194                 ####################
 195                 #skip non-numeric values
 196                 if ($value !~ /^\d/) {
 197                     if ($value eq "\." ) { next; }
 198                     print STDERR "measurement:  $value \n";
 199                     #push @errors,  "** Found non-numeric value in column $header (value = '" . $value ."') Row = $row.";
 200                     next;
 201                 }
 202                 #####################
 203                 $hashref->{join("\t", $spreadsheet_id, $operator, $date, $row) }->{$plot_stock_id}->{$full_accession}->{replicate} = $replicate;
 204                 $hashref->{join("\t", $spreadsheet_id, $operator, $date, $row) }->{$plot_stock_id}->{$full_accession}->{block} = $block;
 205                 $hashref->{join("\t", $spreadsheet_id, $operator, $date, $row) }->{$plot_stock_id}->{$full_accession}->{planted_plants} = $planted_plants;
 206                 $hashref->{join("\t", $spreadsheet_id, $operator, $date, $row) }->{$plot_stock_id}->{$full_accession}->{surviving_plants} = $surv_plants;
 207                 $hashref->{join("\t", $spreadsheet_id, $operator, $date, $row) }->{$plot_stock_id}->{$full_accession}->{value} = $value;
 208                 print STDERR "Accession: $full_accession Replicate: $replicate Block: $block\n";
 209             }
 210         }
 211     }
 212     ##unique#  PLOT REP  DESIG  BLOCK NOPLT NOSV CO_334:0000010 CO_334:0000099|scale:cassavabase  CO_334:0000018|unit:cm   CO_334:0000039|date:1MAP
 213 ###########
 214 #################################
 215     #my ($op_name, $project_id, $location_id, $stock_id, $cvterm_accession, $value, $date, $count);
 216     $self->parsed_data($hashref);
 217     $self->parsed_header(\%header_hash);
 218     if (scalar(@errors) >= 1) {
 219       $self->parse_errors(\@errors);
 220       print STDERR "More than one parse error\n";
 221     }
 222 }
 223
 224 sub verify {
 225     my $self = shift;
 226     my $schema = $self->schema;
 227     #check is stock exists and if cvterm exists.
 228     #print error only if stocks do not exist and the cvterms
 229     my $hashref = $self->parsed_data;
 230     my @errors;
 231     my @verify;
 232     my @warnings;
 233     foreach my $key (keys %$hashref) {
 234         ##$hashref->{join("\t", $spreadsheet_id, $operator, $date, $row) }->{$plot_stock_id}->{$cvterm_accession}->{replicate} = $replicate;
 235         my ($spreadsheet_id, $operator, $date, $row) = split(/\t/, $key);
 236         print STDERR "***** verify found key $key !!!!!!!\n\n";
 237         print STDERR "verify :  ... . . . .spreadsheet = $spreadsheet_id, operator = $operator, date = $date, row = $row \n\n";
 238         ###
 239         foreach my $plot_stock_id (keys %{$hashref->{$key} } ) {
 240             #check if the stock exists
 241             print STDERR "verify .. Looking for stock_id ".$plot_stock_id."\n";
 242             my $stock;
 243             $stock = $schema->resultset("Stock::Stock")->find( { stock_id => $plot_stock_id } );
 244             if (!$stock) { push @errors, "Stock $plot_stock_id does not exist in the database!"; }
 245             foreach my $cvterm_accession (keys %{$hashref->{$key}->{$plot_stock_id} } ) {
 246                 print STDERR "verify ... Looking for accession $cvterm_accession..\n";
 247                 my ($db_name, $accession) = split (/:/, $cvterm_accession);
 248                 if (!$db_name) { push @errors, "could not find valid db_name in accession $cvterm_accession";}
 249                 if (!$accession) { push @errors, "Could not find valid cvterm accession in $cvterm_accession";}
 250                 #check if the cvterm exists
 251                 my $db = $schema->resultset("General::Db")->search(
 252                     { 'me.name' => $db_name } );
 253                 if ($db->count) {
 254                     my $dbxref = $db->search_related('dbxrefs', { accession => $accession } );
 255
 256                     if ($dbxref->count) {
 257                         my $cvterm = $dbxref->search_related("cvterm", {} )->single;
 258                         if (!$cvterm) { push @errors, "NO cvterm found in the database for accession $cvterm_accession!\n db_name = '" .  $db_name  . "' , accession = '" .  $accession . "'";
 259                         }
 260                     } else {
 261                         push @errors, "No dbxref found for cvterm accession $accession";
 262                     }
 263                 } else {
 264                     push @errors , "db_name $db_name does not exist in the database!";
 265                 }
 266             }
 267         }
 268     }
 269     $self->warnings(\@warnings);
 270     foreach my $err (@errors) {
 271         print STDERR " *!*!*!error = $err\n";
 272     }
 273     if (scalar(@errors) >= 1) {
 274       $self->verify_errors(\@errors);
 275     }
 276 }
 277
 278 sub store {
 279     my $self = shift;
 280     my $schema = $self->schema;
 281     my $metadata_schema = $self->metadata_schema;
 282     my $phenome_schema = $self->phenome_schema;
 283     my $hashref = $self->parsed_data;
 284     my $filename = $self->filename();
 285     my $user_id = $self->user_id();
 286
 287     my $message;
 288
 289     my $coderef = sub {
 290       open(my $F, "<", $self->tmp_filename()) || die "Can't open file ".$self->filename();
 291       binmode $F;
 292       my $md5 = Digest::MD5->new();
 293       $md5->addfile($F);
 294       close($F);
 295
 296       my $md_row = $metadata_schema->resultset("MdMetadata")->create({
 297           create_person_id => $user_id,
 298                                                                      });
 299       $md_row->insert();
 300
 301       my $file_row = $metadata_schema->resultset("MdFiles")->create({
 302           basename => basename($self->filename()),
 303           dirname => dirname($self->filename()),
 304           filetype => 'phenotype spreadsheet upload xls',
 305           md5checksum => $md5->hexdigest(),
 306           metadata_id => $md_row->metadata_id(),
 307                                                                     });
 308       $file_row->insert();
 309
 310
 311       print STDERR "\nFile id: ".$file_row->file_id()."\n";
 312
 313
 314
 315
 316
 317
 318
 319
 320
 321
 322       # find the cvterm for a phenotyping experiment
 323       my $pheno_cvterm = SGN::Model::Cvterm->get_cvterm_row($schema, 'phenotyping_experiment', 'experiment_type');
 324
 325       print STDERR " ***store: phenotyping experiment cvterm = " . $pheno_cvterm->cvterm_id . "\n";
 326       ##################
 327       #This has to be stored in the database when adding a new project for these plots
 328       my $field_layout_experiment = 'field_layout'; #############################
 329       ################
 330       foreach my $key (keys %$hashref) {
 331         my ($spreadsheet_id, $operator, $date, $row) = split(/\t/, $key);
 332         foreach my $plot_stock_id (keys %{$hashref->{$key} } ) {
 333           print STDERR " *** store: loading information for stock $plot_stock_id \n";
 334           foreach my $cvterm_accession (keys %{$hashref->{$key}->{$plot_stock_id} } ) {
 335             print STDERR " ** store: cvterm_accession = $cvterm_accession\n";
 336             my $replicate = $hashref->{$key}->{$plot_stock_id}->{$cvterm_accession}->{replicate};
 337             my $block = $hashref->{$key}->{$plot_stock_id}->{$cvterm_accession}->{block};
 338             my $planted_plants = $hashref->{$key}->{$plot_stock_id}->{$cvterm_accession}->{planted_plants};
 339             my $surviving_plants = $hashref->{$key}->{$plot_stock_id}->{$cvterm_accession}->{surviving_plants};
 340             my $value = $hashref->{$key}->{$plot_stock_id}->{$cvterm_accession}->{value};
 341
 342             print STDERR " ** store: value = $value\n";
 343             my ($db_name, $accession) = split (/:/, $cvterm_accession);
 344             my $db = $schema->resultset("General::Db")->search(
 345                                                                {
 346                                                                 'me.name' => $db_name, } );
 347             print STDERR " ** store: found db $db_name , accession = $accession \n";
 348             if ($db) {
 349               my $dbxref = $db->search_related("dbxrefs", { accession => $accession, });
 350               if ($dbxref) {
 351                 my $cvterm = $dbxref->search_related("cvterm")->single;
 352                 #now get the value and store the whole thing in the database!
 353                 my $stock = $self->schema->resultset("Stock::Stock")->find( { stock_id => $plot_stock_id});
 354                 my $stock_name = $stock->name;
 355                 ################
 356                 my $field_exp = $stock->search_related('nd_experiment_stocks')->search_related('nd_experiment')->find({'type.name' => $field_layout_experiment },{ join => 'type' });
 357                 my $location_id = $field_exp->nd_geolocation_id;
 358                 my $project = $field_exp->nd_experiment_projects->single ; #there should be one project linked with the field experiment
 359                 my $project_id = $project->project_id;
 360
 361                 ###store a new nd_experiment. One phenotyping experiment per upload
 362                 #find if a phenotyping experiment exists for this location
 363                 my $experiment = $schema->resultset('NaturalDiversity::NdExperiment')->find(
 364                                                                                             {
 365                                                                                              nd_geolocation_id => $location_id,
 366                                                                                              type_id => $pheno_cvterm->cvterm_id(),
 367                                                                                             } );
 368                 my ($op_prop, $date_prop);
 369                 ## Find if the experiment has the date and person of this upload, if yes, use the existing one, if no, create a new nd_experiment
 370                 if ($experiment) {
 371                   $op_prop = $experiment->search_related(
 372                                                          'nd_experimentprops' , {
 373                                                                                  'type.name' => 'operator',
 374                                                                                  value       => $operator,
 375                                                                                 },
 376                                                          {
 377                                                           join => 'type' }
 378                                                         )->single;
 379                   $date_prop = $experiment->search_related(
 380                                                            'nd_experimentprops' , {
 381                                                                                    'type.name' => 'date',
 382                                                                                    value       => $date,
 383                                                                                   },
 384                                                            {
 385                                                             join => 'type' }
 386                                                           )->single;
 387                 }
 388                 # Create a new experiment, if one does not exist
 389                 # or ff operator and date are not linked with the existing experiment
 390                 if ( !($op_prop && $date_prop) || !$experiment ) {
 391                   $experiment = $schema->resultset('NaturalDiversity::NdExperiment')->find(
 392                                                                                            {
 393                                                                                             nd_geolocation_id => $location_id,
 394                                                                                             type_id => $pheno_cvterm->cvterm_id(),
 395                                                                                            } );
 396                   print STDERR " ** store: created new experiment " . $experiment->nd_experiment_id . "\n";
 397                   $experiment->create_nd_experimentprops(
 398                       {
 399                           date => $date } ,
 400                       {
 401                           autocreate => 1 , cv_name => 'local' }
 402                       );
 403                   $experiment->create_nd_experimentprops(
 404                       {
 405                           operator => $operator } ,
 406                       {
 407                           autocreate => 1 , cv_name => 'local' }
 408                       );
 409                 }
 410                 ##
 411                 #link the experiment to the project
 412                 $experiment->find_or_create_related('nd_experiment_projects', {
 413                     project_id => $project_id
 414                                                     } );
 415                 print STDERR " ** store: linking experiment " . $experiment->nd_experiment_id . " with project $project_id \n";
 416                 #link the experiment to the stock
 417                 $experiment->find_or_create_related('nd_experiment_stocks' , {
 418                     stock_id => $plot_stock_id,
 419                     type_id  =>  $pheno_cvterm->cvterm_id,
 420                                                     });
 421                 print STDERR " ** store: linking experiment " . $experiment->nd_experiment_id . " to stock $plot_stock_id \n";
 422                 my $uniquename = "Stock: " . $plot_stock_id . ", trait: " . $cvterm->name . " date: $date" . "  operator = $operator" ;
 423                 my $phenotype = $cvterm->find_or_create_related(
 424                     "phenotype_cvalues", {
 425                         observable_id => $cvterm->cvterm_id,
 426                         value => $value ,
 427                         uniquename => $uniquename,
 428                     });
 429                 print STDERR " ** store: added phenotype value $value , observable = " . $cvterm->name ." uniquename = $uniquename \n";
 430                 #link the phenotpe to the experiment
 431                 $experiment->find_or_create_related('nd_experiment_phenotypes' , {
 432                     phenotype_id => $phenotype->phenotype_id });
 433                 $message .= "Added phenotype: trait= " . $cvterm->name . ", value = $value, to stock " . qq|<a href="/stock/$plot_stock_id/view">$stock_name</a><br />| ;
 434
 435                 #link the file to the experiment
 436                 #$experiment->find_or_create_related('nd_experiment_md_files',{file_id => $file_row->file_id(),});
 437                 my $experiment_files = $phenome_schema->resultset("NdExperimentMdFiles")->create({
 438                     nd_experiment_id => $experiment->nd_experiment_id(),
 439                     file_id => $file_row->file_id(),
 440                                                                                                  });
 441                 $experiment_files->insert();
 442
 443               }
 444             }
 445           }
 446         }
 447       }
 448
 449
 450     };
 451     my $error;
 452     print "STDERR coderef: $coderef\n";
 453     print "STDERR schema: $schema\n";
 454     try {
 455       $schema->txn_do($coderef);
 456     } catch {
 457       # Transaction failed
 458       $error =  "An error occured! Cannot store data! <br />" . $_ . "\n";
 459     };
 460
 461     if ($error) {
 462       $self->store_error($error);
 463     } else {
 464       #############
 465     }
 466
 467
 468     if ($message) {
 469       $self->store_message($message);
 470     }
 471
 472
 473
 474   }
 475
 476 ###
 477 1;                              #
 478 ###