lib/SGN/Controller/AJAX/Cross.pm

   1
   2 =head1 NAME
   3
   4 SGN::Controller::AJAX::Cross - a REST controller class to provide the
   5 functions for adding crosses
   6
   7 =head1 DESCRIPTION
   8
   9 Add a new cross or upload a file containing crosses to add
  10
  11 =head1 AUTHOR
  12
  13 Jeremy Edwards <jde22@cornell.edu>
  14 Lukas Mueller <lam87@cornell.edu>
  15
  16 =cut
  17
  18 package SGN::Controller::AJAX::Cross;
  19
  20 use Moose;
  21 use Try::Tiny;
  22 use DateTime;
  23 use Time::HiRes qw(time);
  24 use POSIX qw(strftime);
  25 use Data::Dumper;
  26 use File::Basename qw | basename dirname|;
  27 use File::Copy;
  28 use File::Slurp;
  29 use File::Spec::Functions;
  30 use Digest::MD5;
  31 use List::MoreUtils qw /any /;
  32 use Bio::GeneticRelationships::Pedigree;
  33 use Bio::GeneticRelationships::Individual;
  34 use CXGN::UploadFile;
  35 use CXGN::Pedigree::AddCrossingtrial;
  36 use CXGN::Pedigree::AddCrosses;
  37 use CXGN::Pedigree::AddProgeny;
  38 use CXGN::Pedigree::AddCrossInfo;
  39 use CXGN::Pedigree::AddPopulations;
  40 use CXGN::Pedigree::ParseUpload;
  41 use CXGN::Trial::Folder;
  42 use CXGN::Trial::TrialLayout;
  43 use Carp;
  44 use File::Path qw(make_path);
  45 use File::Spec::Functions qw / catfile catdir/;
  46 use CXGN::Cross;
  47 use JSON;
  48 use Tie::UrlEncoder; our(%urlencode);
  49 use LWP::UserAgent;
  50 use HTML::Entities;
  51 use URI::Encode qw(uri_encode uri_decode);
  52
  53 BEGIN { extends 'Catalyst::Controller::REST' }
  54
  55 __PACKAGE__->config(
  56     default   => 'application/json',
  57     stash_key => 'rest',
  58     map       => { 'application/json' => 'JSON', 'text/html' => 'JSON' },
  59 );
  60
  61 sub upload_cross_file : Path('/ajax/cross/upload_crosses_file') : ActionClass('REST') { }
  62
  63 sub upload_cross_file_POST : Args(0) {
  64     my ($self, $c) = @_;
  65     my $chado_schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
  66     my $metadata_schema = $c->dbic_schema("CXGN::Metadata::Schema");
  67     my $phenome_schema = $c->dbic_schema("CXGN::Phenome::Schema");
  68     my $dbh = $c->dbc->dbh;
  69     my $crossing_trial_id = $c->req->param('cross_upload_crossing_trial');
  70     my $location = $c->req->param('cross_upload_location');
  71     my $crosses_simple_upload = $c->req->upload('xls_crosses_simple_file');
  72     my $crosses_plots_upload = $c->req->upload('xls_crosses_plots_file');
  73     my $crosses_plants_upload = $c->req->upload('xls_crosses_plants_file');
  74     my $upload;
  75     my $upload_type;
  76     if ($crosses_plots_upload) {
  77         $upload = $crosses_plots_upload;
  78         $upload_type = 'CrossesExcelFormat';
  79         }
  80     if ($crosses_plants_upload) {
  81             $upload = $crosses_plants_upload;
  82             $upload_type = 'CrossesExcelFormat';
  83             }
  84
  85     if ($crosses_simple_upload) {
  86         $upload = $crosses_simple_upload;
  87         $upload_type = 'CrossesSimpleExcel';
  88     }
  89
  90     my $prefix = $c->req->param('upload_prefix');
  91     my $suffix = $c->req->param('upload_suffix');
  92     my $parser;
  93     my $parsed_data;
  94     my $upload_original_name = $upload->filename();
  95     my $upload_tempfile = $upload->tempname;
  96     my $subdirectory = "cross_upload";
  97     my $archived_filename_with_path;
  98     my $md5;
  99     my $validate_file;
 100     my $parsed_file;
 101     my $parse_errors;
 102     my %parsed_data;
 103     my %upload_metadata;
 104     my $time = DateTime->now();
 105     my $timestamp = $time->ymd()."_".$time->hms();
 106     my $user_role;
 107     my $user_id;
 108     my $user_name;
 109     my $owner_name;
 110     my $upload_file_type = "crosses excel";#get from form when more options are added
 111     my $session_id = $c->req->param("sgn_session_id");
 112
 113     if ($session_id){
 114         my $dbh = $c->dbc->dbh;
 115         my @user_info = CXGN::Login->new($dbh)->query_from_cookie($session_id);
 116         if (!$user_info[0]){
 117             $c->stash->{rest} = {error=>'You must be logged in to upload crosses!'};
 118             $c->detach();
 119         }
 120         $user_id = $user_info[0];
 121         $user_role = $user_info[1];
 122         my $p = CXGN::People::Person->new($dbh, $user_id);
 123         $user_name = $p->get_username;
 124     } else{
 125         if (!$c->user){
 126             $c->stash->{rest} = {error=>'You must be logged in to upload crosses!'};
 127             $c->detach();
 128         }
 129         $user_id = $c->user()->get_object()->get_sp_person_id();
 130         $user_name = $c->user()->get_object()->get_username();
 131         $user_role = $c->user->get_object->get_user_type();
 132     }
 133
 134     my $uploader = CXGN::UploadFile->new({
 135         tempfile => $upload_tempfile,
 136         subdirectory => $subdirectory,
 137         archive_path => $c->config->{archive_path},
 138         archive_filename => $upload_original_name,
 139         timestamp => $timestamp,
 140         user_id => $user_id,
 141         user_role => $user_role
 142     });
 143
 144     ## Store uploaded temporary file in arhive
 145     $archived_filename_with_path = $uploader->archive();
 146     $md5 = $uploader->get_md5($archived_filename_with_path);
 147     if (!$archived_filename_with_path) {
 148         $c->stash->{rest} = {error => "Could not save file $upload_original_name in archive",};
 149         return;
 150     }
 151     unlink $upload_tempfile;
 152
 153     $upload_metadata{'archived_file'} = $archived_filename_with_path;
 154     $upload_metadata{'archived_file_type'}="cross upload file";
 155     $upload_metadata{'user_id'}=$user_id;
 156     $upload_metadata{'date'}="$timestamp";
 157
 158     my $cross_properties_json = $c->config->{cross_properties};
 159     my @properties = split ',', $cross_properties_json;
 160     my $cross_properties = \@properties;
 161
 162     #parse uploaded file with appropriate plugin
 163     $parser = CXGN::Pedigree::ParseUpload->new(chado_schema => $chado_schema, filename => $archived_filename_with_path, cross_properties => $cross_properties);
 164     $parser->load_plugin($upload_type);
 165     $parsed_data = $parser->parse();
 166     #print STDERR "Dumper of parsed data:\t" . Dumper($parsed_data) . "\n";
 167
 168     if (!$parsed_data){
 169         my $return_error = '';
 170         my $parse_errors;
 171         if (!$parser->has_parse_errors() ){
 172             $c->stash->{rest} = {error_string => "Could not get parsing errors"};
 173         } else {
 174             $parse_errors = $parser->get_parse_errors();
 175             #print STDERR Dumper $parse_errors;
 176
 177             foreach my $error_string (@{$parse_errors->{'error_messages'}}){
 178                 $return_error .= $error_string."<br>";
 179             }
 180         }
 181         $c->stash->{rest} = {error_string => $return_error, missing_accessions => $parse_errors->{'missing_accessions'}, missing_plots => $parse_errors->{'missing_plots'}};
 182         $c->detach();
 183     }
 184
 185     my $cross_add = CXGN::Pedigree::AddCrosses->new({
 186         chado_schema => $chado_schema,
 187         phenome_schema => $phenome_schema,
 188         metadata_schema => $metadata_schema,
 189         dbh => $dbh,
 190         location => $location,
 191         crossing_trial_id => $crossing_trial_id,
 192         crosses =>  $parsed_data->{crosses},
 193         owner_name => $user_name
 194           });
 195
 196     #validate the crosses
 197     if (!$cross_add->validate_crosses()){
 198         $c->stash->{rest} = {error_string => "Error validating crosses",};
 199         return;
 200     }
 201
 202     #add the crosses
 203     if (!$cross_add->add_crosses()){
 204         $c->stash->{rest} = {error_string => "Error adding crosses",};
 205         return;
 206     }
 207
 208     #add the progeny
 209     if ($parsed_data->{number_of_progeny}) {
 210         my %progeny_hash = %{$parsed_data->{number_of_progeny}};
 211
 212         foreach my $cross_name_key (keys %progeny_hash) {
 213             my $progeny_number = $progeny_hash{$cross_name_key};
 214             my $progeny_increment = 1;
 215             my @progeny_names;
 216
 217             #create array of progeny names to add for this cross
 218             while ($progeny_increment < $progeny_number + 1) {
 219                 $progeny_increment = sprintf "%03d", $progeny_increment;
 220                 my $stock_name = $cross_name_key.$prefix.$progeny_increment.$suffix;
 221                 push @progeny_names, $stock_name;
 222                 $progeny_increment++;
 223             }
 224
 225             #add array of progeny to the cross
 226             my $progeny_add = CXGN::Pedigree::AddProgeny->new ({
 227                 chado_schema => $chado_schema,
 228                 phenome_schema => $phenome_schema,
 229                 dbh => $dbh,
 230                 cross_name => $cross_name_key,
 231                 progeny_names => \@progeny_names,
 232                 owner_name => $owner_name,
 233             });
 234             if (!$progeny_add->add_progeny()){
 235                 $c->stash->{rest} = {error_string => "Error adding progeny",};
 236                 #should delete crosses and other progeny if add progeny fails?
 237                 return;
 238             }
 239         }
 240     }
 241
 242     while (my $info_type = shift (@properties)){
 243         if ($parsed_data->{$info_type}) {
 244             print STDERR "Handling info type $info_type\n";
 245             my %info_hash = %{$parsed_data->{$info_type}};
 246             foreach my $cross_name_key (keys %info_hash) {
 247                 my $value = $info_hash{$cross_name_key};
 248                 my $cross_add_info = CXGN::Pedigree::AddCrossInfo->new({ chado_schema => $chado_schema, cross_name => $cross_name_key, key => $info_type, value => $value, } );
 249                 $cross_add_info->add_info();
 250             }
 251         }
 252     }
 253
 254     $c->stash->{rest} = {success => "1",};
 255 }
 256
 257
 258 sub add_cross : Local : ActionClass('REST') { }
 259
 260 sub add_cross_POST :Args(0) {
 261     my ($self, $c) = @_;
 262     my $chado_schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 263     my $cross_name = $c->req->param('cross_name');
 264     my $cross_type = $c->req->param('cross_type');
 265     my $crossing_trial_id = $c->req->param('crossing_trial_id');
 266     my $female_plot_id = $c->req->param('female_plot');
 267     my $male_plot_id = $c->req->param('male_plot');
 268     $cross_name =~ s/^\s+|\s+$//g; #trim whitespace from front and end.
 269
 270     #print STDERR "Female Plot=".Dumper($female_plot)."\n";
 271
 272     if (!$c->user()) {
 273         print STDERR "User not logged in... not adding a cross.\n";
 274         $c->stash->{rest} = {error => "You need to be logged in to add a cross." };
 275         return;
 276     }
 277
 278     if (!any { $_ eq "curator" || $_ eq "submitter" } ($c->user()->roles)  ) {
 279         print STDERR "User does not have sufficient privileges.\n";
 280         $c->stash->{rest} = {error =>  "you have insufficient privileges to add a cross." };
 281         return;
 282     }
 283
 284     if ($cross_type eq "polycross") {
 285       print STDERR "Handling a polycross\n";
 286         my @maternal_parents = split (',', $c->req->param('maternal_parents'));
 287         print STDERR "Maternal parents array:" . @maternal_parents . "\n Maternal parents with ref:" . \@maternal_parents . "\n Maternal parents with dumper:". Dumper(@maternal_parents) . "\n";
 288         my $paternal = $cross_name . '_parents';
 289         my $population_add = CXGN::Pedigree::AddPopulations->new({ schema => $chado_schema, name => $paternal, members =>  \@maternal_parents} );
 290         $population_add->add_population();
 291         $cross_type = 'open';
 292         print STDERR "Scalar maternatal paretns:" . scalar @maternal_parents;
 293         for (my $i = 0; $i < scalar @maternal_parents; $i++) {
 294           my $maternal = $maternal_parents[$i];
 295           my $polycross_name = $cross_name . '_' . $maternal . '_polycross';
 296           print STDERR "First polycross to add is $polycross_name with amternal $maternal and paternal $paternal\n";
 297           my $success = $self->add_individual_cross($c, $chado_schema, $polycross_name, $cross_type, $crossing_trial_id, $female_plot_id, $male_plot_id, $maternal, $paternal);
 298           if (!$success) {
 299             return;
 300           }
 301           print STDERR "polycross addition  $polycross_name worked successfully\n";
 302         }
 303       }
 304     elsif ($cross_type eq "reciprocal") {
 305         $cross_type = 'biparental';
 306         my @maternal_parents = split (',', $c->req->param('maternal_parents'));
 307         for (my $i = 0; $i < scalar @maternal_parents; $i++) {
 308             my $maternal = $maternal_parents[$i];
 309             for (my $j = 0; $j < scalar @maternal_parents; $j++) {
 310                 my $paternal = $maternal_parents[$j];
 311                 if ($maternal eq $paternal) {
 312                     next;
 313                 }
 314                 my $reciprocal_cross_name = $cross_name . '_' . $maternal . 'x' . $paternal . '_reciprocalcross';
 315                 my $success = $self->add_individual_cross($c, $chado_schema, $reciprocal_cross_name, $cross_type, $crossing_trial_id, $female_plot_id, $male_plot_id, $maternal, $paternal);
 316                 if (!$success) {
 317                     return;
 318                 }
 319             }
 320         }
 321     }
 322     elsif ($cross_type eq "multicross") {
 323         $cross_type = 'biparental';
 324         my @maternal_parents = split (',', $c->req->param('maternal_parents'));
 325         my @paternal_parents = split (',', $c->req->param('paternal_parents'));
 326         for (my $i = 0; $i < scalar @maternal_parents; $i++) {
 327             my $maternal = $maternal_parents[$i];
 328             my $paternal = $paternal_parents[$i];
 329             my $multicross_name = $cross_name . '_' . $maternal . 'x' . $paternal . '_multicross';
 330             my $success = $self->add_individual_cross($c, $chado_schema, $multicross_name, $cross_type, $crossing_trial_id, $female_plot_id, $male_plot_id, $maternal, $paternal);
 331             if (!$success) {
 332               return;
 333             }
 334         }
 335     }
 336     else {
 337         my $maternal = $c->req->param('maternal');
 338         my $paternal = $c->req->param('paternal');
 339         my $success = $self->add_individual_cross($c, $chado_schema, $cross_name, $cross_type, $crossing_trial_id, $female_plot_id, $male_plot_id, $maternal, $paternal);
 340         if (!$success) {
 341             return;
 342         }
 343     }
 344     $c->stash->{rest} = {success => "1",};
 345   }
 346
 347 sub get_cross_relationships :Path('/cross/ajax/relationships') :Args(1) {
 348     my $self = shift;
 349     my $c = shift;
 350     my $cross_id = shift;
 351
 352     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 353
 354     my $cross = $schema->resultset("Stock::Stock")->find( { stock_id => $cross_id });
 355
 356     if ($cross && $cross->type()->name() ne "cross") {
 357             $c->stash->{rest} = { error => 'This entry is not of type cross and cannot be displayed using this page.' };
 358             return;
 359     }
 360
 361     my $cross_obj = CXGN::Cross->new({schema=>$schema, cross_stock_id=>$cross_id});
 362     my ($maternal_parent, $paternal_parent, $progeny) = $cross_obj->get_cross_relationships();
 363
 364     $c->stash->{rest} = {
 365         maternal_parent => $maternal_parent,
 366         paternal_parent => $paternal_parent,
 367         progeny => $progeny,
 368     };
 369 }
 370
 371 sub get_cross_parents :Path('/ajax/cross/accession_plot_plant_parents') Args(1) {
 372     my $self = shift;
 373     my $c = shift;
 374     my $cross_id = shift;
 375
 376     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 377     my $female_accession_cvterm = SGN::Model::Cvterm->get_cvterm_row($schema, 'female_parent', 'stock_relationship')->cvterm_id();
 378     my $female_plot_cvterm = SGN::Model::Cvterm->get_cvterm_row($schema, 'female_plot_of', 'stock_relationship')->cvterm_id();
 379     my $male_accession_cvterm = SGN::Model::Cvterm->get_cvterm_row($schema, 'male_parent', 'stock_relationship')->cvterm_id();
 380     my $male_plot_cvterm = SGN::Model::Cvterm->get_cvterm_row($schema, 'male_plot_of', 'stock_relationship')->cvterm_id();
 381     my $female_plant_cvterm = SGN::Model::Cvterm->get_cvterm_row($schema, 'female_plant_of', 'stock_relationship')->cvterm_id();
 382     my $male_plant_cvterm = SGN::Model::Cvterm->get_cvterm_row($schema, 'male_plant_of', 'stock_relationship')->cvterm_id();
 383
 384     my $q ="SELECT stock1.stock_id, stock1.uniquename, stock2.stock_id, stock2.uniquename, stock3.stock_id, stock3.uniquename, stock4.stock_id, stock4.uniquename, stock5.stock_id, stock5.uniquename, stock6.stock_id, stock6.uniquename, stock_relationship1.value FROM stock
 385         JOIN stock_relationship AS stock_relationship1 ON (stock.stock_id = stock_relationship1.object_id) and stock_relationship1.type_id = ?
 386         JOIN stock AS stock1 ON (stock_relationship1.subject_id = stock1.stock_id)
 387         LEFT JOIN stock_relationship AS stock_relationship2 ON (stock.stock_id = stock_relationship2.object_id) AND stock_relationship2.type_id = ?
 388         LEFT JOIN stock AS stock2 on (stock_relationship2.subject_id = stock2.stock_id)
 389         LEFT JOIN stock_relationship AS stock_relationship3 ON (stock.stock_id = stock_relationship3.object_id) and stock_relationship3.type_id = ?
 390         LEFT JOIN stock AS stock3 ON (stock_relationship3.subject_id = stock3.stock_id)
 391         LEFT JOIN stock_relationship AS stock_relationship4 ON (stock.stock_id = stock_relationship4.object_id) AND stock_relationship4.type_id = ?
 392         LEFT JOIN stock AS stock4 ON (stock_relationship4.subject_id =stock4.stock_id)
 393         LEFT JOIN stock_relationship AS stock_relationship5 ON (stock.stock_id = stock_relationship5.object_id) AND stock_relationship5.type_id = ?
 394         LEFT JOIN stock AS stock5 ON (stock_relationship5.subject_id =stock5.stock_id)
 395         LEFT JOIN stock_relationship AS stock_relationship6 ON (stock.stock_id = stock_relationship6.object_id) AND stock_relationship6.type_id = ?
 396         LEFT JOIN stock AS stock6 ON (stock_relationship6.subject_id =stock6.stock_id)
 397
 398          WHERE stock.stock_id = ?";
 399
 400
 401     my $h = $schema->storage->dbh()->prepare($q);
 402     $h->execute($female_accession_cvterm, $female_plot_cvterm, $female_plant_cvterm, $male_accession_cvterm, $male_plot_cvterm, $male_plant_cvterm, $cross_id);
 403
 404     my @cross_parents = ();
 405     while(my ($female_accession_id, $female_accession_name, $female_plot_id, $female_plot_name, $female_plant_id, $female_plant_name, $male_accession_id, $male_accession_name, $male_plot_id, $male_plot_name, $male_plant_id, $male_plant_name, $cross_type) = $h->fetchrow_array()){
 406         push @cross_parents, [ $cross_type,
 407             qq{<a href="/stock/$female_accession_id/view">$female_accession_name</a>},
 408             qq{<a href="/stock/$male_accession_id/view">$male_accession_name</a>},
 409             qq{<a href="/stock/$female_plot_id/view">$female_plot_name</a>},
 410             qq{<a href="/stock/$male_plot_id/view">$male_plot_name</a>},
 411             qq{<a href="/stock/$female_plant_id/view">$female_plant_name</a>},
 412             qq{<a href="/stock/$male_plant_id/view">$male_plant_name</a>}];
 413     }
 414
 415     $c->stash->{rest} = {data => \@cross_parents}
 416
 417 }
 418
 419
 420
 421 sub get_cross_properties :Path('/ajax/cross/properties') Args(1) {
 422     my $self = shift;
 423     my $c = shift;
 424     my $cross_id = shift;
 425
 426     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 427     my $cross_info_cvterm = SGN::Model::Cvterm->get_cvterm_row($schema, 'crossing_metadata_json', 'stock_property')->cvterm_id();
 428
 429     my $cross_info = $schema->resultset("Stock::Stockprop")->find({stock_id => $cross_id, type_id => $cross_info_cvterm});
 430
 431     if($cross_info){
 432         $cross_json_string = $cross_info->value();
 433     }
 434
 435     my $cross_props_hash ={};
 436     if($cross_json_string){
 437         $cross_props_hash = decode_json $cross_json_string;
 438     }
 439
 440     my $cross_properties = $c->config->{cross_properties};
 441     my @column_order = split ',',$cross_properties;
 442     my @props;
 443     my @row;
 444     foreach my $key (@column_order){
 445         push @row, $cross_props_hash->{$key};
 446     }
 447
 448     push @props,\@row;
 449     $c->stash->{rest} = {data => \@props};
 450
 451 }
 452
 453
 454  sub save_property_check :Path('/cross/property/check') Args(1) {
 455     my $self = shift;
 456     my $c = shift;
 457     my $cross_id = shift;
 458
 459     my $type = $c->req->param("type");
 460     my $value = $c->req->param("value");
 461
 462
 463     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 464
 465     if ($type =~ m/Number/ || $type =~ m/Days/) { $type = 'number';}
 466     if ($type =~ m/Date/) { $type = 'date';}
 467
 468     my %suggested_values = (
 469 #  cross_name => '.*',
 470 #       cross_type =>  { 'biparental'=>1, 'self'=>1, 'open'=>1, 'bulk'=>1, 'bulk_self'=>1, 'bulk_open'=>1, 'doubled_haploid'=>1 },
 471               number => '\d+',
 472               date => '\d{4}\\/\d{2}\\/\d{2}',
 473           );
 474
 475     my %example_values = (
 476               date => '2014/03/29',
 477         number => 20,
 478 #  cross_type => 'biparental',
 479 #       cross_name => 'nextgen_cross',
 480           );
 481
 482     if (ref($suggested_values{$type})) {
 483               if (!exists($suggested_values{$type}->{$value})) { # don't make this case insensitive!
 484                   $c->stash->{rest} =  { message => 'The provided value is not in the suggested list of terms. This could affect downstream data processing.' };
 485                   return;
 486               }
 487     }
 488     else {
 489               if ($value !~ m/^$suggested_values{$type}$/) {
 490                   $c->stash->{rest} = { error => 'The provided value is not in a valid format. Format example: "'.$example_values{$type}.'"' };
 491                   return;
 492               }
 493     }
 494     $c->stash->{rest} = { success => 1 };
 495 }
 496
 497
 498
 499 sub cross_property_save :Path('/cross/property/save') Args(1) {
 500     my $self = shift;
 501     my $c = shift;
 502
 503     if (!$c->user()) {
 504               $c->stash->{rest} = { error => "You must be logged in to add properties." };
 505               return;
 506     }
 507     if (!($c->user()->has_role('submitter') or $c->user()->has_role('curator'))) {
 508               $c->stash->{rest} = { error => "You do not have sufficient privileges to add properties." };
 509               return;
 510     }
 511
 512     my $cross_id = $c->req->param("cross_id");
 513     my $type = $c->req->param("type");
 514     my $value = $c->req->param("value");
 515
 516     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 517     my $cross_name = $schema->resultset("Stock::Stock")->find({stock_id => $cross_id})->uniquename();
 518
 519     my $cross_add_info = CXGN::Pedigree::AddCrossInfo->new({
 520         chado_schema => $schema,
 521         cross_name => $cross_name,
 522         key => $type,
 523         value => $value
 524     });
 525     $cross_add_info->add_info();
 526
 527     if (!$cross_add_info->add_info()){
 528         $c->stash->{rest} = {error_string => "Error saving info",};
 529         return;
 530     }
 531
 532     $c->stash->{rest} = { success => 1};
 533 }
 534
 535 sub add_more_progeny :Path('/cross/progeny/add') Args(1) {
 536     my $self = shift;
 537     my $c = shift;
 538     my $cross_id = shift;
 539
 540     if (!$c->user()) {
 541         $c->stash->{rest} = { error => "You must be logged in add progeny." };
 542         return;
 543     }
 544     if (!($c->user()->has_role('submitter') or $c->user()->has_role('curator'))) {
 545         $c->stash->{rest} = { error => "You do not have sufficient privileges to add progeny." };
 546         return;
 547     }
 548
 549     my $basename = $c->req->param("basename");
 550     my $start_number = $c->req->param("start_number");
 551     my $progeny_count = $c->req->param("progeny_count");
 552     my $cross_name = $c->req->param("cross_name");
 553
 554     my @progeny_names = ();
 555     foreach my $n (1..$progeny_count) {
 556         push @progeny_names, $basename. (sprintf "%03d", $n + $start_number -1);
 557     }
 558
 559     #print STDERR Dumper(\@progeny_names);
 560
 561     my $chado_schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 562     my $metadata_schema = $c->dbic_schema("CXGN::Metadata::Schema");
 563     my $phenome_schema = $c->dbic_schema("CXGN::Phenome::Schema");
 564     my $dbh = $c->dbc->dbh;
 565
 566     my $owner_name = $c->user()->get_object()->get_username();
 567
 568     my $progeny_add = CXGN::Pedigree::AddProgeny
 569         ->new({
 570             chado_schema => $chado_schema,
 571             phenome_schema => $phenome_schema,
 572             dbh => $dbh,
 573             cross_name => $cross_name,
 574             progeny_names => \@progeny_names,
 575             owner_name => $owner_name,
 576               });
 577     if (!$progeny_add->add_progeny()){
 578       $c->stash->{rest} = {error_string => "Error adding progeny. Please change the input parameters and try again.",};
 579       #should delete crosses and other progeny if add progeny fails?
 580       return;
 581     }
 582
 583     $c->stash->{rest} = { success => 1};
 584
 585 }
 586
 587
 588 my $new_cross = CXGN::Cross->new({ schema=>schema });
 589 $new_cross->female_parent($fjfj);
 590 $new_cross->male_parent(kdkjf);
 591 $new_cross->location(kjlsdlkjdfskj);
 592 ...type
 593 ...cross_name
 594 ...plots...
 595 $new_cross->store();
 596
 597 sub add_individual_cross {
 598   my $self = shift;
 599   my $c = shift;
 600   my $chado_schema = shift;
 601   my $cross_name = shift;
 602   my $cross_type = shift;
 603   my $crossing_trial_id = shift;
 604   my $female_plot_id = shift;
 605   my $female_plot;
 606   my $male_plot_id = shift;
 607   my $male_plot;
 608   my $maternal = shift;
 609   my $paternal = shift;
 610
 611   my $owner_name = $c->user()->get_object()->get_username();
 612   my @progeny_names;
 613   my $progeny_increment = 1;
 614   my $metadata_schema = $c->dbic_schema("CXGN::Metadata::Schema");
 615   my $phenome_schema = $c->dbic_schema("CXGN::Phenome::Schema");
 616   my $dbh = $c->dbc->dbh;
 617   my $location = $c->req->param('location');
 618   my $prefix = $c->req->param('prefix');
 619   my $suffix = $c->req->param('suffix');
 620   my $progeny_number = $c->req->param('progeny_number');
 621   my $tag_number = $c->req->param('tag_number');
 622   my $pollination_date = $c->req->param('pollination_date');
 623   my $number_of_bags = $c->req->param('bag_number');
 624   my $number_of_flowers = $c->req->param('flower_number');
 625   my $number_of_fruits = $c->req->param('fruit_number');
 626   my $number_of_seeds = $c->req->param('seed_number');
 627   my $visible_to_role = $c->req->param('visible_to_role');
 628
 629   #print STDERR Dumper "Adding Cross... Maternal: $maternal Paternal: $paternal Cross Type: $cross_type Number of Flowers: $number_of_flowers";
 630
 631     if ($female_plot_id){
 632         my $female_plot_rs = $chado_schema->resultset("Stock::Stock")->find({stock_id => $female_plot_id});
 633         $female_plot = $female_plot_rs->name();
 634     }
 635
 636     if ($male_plot_id){
 637         my $male_plot_rs = $chado_schema->resultset("Stock::Stock")->find({stock_id => $male_plot_id});
 638         $male_plot = $male_plot_rs->name();
 639     }
 640
 641
 642   #check that progeny number is an integer less than maximum allowed
 643   my $maximum_progeny_number = 999; #higher numbers break cross name convention
 644   if ($progeny_number) {
 645     if ((! $progeny_number =~ m/^\d+$/) or ($progeny_number > $maximum_progeny_number) or ($progeny_number < 1)) {
 646 $c->stash->{rest} = {error =>  "progeny number exceeds the maximum of $maximum_progeny_number or is invalid." };
 647 return 0;
 648     }
 649   }
 650
 651   #check that maternal name is not blank
 652   if ($maternal eq "") {
 653     $c->stash->{rest} = {error =>  "Female parent name cannot be blank." };
 654     return 0;
 655   }
 656
 657   #if required, check that paternal parent name is not blank;
 658   if ($paternal eq "" && ($cross_type ne "open") && ($cross_type ne "bulk_open")) {
 659     $c->stash->{rest} = {error =>  "Male parent name cannot be blank." };
 660     return 0;
 661   }
 662
 663   #check that parents exist in the database
 664   if (! $chado_schema->resultset("Stock::Stock")->find({uniquename=>$maternal,})){
 665     $c->stash->{rest} = {error =>  "Female parent does not exist." };
 666     return 0;
 667   }
 668
 669   if ($paternal) {
 670     if (! $chado_schema->resultset("Stock::Stock")->find({uniquename=>$paternal,})){
 671 $c->stash->{rest} = {error =>  "Male parent does not exist." };
 672 return 0;
 673     }
 674   }
 675
 676   #check that cross name does not already exist
 677   if ($chado_schema->resultset("Stock::Stock")->find({uniquename=>$cross_name})){
 678     $c->stash->{rest} = {error =>  "cross name already exists." };
 679     return 0;
 680   }
 681
 682   #check that progeny do not already exist
 683   if ($chado_schema->resultset("Stock::Stock")->find({uniquename=>$cross_name.$prefix.'001'.$suffix,})){
 684     $c->stash->{rest} = {error =>  "progeny already exist." };
 685     return 0;
 686   }
 687
 688   #objects to store cross information
 689   my $cross_to_add = Bio::GeneticRelationships::Pedigree->new(name => $cross_name, cross_type => $cross_type);
 690   my $female_individual = Bio::GeneticRelationships::Individual->new(name => $maternal);
 691   $cross_to_add->set_female_parent($female_individual);
 692
 693     if ($paternal) {
 694         my $male_individual = Bio::GeneticRelationships::Individual->new(name => $paternal);
 695         $cross_to_add->set_male_parent($male_individual);
 696     }
 697
 698     if ($female_plot) {
 699         my $female_plot_individual = Bio::GeneticRelationships::Individual->new(name => $female_plot);
 700         $cross_to_add->set_female_plot($female_plot_individual);
 701     }
 702
 703     if ($male_plot) {
 704         my $male_plot_individual = Bio::GeneticRelationships::Individual->new(name => $male_plot);
 705         $cross_to_add->set_male_plot($male_plot_individual);
 706     }
 707
 708
 709   $cross_to_add->set_cross_type($cross_type);
 710   $cross_to_add->set_name($cross_name);
 711
 712   eval {
 713 #create array of pedigree objects to add, in this case just one pedigree
 714 my @array_of_pedigree_objects = ($cross_to_add);
 715 my $cross_add = CXGN::Pedigree::AddCrosses
 716     ->new({
 717   chado_schema => $chado_schema,
 718   phenome_schema => $phenome_schema,
 719   dbh => $dbh,
 720   location => $location,
 721   crossing_trial_id => $crossing_trial_id,
 722   crosses =>  \@array_of_pedigree_objects,
 723   owner_name => $owner_name,
 724     });
 725
 726
 727 #add the crosses
 728 $cross_add->add_crosses();
 729   };
 730   if ($@) {
 731 $c->stash->{rest} = { error => "Error creating the cross: $@" };
 732 return 0;
 733   }
 734
 735   eval {
 736 #create progeny if specified
 737 if ($progeny_number) {
 738
 739     #create array of progeny names to add for this cross
 740     while ($progeny_increment < $progeny_number + 1) {
 741   $progeny_increment = sprintf "%03d", $progeny_increment;
 742   my $stock_name = $cross_name.$prefix.$progeny_increment.$suffix;
 743   push @progeny_names, $stock_name;
 744   $progeny_increment++;
 745     }
 746
 747     #add array of progeny to the cross
 748     my $progeny_add = CXGN::Pedigree::AddProgeny
 749   ->new({
 750       chado_schema => $chado_schema,
 751       phenome_schema => $phenome_schema,
 752       dbh => $dbh,
 753       cross_name => $cross_name,
 754       progeny_names => \@progeny_names,
 755       owner_name => $owner_name,
 756         });
 757     $progeny_add->add_progeny();
 758
 759 }
 760
 761     my @cross_props = (
 762         ['Pollination Date',$pollination_date],
 763         ['Number of Flowers',$number_of_flowers],
 764         ['Number of Fruits',$number_of_fruits],
 765         ['Number of Seeds',$number_of_seeds]
 766     );
 767
 768     foreach (@cross_props){
 769         if ($_->[1]){
 770             my $cross_add_info = CXGN::Pedigree::AddCrossInfo->new({
 771                 chado_schema => $chado_schema,
 772                 cross_name => $cross_name,
 773                 key => $_->[0],
 774                 value => $_->[1]
 775             });
 776         $cross_add_info->add_info();
 777         }
 778     }
 779   };
 780     if ($@) {
 781         $c->stash->{rest} = { error => "An error occurred: $@"};
 782         return 0;
 783     }
 784     return 1;
 785
 786 }
 787
 788
 789 sub add_crossingtrial : Path('/ajax/cross/add_crossingtrial') : ActionClass('REST') {}
 790
 791 sub add_crossingtrial_POST :Args(0){
 792     my ($self, $c) = @_;
 793     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 794     my $dbh = $c->dbc->dbh;
 795     print STDERR Dumper $c->req->params();
 796     my $crossingtrial_name = $c->req->param('crossingtrial_name');
 797     my $breeding_program_id = $c->req->param('crossingtrial_program_id');
 798     my $location = $c->req->param('crossingtrial_location');
 799     my $year = $c->req->param('year');
 800     my $project_description = $c->req->param('project_description');
 801     my $geolocation_lookup = CXGN::Location::LocationLookup->new(schema =>$schema);
 802     $geolocation_lookup->set_location_name($location);
 803     if(!$geolocation_lookup->get_geolocation()){
 804         $c->stash->{rest}={error => "Location not found"};
 805         return;
 806     }
 807
 808     if (!$c->user()){
 809         print STDERR "User not logged in... not adding a crossingtrial.\n";
 810         $c->stash->{rest} = {error => "You need to be logged in to add a crossingtrial."};
 811         return;
 812     }
 813
 814     if (!any { $_ eq "curator" || $_ eq "submitter" } ($c->user()->roles)){
 815         print STDERR "User does not have sufficient privileges.\n";
 816         $c->stash->{rest} = {error =>  "you have insufficient privileges to add a crossingtrial." };
 817         return;
 818     }
 819
 820     my $error;
 821     eval{
 822         my $add_crossingtrial = CXGN::Pedigree::AddCrossingtrial->new({
 823             chado_schema => $schema,
 824             dbh => $dbh,
 825             breeding_program_id => $breeding_program_id,
 826             year => $c->req->param('year'),
 827             project_description => $c->req->param('project_description'),
 828             crossingtrial_name => $crossingtrial_name,
 829             nd_geolocation_id => $geolocation_lookup->get_geolocation()->nd_geolocation_id()
 830         });
 831         my $store_return = $add_crossingtrial->save_crossingtrial();
 832         if ($store_return->{error}){
 833             $error = $store_return->{error};
 834         }
 835     };
 836
 837     if ($@) {
 838         $c->stash->{rest} = {error => $@};
 839         return;
 840     };
 841
 842     if ($error){
 843         $c->stash->{rest} = {error => $error};
 844     } else {
 845         $c->stash->{rest} = {success => 1};
 846     }
 847 }
 848
 849 sub upload_progenies : Path('/ajax/cross/upload_progenies') : ActionClass('REST'){ }
 850
 851 sub upload_progenies_POST : Args(0) {
 852     my $self = shift;
 853     my $c = shift;
 854     my $chado_schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 855     my $metadata_schema = $c->dbic_schema("CXGN::Metadata::Schema");
 856     my $phenome_schema = $c->dbic_schema("CXGN::Phenome::Schema");
 857     my $dbh = $c->dbc->dbh;
 858     my $upload = $c->req->upload('progenies_upload_file');
 859     my $parser;
 860     my $parsed_data;
 861     my $upload_original_name = $upload->filename();
 862     my $upload_tempfile = $upload->tempname;
 863     my $subdirectory = "cross_upload";
 864     my $archived_filename_with_path;
 865     my $md5;
 866     my $validate_file;
 867     my $parsed_file;
 868     my $parse_errors;
 869     my %parsed_data;
 870     my %upload_metadata;
 871     my $time = DateTime->now();
 872     my $timestamp = $time->ymd()."_".$time->hms();
 873     my $user_role;
 874     my $user_id;
 875     my $user_name;
 876     my $owner_name;
 877 #   my $upload_file_type = "crosses excel";#get from form when more options are added
 878     my $session_id = $c->req->param("sgn_session_id");
 879
 880     if ($session_id){
 881         my $dbh = $c->dbc->dbh;
 882         my @user_info = CXGN::Login->new($dbh)->query_from_cookie($session_id);
 883         if (!$user_info[0]){
 884             $c->stash->{rest} = {error=>'You must be logged in to upload progenies!'};
 885             $c->detach();
 886         }
 887         $user_id = $user_info[0];
 888         $user_role = $user_info[1];
 889         my $p = CXGN::People::Person->new($dbh, $user_id);
 890         $user_name = $p->get_username;
 891     } else{
 892         if (!$c->user){
 893             $c->stash->{rest} = {error=>'You must be logged in to upload progenies!'};
 894             $c->detach();
 895         }
 896         $user_id = $c->user()->get_object()->get_sp_person_id();
 897         $user_name = $c->user()->get_object()->get_username();
 898         $user_role = $c->user->get_object->get_user_type();
 899     }
 900
 901     my $uploader = CXGN::UploadFile->new({
 902         tempfile => $upload_tempfile,
 903         subdirectory => $subdirectory,
 904         archive_path => $c->config->{archive_path},
 905         archive_filename => $upload_original_name,
 906         timestamp => $timestamp,
 907         user_id => $user_id,
 908         user_role => $user_role
 909     });
 910
 911     ## Store uploaded temporary file in arhive
 912     $archived_filename_with_path = $uploader->archive();
 913     $md5 = $uploader->get_md5($archived_filename_with_path);
 914     if (!$archived_filename_with_path) {
 915         $c->stash->{rest} = {error => "Could not save file $upload_original_name in archive",};
 916         return;
 917     }
 918     unlink $upload_tempfile;
 919
 920     $upload_metadata{'archived_file'} = $archived_filename_with_path;
 921     $upload_metadata{'archived_file_type'}="cross upload file";
 922     $upload_metadata{'user_id'}=$user_id;
 923     $upload_metadata{'date'}="$timestamp";
 924
 925     #parse uploaded file with appropriate plugin
 926     $parser = CXGN::Pedigree::ParseUpload->new(chado_schema => $chado_schema, filename => $archived_filename_with_path);
 927     $parser->load_plugin('ProgeniesExcel');
 928     $parsed_data = $parser->parse();
 929     #print STDERR "Dumper of parsed data:\t" . Dumper($parsed_data) . "\n";
 930
 931     if (!$parsed_data){
 932         my $return_error = '';
 933         my $parse_errors;
 934         if (!$parser->has_parse_errors() ){
 935             $c->stash->{rest} = {error_string => "Could not get parsing errors"};
 936         } else {
 937             $parse_errors = $parser->get_parse_errors();
 938             #print STDERR Dumper $parse_errors;
 939
 940             foreach my $error_string (@{$parse_errors->{'error_messages'}}){
 941                 $return_error .= $error_string."<br>";
 942             }
 943         }
 944         $c->stash->{rest} = {error_string => $return_error, missing_crosses => $parse_errors->{'missing_crosses'} };
 945         $c->detach();
 946     }
 947
 948     #add the progeny
 949     if ($parsed_data){
 950         my %progeny_hash = %{$parsed_data};
 951         foreach my $cross_name_key (keys %progeny_hash){
 952             my $progenies_ref = $progeny_hash{$cross_name_key};
 953             my @progenies = @{$progenies_ref};
 954
 955             my $progeny_add = CXGN::Pedigree::AddProgeny->new({
 956                 chado_schema => $chado_schema,
 957                 phenome_schema => $phenome_schema,
 958                 dbh => $dbh,
 959                 cross_name => $cross_name_key,
 960                 progeny_names => \@progenies,
 961                 owner_name => $user_name,
 962             });
 963             if (!$progeny_add->add_progeny()){
 964                 $c->stash->{rest} = {error_string => "Error adding progeny",};
 965                 return;
 966             }
 967         }
 968     }
 969
 970     $c->stash->{rest} = {success => "1",};
 971 }
 972
 973 sub upload_info : Path('/ajax/cross/upload_info') : ActionClass('REST'){ }
 974
 975 sub upload_info_POST : Args(0) {
 976     my $self = shift;
 977     my $c = shift;
 978     my $chado_schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 979     my $metadata_schema = $c->dbic_schema("CXGN::Metadata::Schema");
 980     my $phenome_schema = $c->dbic_schema("CXGN::Phenome::Schema");
 981     my $dbh = $c->dbc->dbh;
 982     my $upload = $c->req->upload('crossinfo_upload_file');
 983     my $parser;
 984     my $parsed_data;
 985     my $upload_original_name = $upload->filename();
 986     my $upload_tempfile = $upload->tempname;
 987     my $subdirectory = "cross_upload";
 988     my $archived_filename_with_path;
 989     my $md5;
 990     my $validate_file;
 991     my $parsed_file;
 992     my $parse_errors;
 993     my %parsed_data;
 994     my %upload_metadata;
 995     my $time = DateTime->now();
 996     my $timestamp = $time->ymd()."_".$time->hms();
 997     my $user_role;
 998     my $user_id;
 999     my $user_name;
1000     my $owner_name;
1001     my $session_id = $c->req->param("sgn_session_id");
1002
1003     if ($session_id){
1004         my $dbh = $c->dbc->dbh;
1005         my @user_info = CXGN::Login->new($dbh)->query_from_cookie($session_id);
1006         if (!$user_info[0]){
1007             $c->stash->{rest} = {error=>'You must be logged in to upload cross info!'};
1008             $c->detach();
1009         }
1010         $user_id = $user_info[0];
1011         $user_role = $user_info[1];
1012         my $p = CXGN::People::Person->new($dbh, $user_id);
1013         $user_name = $p->get_username;
1014     } else{
1015         if (!$c->user){
1016             $c->stash->{rest} = {error=>'You must be logged in to upload cross info!'};
1017             $c->detach();
1018         }
1019         $user_id = $c->user()->get_object()->get_sp_person_id();
1020         $user_name = $c->user()->get_object()->get_username();
1021         $user_role = $c->user->get_object->get_user_type();
1022     }
1023
1024     my $uploader = CXGN::UploadFile->new({
1025         tempfile => $upload_tempfile,
1026         subdirectory => $subdirectory,
1027         archive_path => $c->config->{archive_path},
1028         archive_filename => $upload_original_name,
1029         timestamp => $timestamp,
1030         user_id => $user_id,
1031         user_role => $user_role
1032     });
1033
1034     ## Store uploaded temporary file in arhive
1035     $archived_filename_with_path = $uploader->archive();
1036     $md5 = $uploader->get_md5($archived_filename_with_path);
1037     if (!$archived_filename_with_path) {
1038         $c->stash->{rest} = {error => "Could not save file $upload_original_name in archive",};
1039         return;
1040     }
1041     unlink $upload_tempfile;
1042
1043     $upload_metadata{'archived_file'} = $archived_filename_with_path;
1044     $upload_metadata{'archived_file_type'}="cross upload file";
1045     $upload_metadata{'user_id'}=$user_id;
1046     $upload_metadata{'date'}="$timestamp";
1047
1048     my $cross_properties_json = $c->config->{cross_properties};
1049     my @properties = split ',', $cross_properties_json;
1050     my $cross_properties = \@properties;
1051
1052     #parse uploaded file with appropriate plugin
1053     $parser = CXGN::Pedigree::ParseUpload->new(chado_schema => $chado_schema, filename => $archived_filename_with_path, cross_properties => $cross_properties);
1054     $parser->load_plugin('CrossInfoExcel');
1055     $parsed_data = $parser->parse();
1056     #print STDERR "Dumper of parsed data:\t" . Dumper($parsed_data) . "\n";
1057
1058     if (!$parsed_data) {
1059         my $return_error = '';
1060         my $parse_errors;
1061         if (!$parser->has_parse_errors() ){
1062             $c->stash->{rest} = {error_string => "Could not get parsing errors"};
1063         } else {
1064             $parse_errors = $parser->get_parse_errors();
1065             #print STDERR Dumper $parse_errors;
1066
1067             foreach my $error_string (@{$parse_errors->{'error_messages'}}){
1068                 $return_error .= $error_string."<br>";
1069             }
1070         }
1071         $c->stash->{rest} = {error_string => $return_error, missing_crosses => $parse_errors->{'missing_crosses'} };
1072         $c->detach();
1073     }
1074
1075     while (my $info_type = shift (@properties)){
1076         if ($parsed_data->{$info_type}) {
1077             print STDERR "Handling info type $info_type\n";
1078             my %info_hash = %{$parsed_data->{$info_type}};
1079             foreach my $cross_name_key (keys %info_hash){
1080                 my $value = $info_hash{$cross_name_key};
1081                 my $cross_add_info = CXGN::Pedigree::AddCrossInfo->new({
1082                     chado_schema => $chado_schema,
1083                     cross_name => $cross_name_key,
1084                     key => $info_type,
1085                     value => $value,
1086                 });
1087                 $cross_add_info->add_info();
1088             }
1089         }
1090     }
1091
1092     $c->stash->{rest} = {success => "1",};
1093 }
1094
1095
1096 sub upload_family_names : Path('/ajax/cross/upload_family_names') : ActionClass('REST'){ }
1097
1098 sub upload_family_names_POST : Args(0) {
1099     my $self = shift;
1100     my $c = shift;
1101     my $chado_schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
1102     my $metadata_schema = $c->dbic_schema("CXGN::Metadata::Schema");
1103     my $dbh = $c->dbc->dbh;
1104     my $upload = $c->req->upload('family_name_upload_file');
1105     my $parser;
1106     my $parsed_data;
1107     my $upload_original_name = $upload->filename();
1108     my $upload_tempfile = $upload->tempname;
1109     my $subdirectory = "cross_upload";
1110     my $archived_filename_with_path;
1111     my $md5;
1112     my $validate_file;
1113     my $parsed_file;
1114     my $parse_errors;
1115     my %parsed_data;
1116     my %upload_metadata;
1117     my $time = DateTime->now();
1118     my $timestamp = $time->ymd()."_".$time->hms();
1119     my $user_role;
1120     my $user_id;
1121     my $user_name;
1122     my $owner_name;
1123 #   my $upload_file_type = "crosses excel";#get from form when more options are added
1124     my $session_id = $c->req->param("sgn_session_id");
1125
1126     if ($session_id){
1127         my $dbh = $c->dbc->dbh;
1128         my @user_info = CXGN::Login->new($dbh)->query_from_cookie($session_id);
1129         if (!$user_info[0]){
1130             $c->stash->{rest} = {error=>'You must be logged in to upload family names!'};
1131             $c->detach();
1132         }
1133         $user_id = $user_info[0];
1134         $user_role = $user_info[1];
1135         my $p = CXGN::People::Person->new($dbh, $user_id);
1136         $user_name = $p->get_username;
1137     } else{
1138         if (!$c->user){
1139             $c->stash->{rest} = {error=>'You must be logged in to upload family names!'};
1140             $c->detach();
1141         }
1142         $user_id = $c->user()->get_object()->get_sp_person_id();
1143         $user_name = $c->user()->get_object()->get_username();
1144         $user_role = $c->user->get_object->get_user_type();
1145     }
1146
1147     my $uploader = CXGN::UploadFile->new({
1148         tempfile => $upload_tempfile,
1149         subdirectory => $subdirectory,
1150         archive_path => $c->config->{archive_path},
1151         archive_filename => $upload_original_name,
1152         timestamp => $timestamp,
1153         user_id => $user_id,
1154         user_role => $user_role
1155     });
1156
1157     ## Store uploaded temporary file in arhive
1158     $archived_filename_with_path = $uploader->archive();
1159     $md5 = $uploader->get_md5($archived_filename_with_path);
1160     if (!$archived_filename_with_path) {
1161         $c->stash->{rest} = {error => "Could not save file $upload_original_name in archive",};
1162         return;
1163     }
1164     unlink $upload_tempfile;
1165
1166     $upload_metadata{'archived_file'} = $archived_filename_with_path;
1167     $upload_metadata{'archived_file_type'}="cross upload file";
1168     $upload_metadata{'user_id'}=$user_id;
1169     $upload_metadata{'date'}="$timestamp";
1170
1171     #parse uploaded file with appropriate plugin
1172     $parser = CXGN::Pedigree::ParseUpload->new(chado_schema => $chado_schema, filename => $archived_filename_with_path);
1173     $parser->load_plugin('FamilyNameExcel');
1174     $parsed_data = $parser->parse();
1175     #print STDERR "Dumper of parsed data:\t" . Dumper($parsed_data) . "\n";
1176
1177     if (!$parsed_data){
1178         my $return_error = '';
1179         my $parse_errors;
1180         if (!$parser->has_parse_errors() ){
1181             $c->stash->{rest} = {error_string => "Could not get parsing errors"};
1182         } else {
1183             $parse_errors = $parser->get_parse_errors();
1184             #print STDERR Dumper $parse_errors;
1185
1186             foreach my $error_string (@{$parse_errors->{'error_messages'}}){
1187                 $return_error .= $error_string."<br>";
1188             }
1189         }
1190         $c->stash->{rest} = {error_string => $return_error, missing_crosses => $parse_errors->{'missing_crosses'} };
1191         $c->detach();
1192     }
1193
1194     #add the progeny
1195     if ($parsed_data){
1196         my %family_name_hash = %{$parsed_data};
1197         foreach my $cross_name(keys %family_name_hash){
1198             my $family_name = $family_name_hash{$cross_name};
1199
1200             my $family_name_add = CXGN::Pedigree::AddCrossInfo->new({
1201                 chado_schema => $chado_schema,
1202                 dbh => $dbh,
1203                 cross_name => $cross_name,
1204                 family_name => $family_name,
1205             });
1206             if (!$family_name_add->add_info()){
1207                 $c->stash->{rest} = {error_string => "Error adding family name",};
1208                 return;
1209             }
1210         }
1211     }
1212
1213     $c->stash->{rest} = {success => "1",};
1214 }
1215
1216
1217 sub delete_cross : Path('/ajax/cross/delete') : ActionClass('REST'){ }
1218
1219 sub delete_cross_POST : Args(0) {
1220     my $self = shift;
1221     my $c = shift;
1222
1223     my $cross_stock_id = $c->req->param("cross_id");
1224
1225     my $cross = CXGN::Cross->new( { schema => $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado'), cross_stock_id => $cross_stock_id });
1226
1227     if (!$cross->cross_stock_id()) {
1228         $c->stash->{rest} = { error => "No such cross exists. Cannot delete." };
1229         return;
1230     }
1231
1232     my $error = $cross->delete();
1233
1234     print STDERR "ERROR = $error\n";
1235
1236     if ($error) {
1237         $c->stash->{rest} = { error => "An error occurred attempting to delete a cross. ($@)" };
1238         return;
1239     }
1240
1241     $c->stash->{rest} = { success => 1 };
1242 }
1243
1244
1245 ###
1246 1;#
1247 ###