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 Data::Dumper;
  24 use File::Basename qw | basename dirname|;
  25 use File::Copy;
  26 use File::Slurp;
  27 use File::Spec::Functions;
  28 use Digest::MD5;
  29 use List::MoreUtils qw /any /;
  30 use Bio::GeneticRelationships::Pedigree;
  31 use Bio::GeneticRelationships::Individual;
  32 use CXGN::UploadFile;
  33 use CXGN::Pedigree::AddCrosses;
  34 use CXGN::Pedigree::AddProgeny;
  35 use CXGN::Pedigree::AddCrossInfo;
  36 use CXGN::Pedigree::ParseUpload;
  37 use CXGN::Trial::Folder;
  38 use Carp;
  39 use File::Path qw(make_path);
  40 use File::Spec::Functions qw / catfile catdir/;
  41 use CXGN::Cross;
  42
  43 BEGIN { extends 'Catalyst::Controller::REST' }
  44
  45 __PACKAGE__->config(
  46     default   => 'application/json',
  47     stash_key => 'rest',
  48     map       => { 'application/json' => 'JSON', 'text/html' => 'JSON' },
  49    );
  50
  51 sub upload_cross_file : Path('/ajax/cross/upload_crosses_file') : ActionClass('REST') { }
  52
  53 sub upload_cross_file_POST : Args(0) {
  54   my ($self, $c) = @_;
  55   my $chado_schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
  56   my $metadata_schema = $c->dbic_schema("CXGN::Metadata::Schema");
  57   my $phenome_schema = $c->dbic_schema("CXGN::Phenome::Schema");
  58   my $dbh = $c->dbc->dbh;
  59   my $program = $c->req->param('cross_upload_breeding_program');
  60   my $location = $c->req->param('cross_upload_location');
  61   my $upload = $c->req->upload('crosses_upload_file');
  62   my $prefix = $c->req->param('upload_prefix');
  63   my $suffix = $c->req->param('upload_suffix');
  64   my $uploader = CXGN::UploadFile->new();
  65   my $parser;
  66   my $parsed_data;
  67   my $upload_original_name = $upload->filename();
  68   my $upload_tempfile = $upload->tempname;
  69   my $subdirectory = "cross_upload";
  70   my $archived_filename_with_path;
  71   my $md5;
  72   my $validate_file;
  73   my $parsed_file;
  74   my $parse_errors;
  75   my %parsed_data;
  76   my %upload_metadata;
  77   my $time = DateTime->now();
  78   my $timestamp = $time->ymd()."_".$time->hms();
  79   my $user_id;
  80   my $owner_name;
  81   my $upload_file_type = "crosses excel";#get from form when more options are added
  82
  83   if (!$c->user()) {
  84     print STDERR "User not logged in... not adding a crosses.\n";
  85     $c->stash->{rest} = {error => "You need to be logged in to add a cross." };
  86     return;
  87   }
  88   $user_id = $c->user()->get_object()->get_sp_person_id();
  89
  90   $owner_name = $c->user()->get_object()->get_username();
  91
  92   ## Store uploaded temporary file in archive
  93   $archived_filename_with_path = $uploader->archive($c, $subdirectory, $upload_tempfile, $upload_original_name, $timestamp);
  94   $md5 = $uploader->get_md5($archived_filename_with_path);
  95   if (!$archived_filename_with_path) {
  96       $c->stash->{rest} = {error => "Could not save file $upload_original_name in archive",};
  97       return;
  98   }
  99   unlink $upload_tempfile;
 100
 101   $upload_metadata{'archived_file'} = $archived_filename_with_path;
 102   $upload_metadata{'archived_file_type'}="cross upload file";
 103   $upload_metadata{'user_id'}=$user_id;
 104   $upload_metadata{'date'}="$timestamp";
 105
 106   #parse uploaded file with appropriate plugin
 107   $parser = CXGN::Pedigree::ParseUpload->new(chado_schema => $chado_schema, filename => $archived_filename_with_path);
 108   $parser->load_plugin('CrossesExcelFormat');
 109   $parsed_data = $parser->parse();
 110
 111   if (!$parsed_data) {
 112     my $return_error = '';
 113
 114     if (! $parser->has_parse_errors() ){
 115       $return_error = "Could not get parsing errors";
 116       $c->stash->{rest} = {error_string => $return_error,};
 117     }
 118
 119     else {
 120       $parse_errors = $parser->get_parse_errors();
 121       foreach my $error_string (@{$parse_errors}){
 122         $return_error=$return_error.$error_string."<br>";
 123       }
 124     }
 125
 126     $c->stash->{rest} = {error_string => $return_error,};
 127     return;
 128   }
 129
 130   my $cross_add = CXGN::Pedigree::AddCrosses
 131     ->new({
 132            chado_schema => $chado_schema,
 133            phenome_schema => $phenome_schema,
 134            metadata_schema => $metadata_schema,
 135            dbh => $dbh,
 136            location => $location,
 137            program => $program,
 138            crosses =>  $parsed_data->{crosses},
 139            owner_name => $owner_name,
 140           });
 141
 142   #validate the crosses
 143   if (!$cross_add->validate_crosses()){
 144     $c->stash->{rest} = {error_string => "Error validating crosses",};
 145     return;
 146   }
 147
 148   #add the crosses
 149   if (!$cross_add->add_crosses()){
 150     $c->stash->{rest} = {error_string => "Error adding crosses",};
 151     return;
 152   }
 153
 154   #add the progeny
 155   foreach my $cross_name_key (keys %{$parsed_data->{progeny}}){
 156     my $progeny_number = $parsed_data->{progeny}->{$cross_name_key};
 157     my $progeny_increment = 1;
 158     my @progeny_names;
 159
 160     #create array of progeny names to add for this cross
 161     while ($progeny_increment < $progeny_number + 1) {
 162       $progeny_increment = sprintf "%03d", $progeny_increment;
 163       my $stock_name = $cross_name_key.$prefix.$progeny_increment.$suffix;
 164       push @progeny_names, $stock_name;
 165       $progeny_increment++;
 166     }
 167
 168     #add array of progeny to the cross
 169     my $progeny_add = CXGN::Pedigree::AddProgeny
 170       ->new({
 171              chado_schema => $chado_schema,
 172              phenome_schema => $phenome_schema,
 173              dbh => $dbh,
 174              cross_name => $cross_name_key,
 175              progeny_names => \@progeny_names,
 176              owner_name => $owner_name,
 177             });
 178     if (!$progeny_add->add_progeny()){
 179       $c->stash->{rest} = {error_string => "Error adding progeny",};
 180       #should delete crosses and other progeny if add progeny fails?
 181       return;
 182     }
 183   }
 184
 185   #add the number of flowers to crosses
 186   foreach my $cross_name_key (keys %{$parsed_data->{flowers}}) {
 187     my $number_of_flowers = $parsed_data->{flowers}->{$cross_name_key};
 188     my $cross_add_info = CXGN::Pedigree::AddCrossInfo->new({ chado_schema => $chado_schema, cross_name => $cross_name_key} );
 189     $cross_add_info->set_number_of_flowers($number_of_flowers);
 190     $cross_add_info->add_info();
 191   }
 192
 193   #add the number of seeds to crosses
 194   foreach my $cross_name_key (keys %{$parsed_data->{seeds}}) {
 195     my $number_of_seeds = $parsed_data->{seeds}->{$cross_name_key};
 196     my $cross_add_info = CXGN::Pedigree::AddCrossInfo->new({ chado_schema => $chado_schema, cross_name => $cross_name_key} );
 197     $cross_add_info->set_number_of_seeds($number_of_seeds);
 198     $cross_add_info->add_info();
 199   }
 200
 201   $c->stash->{rest} = {success => "1",};
 202 }
 203
 204
 205 sub add_cross : Local : ActionClass('REST') { }
 206
 207 sub add_cross_POST :Args(0) {
 208     my ($self, $c) = @_;
 209     my $chado_schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 210     my $metadata_schema = $c->dbic_schema("CXGN::Metadata::Schema");
 211     my $phenome_schema = $c->dbic_schema("CXGN::Phenome::Schema");
 212     my $dbh = $c->dbc->dbh;
 213     my $cross_name = $c->req->param('cross_name');
 214     my $cross_type = $c->req->param('cross_type');
 215     my $program = $c->req->param('program');
 216     my $location = $c->req->param('location');
 217     my $maternal = $c->req->param('maternal_parent');
 218     my $paternal = $c->req->param('paternal_parent');
 219     my $prefix = $c->req->param('prefix');
 220     my $suffix = $c->req->param('suffix');
 221     my $progeny_number = $c->req->param('progeny_number');
 222     my $number_of_flowers = $c->req->param('number_of_flowers');
 223     my $number_of_seeds = $c->req->param('number_of_seeds');
 224     my $visible_to_role = $c->req->param('visible_to_role');
 225     my $parent_folder_id = $c->req->param('folder_id');
 226     my $cross_add;
 227     my $progeny_add;
 228     my @progeny_names;
 229     my @array_of_pedigree_objects;
 230     my $progeny_increment = 1;
 231     my $paternal_parent_not_required;
 232     my $number_of_flowers_cvterm;
 233     my $number_of_seeds_cvterm;
 234     my $owner_name;
 235
 236     if ($cross_type eq "open" || $cross_type eq "bulk_open") {
 237       $paternal_parent_not_required = 1;
 238     }
 239
 240     print STDERR "Adding Cross... Maternal: $maternal Paternal: $paternal Cross Type: $cross_type\n";
 241
 242     if (!$c->user()) {
 243         print STDERR "User not logged in... not adding a cross.\n";
 244         $c->stash->{rest} = {error => "You need to be logged in to add a cross." };
 245         return;
 246     }
 247
 248     $owner_name = $c->user()->get_object()->get_username();
 249
 250     if (!any { $_ eq "curator" || $_ eq "submitter" } ($c->user()->roles)  ) {
 251         print STDERR "User does not have sufficient privileges.\n";
 252         $c->stash->{rest} = {error =>  "you have insufficient privileges to add a cross." };
 253         return;
 254     }
 255
 256     #check that progeny number is an integer less than maximum allowed
 257     my $maximum_progeny_number = 999; #higher numbers break cross name convention
 258     if ($progeny_number) {
 259       if ((! $progeny_number =~ m/^\d+$/) or ($progeny_number > $maximum_progeny_number) or ($progeny_number < 1)) {
 260         $c->stash->{rest} = {error =>  "progeny number exceeds the maximum of $maximum_progeny_number or is invalid." };
 261         return;
 262       }
 263     }
 264
 265     #check that maternal name is not blank
 266     if ($maternal eq "") {
 267       $c->stash->{rest} = {error =>  "maternal parent name cannot be blank." };
 268       return;
 269     }
 270
 271     #if required, check that paternal parent name is not blank;
 272     if ($paternal eq "" && !$paternal_parent_not_required) {
 273       $c->stash->{rest} = {error =>  "paternal parent name cannot be blank." };
 274       return;
 275     }
 276
 277     #check that parents exist in the database
 278     if (! $chado_schema->resultset("Stock::Stock")->find({name=>$maternal,})){
 279       $c->stash->{rest} = {error =>  "maternal parent does not exist." };
 280       return;
 281     }
 282
 283     if (!$paternal_parent_not_required) {
 284       if (! $chado_schema->resultset("Stock::Stock")->find({name=>$paternal,})){
 285         $c->stash->{rest} = {error =>  "paternal parent does not exist." };
 286         return;
 287       }
 288     }
 289
 290     #check that cross name does not already exist
 291     if ($chado_schema->resultset("Stock::Stock")->find({name=>$cross_name})){
 292       $c->stash->{rest} = {error =>  "cross name already exists." };
 293       return;
 294     }
 295
 296     #check that progeny do not already exist
 297     if ($chado_schema->resultset("Stock::Stock")->find({name=>$cross_name.$prefix.'001'.$suffix,})){
 298       $c->stash->{rest} = {error =>  "progeny already exist." };
 299       return;
 300     }
 301
 302     #objects to store cross information
 303     my $cross_to_add = Bio::GeneticRelationships::Pedigree->new(name => $cross_name, cross_type => $cross_type);
 304     my $female_individual = Bio::GeneticRelationships::Individual->new(name => $maternal);
 305     $cross_to_add->set_female_parent($female_individual);
 306
 307     if (!$paternal_parent_not_required){
 308       my $male_individual = Bio::GeneticRelationships::Individual->new(name => $paternal);
 309       $cross_to_add->set_male_parent($male_individual);
 310     }
 311
 312
 313     $cross_to_add->set_cross_type($cross_type);
 314     $cross_to_add->set_name($cross_name);
 315
 316     eval {
 317         #create array of pedigree objects to add, in this case just one pedigree
 318         @array_of_pedigree_objects = ($cross_to_add);
 319         $cross_add = CXGN::Pedigree::AddCrosses
 320             ->new({
 321                 chado_schema => $chado_schema,
 322                 phenome_schema => $phenome_schema,
 323                 #metadata_schema => $metadata_schema,
 324                 dbh => $dbh,
 325                 location => $location,
 326                 program => $program,
 327                 crosses =>  \@array_of_pedigree_objects,
 328                 owner_name => $owner_name,
 329     parent_folder_id => $parent_folder_id
 330                   });
 331
 332
 333         #add the crosses
 334         $cross_add->add_crosses();
 335     };
 336     if ($@) {
 337         $c->stash->{rest} = { error => "Error creating the cross: $@" };
 338         return;
 339     }
 340
 341     eval {
 342         #create progeny if specified
 343         if ($progeny_number) {
 344
 345             #create array of progeny names to add for this cross
 346             while ($progeny_increment < $progeny_number + 1) {
 347                 $progeny_increment = sprintf "%03d", $progeny_increment;
 348                 my $stock_name = $cross_name.$prefix.$progeny_increment.$suffix;
 349                 push @progeny_names, $stock_name;
 350                 $progeny_increment++;
 351             }
 352
 353             #add array of progeny to the cross
 354             $progeny_add = CXGN::Pedigree::AddProgeny
 355                 ->new({
 356                     chado_schema => $chado_schema,
 357                     phenome_schema => $phenome_schema,
 358                     dbh => $dbh,
 359                     cross_name => $cross_name,
 360                     progeny_names => \@progeny_names,
 361                     owner_name => $owner_name,
 362                       });
 363             $progeny_add->add_progeny();
 364
 365         }
 366
 367         #add number of flowers as an experimentprop if specified
 368         if ($number_of_flowers) {
 369             my $cross_add_info = CXGN::Pedigree::AddCrossInfo->new({ chado_schema => $chado_schema, cross_name => $cross_name} );
 370             $cross_add_info->set_number_of_flowers($number_of_flowers);
 371             $cross_add_info->add_info();
 372         }
 373
 374         #add number of seeds as an experimentprop if specified
 375         if ($number_of_seeds) {
 376             my $cross_add_info = CXGN::Pedigree::AddCrossInfo->new({ chado_schema => $chado_schema, cross_name => $cross_name} );
 377             $cross_add_info->set_number_of_seeds($number_of_seeds);
 378             $cross_add_info->add_info();
 379         }
 380
 381     };
 382     if ($@) {
 383         $c->stash->{rest} = { error => "An error occurred: $@"};
 384         return;
 385     }
 386
 387     $c->stash->{rest} = { error => '', };
 388   }
 389
 390 sub get_cross_relationships :Path('/cross/ajax/relationships') :Args(1) {
 391     my $self = shift;
 392     my $c = shift;
 393     my $cross_id = shift;
 394
 395     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 396
 397     my $cross = $schema->resultset("Stock::Stock")->find( { stock_id => $cross_id });
 398
 399     if ($cross && $cross->type()->name() ne "cross") {
 400         $c->stash->{rest} = { error => 'This entry is not of type cross and cannot be displayed using this page.' };
 401         return;
 402     }
 403
 404     my $cross_obj = CXGN::Cross->new({bcs_schema=>$schema, cross_stock_id=>$cross_id});
 405     my ($maternal_parent, $paternal_parent, $progeny) = $cross_obj->get_cross_relationships();
 406
 407     $c->stash->{rest} = {
 408         maternal_parent => $maternal_parent,
 409         paternal_parent => $paternal_parent,
 410         progeny => $progeny,
 411     };
 412 }
 413
 414
 415 sub get_cross_properties :Path('/cross/ajax/properties') Args(1) {
 416     my $self = shift;
 417     my $c = shift;
 418     my $cross_id = shift;
 419
 420     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 421
 422     my $rs = $schema->resultset("NaturalDiversity::NdExperimentprop")->search( { 'nd_experiment_stocks.stock_id' => $cross_id }, { join => { 'nd_experiment' =>  'nd_experiment_stocks' }});
 423
 424     my $props = {};
 425
 426     print STDERR "PROPS LEN ".$rs->count()."\n";
 427
 428     while (my $prop = $rs->next()) {
 429         push @{$props->{$prop->type->name()}}, [ $prop->get_column('value'), $prop->get_column('nd_experimentprop_id') ];
 430     }
 431
 432     print STDERR Dumper($props);
 433     $c->stash->{rest} = { props => $props };
 434
 435
 436 }
 437
 438 sub save_property_check :Path('/cross/property/check') Args(1) {
 439     my $self = shift;
 440     my $c = shift;
 441     my $cross_id = shift;
 442
 443     my $type = $c->req->param("type");
 444     my $value = $c->req->param("value");
 445
 446
 447     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 448     my $type_row = $schema->resultset('Cv::Cvterm')->find( { name => $type } );
 449
 450     if (! $type_row) {
 451         $c->stash->{rest} = { error => "The type '$type' does not exist in the database" };
 452         return;
 453     }
 454
 455     my $type_id = $type_row->cvterm_id();
 456
 457     my %suggested_values = (
 458         cross_type =>  { 'biparental'=>1, 'self'=>1, 'open pollinated'=>1, 'bulk'=>1, 'bulk selfed'=>1, 'bulk and open pollinated'=>1, 'doubled haplotype'=>1 },
 459         number_of_flowers => '\d+',
 460         number_of_seeds => '\d+',
 461         date => '\d{4}\\/\d{2}\\/\d{2}',
 462         time => '\d+\:\d+',
 463         operator => '.*',
 464         cross_name => '.*',
 465         );
 466
 467     my %example_values = (
 468         date => '2014/03/29',
 469         time => '10:00',
 470         number_of_flowers => 23,
 471         number_of_seeds => 42,
 472         operator => 'Alfonso',
 473         cross_name => 'nextgen_cross',
 474         );
 475
 476     if (ref($suggested_values{$type})) {
 477         if (!exists($suggested_values{$type}->{$value})) { # don't make this case insensitive!
 478             $c->stash->{rest} =  { message => 'The provided value is not in the suggested list of terms. This could affect downstream data processing.' };
 479             return;
 480         }
 481     }
 482     else {
 483         if ($value !~ m/^$suggested_values{$type}$/) {
 484             $c->stash->{rest} = { error => 'The provided value is not of the correct type. Format example: "'.$example_values{$type}.'"' };
 485             return;
 486         }
 487     }
 488     $c->stash->{rest} = { success => 1 };
 489 }
 490
 491 sub cross_property_save :Path('/cross/property/save') Args(1) {
 492     my $self = shift;
 493     my $c = shift;
 494
 495     if (!$c->user()) {
 496         $c->stash->{rest} = { error => "You must be logged in add properties." };
 497         return;
 498     }
 499     if (!($c->user()->has_role('submitter') or $c->user()->has_role('curator'))) {
 500         $c->stash->{rest} = { error => "You do not have sufficient privileges to add properties." };
 501         return;
 502     }
 503
 504     my $cross_id = $c->req->param("cross_id");
 505     my $type  = $c->req->param("type");
 506     my $value    = $c->req->param("value");
 507
 508     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 509
 510     my $exp_id = $schema->resultset("NaturalDiversity::NdExperiment")->search( { 'nd_experiment_stocks.stock_id' => $cross_id }, { join => 'nd_experiment_stocks' })->first()->get_column('nd_experiment_id');
 511
 512     my $type_id;
 513     my $type_row = $schema->resultset("Cv::Cvterm")->find( { 'me.name' => $type, 'cv.name' => 'nd_experiment_property' }, { join => { 'cv'}});
 514     if ($type_row) {
 515         $type_id = $type_row->cvterm_id();
 516     }
 517     else {
 518         $c->stash->{rest} = { error => "The type $type does not exist in the database." };
 519         return;
 520     }
 521
 522     my $rs = $schema->resultset("NaturalDiversity::NdExperimentprop")->search( { 'nd_experiment_stocks.stock_id' => $cross_id, 'me.type_id' => $type_id }, { join => { 'nd_experiment' => { 'nd_experiment_stocks' }}});
 523
 524     my $row = $rs->first();
 525     if (!$row) {
 526         $row = $schema->resultset("NaturalDiversity::NdExperimentprop")->create( { 'nd_experiment_stocks.stock_id' => $cross_id, 'me.type_id' => $type_id, 'me.value'=>$value, 'me.nd_experiment_id' => $exp_id }, { join => {'nd_experiment' => {'nd_experiment_stocks' }}});
 527         $row->insert();
 528     }
 529     else {
 530
 531         $row->set_column( 'value' => $value );
 532         $row->update();
 533     }
 534
 535     $c->stash->{rest} = { success => 1 };
 536 }
 537
 538
 539 sub add_more_progeny :Path('/cross/progeny/add') Args(1) {
 540     my $self = shift;
 541     my $c = shift;
 542     my $cross_id = shift;
 543
 544     if (!$c->user()) {
 545         $c->stash->{rest} = { error => "You must be logged in add progeny." };
 546         return;
 547     }
 548     if (!($c->user()->has_role('submitter') or $c->user()->has_role('curator'))) {
 549         $c->stash->{rest} = { error => "You do not have sufficient privileges to add progeny." };
 550         return;
 551     }
 552
 553     my $basename = $c->req->param("basename");
 554     my $start_number = $c->req->param("start_number");
 555     my $progeny_count = $c->req->param("progeny_count");
 556     my $cross_name = $c->req->param("cross_name");
 557
 558     my @progeny_names = ();
 559     foreach my $n (1..$progeny_count) {
 560         push @progeny_names, $basename. (sprintf "%03d", $n + $start_number -1);
 561     }
 562
 563     print STDERR Dumper(\@progeny_names);
 564
 565     my $chado_schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 566     my $metadata_schema = $c->dbic_schema("CXGN::Metadata::Schema");
 567     my $phenome_schema = $c->dbic_schema("CXGN::Phenome::Schema");
 568     my $dbh = $c->dbc->dbh;
 569
 570     my $owner_name = $c->user()->get_object()->get_username();
 571
 572     my $progeny_add = CXGN::Pedigree::AddProgeny
 573         ->new({
 574             chado_schema => $chado_schema,
 575             phenome_schema => $phenome_schema,
 576             dbh => $dbh,
 577             cross_name => $cross_name,
 578             progeny_names => \@progeny_names,
 579             owner_name => $owner_name,
 580               });
 581     if (!$progeny_add->add_progeny()){
 582       $c->stash->{rest} = {error_string => "Error adding progeny. Please change the input parameters and try again.",};
 583       #should delete crosses and other progeny if add progeny fails?
 584       return;
 585     }
 586
 587     $c->stash->{rest} = { success => 1};
 588
 589 }
 590
 591 sub get_crosses_with_folders : Path('/ajax/breeders/get_crosses_with_folders') Args(0) {
 592     my $self = shift;
 593     my $c = shift;
 594
 595     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 596     my $p = CXGN::BreedersToolbox::Projects->new( { schema => $schema  } );
 597
 598     my $projects = $p->get_breeding_programs();
 599
 600     my $html = "";
 601     foreach my $project (@$projects) {
 602            my $folder = CXGN::Trial::Folder->new( { bcs_schema => $schema, folder_id => $project->[0] });
 603            $html .= $folder->get_jstree_html('breeding_program', 'cross');
 604     }
 605
 606     my $dir = catdir($c->site_cluster_shared_dir, "folder");
 607     eval { make_path($dir) };
 608     if ($@) {
 609         print "Couldn't create $dir: $@";
 610     }
 611     my $filename = $dir."/entire_crosses_jstree_html.txt";
 612
 613     my $OUTFILE;
 614     open $OUTFILE, '>', $filename or die "Error opening $filename: $!";
 615     print { $OUTFILE } $html or croak "Cannot write to $filename: $!";
 616     close $OUTFILE or croak "Cannot close $filename: $!";
 617
 618     $c->stash->{rest} = { status => 1 };
 619 }
 620
 621 sub get_crosses_with_folders_cached : Path('/ajax/breeders/get_crosses_with_folders_cached') Args(0) {
 622     my $self = shift;
 623     my $c = shift;
 624
 625     my $dir = catdir($c->site_cluster_shared_dir, "folder");
 626     my $filename = $dir."/entire_crosses_jstree_html.txt";
 627     my $html = '';
 628     open(my $fh, '<', $filename) or die "cannot open file $filename";
 629     {
 630         local $/;
 631         $html = <$fh>;
 632     }
 633     close($fh);
 634
 635     #print STDERR $html;
 636     $c->stash->{rest} = { html => $html };
 637 }
 638
 639 ###
 640 1;#
 641 ###