lib/SGN/Controller/AJAX/LabelDesigner.pm

   1 package SGN::Controller::AJAX::LabelDesigner;
   2
   3 use Moose;
   4 use CXGN::Stock;
   5 use CXGN::List::Transform;
   6 use Data::Dumper;
   7 use Try::Tiny;
   8 use JSON;
   9 use Barcode::Code128;
  10 use CXGN::QRcode;
  11 use CXGN::ZPL;
  12 use PDF::API2;
  13 use Sort::Versions;
  14 use Tie::UrlEncoder; our(%urlencode);
  15 use CXGN::Trial::TrialLayout;
  16 use CXGN::Trial;
  17 use CXGN::Trial::TrialLayoutDownload;
  18
  19 BEGIN { extends 'Catalyst::Controller::REST' }
  20
  21 __PACKAGE__->config(
  22     default   => 'application/json',
  23     stash_key => 'rest',
  24     map       => { 'application/json' => 'JSON', 'text/html' => 'JSON' },
  25    );
  26
  27    sub retrieve_longest_fields :Path('/tools/label_designer/retrieve_longest_fields') {
  28         my $self = shift;
  29         my $c = shift;
  30         my $schema = $c->dbic_schema('Bio::Chado::Schema');
  31         my $data_type = $c->req->param("data_type");
  32         my $value = $c->req->param("value");
  33         my $data_level = $c->req->param("data_level");
  34         my %longest_hash;
  35         print STDERR "Data type is $data_type and id is $value\n";
  36
  37         my ($trial_num, $trial_id, $plot_design, $plant_design, $subplot_design, $tissue_sample_design) = get_plot_data($c, $schema, $data_type, $value);
  38
  39        #if plant ids exist, use plant design
  40        my $design = $plot_design;
  41        if ($data_type =~ m/Field Trials/) {
  42            if ($data_level eq 'plants'){
  43                $design = $plant_design;
  44            }
  45            if ($data_level eq 'subplots'){
  46                $design = $subplot_design;
  47            }
  48            if ($data_level eq 'tissue_samples'){
  49                $design = $tissue_sample_design;
  50            }
  51        }
  52
  53
  54        print STDERR "Num plants 3: " . scalar(keys %{$design});
  55        #print STDERR "AFTER SUB: \nTrial_id is $trial_id and design is ". Dumper($design) ."\n";
  56        if ($trial_num > 1) {
  57            $c->stash->{rest} = { error => "The selected list contains plots from more than one trial. This is not supported. Please select a different data source." };
  58            return;
  59        }
  60
  61        my $trial_name = $schema->resultset("Project::Project")->search({ project_id => $trial_id })->first->name();
  62        if (!$trial_name) {
  63            $c->stash->{rest} = { error => "Trial with id $trial_id does not exist. Can't create labels." };
  64            return;
  65        }
  66
  67        my %design = %{$design};
  68        if (!%design) {
  69            $c->stash->{rest} = { error => "Trial $trial_name does not have a valid field design. Can't create labels." };
  70            return;
  71        }
  72        $longest_hash{'trial_name'} = $trial_name;
  73
  74        my $year_cvterm_id = $schema->resultset("Cv::Cvterm")->search({name=> 'project year' })->first->cvterm_id();
  75        my $year = $schema->resultset("Project::Projectprop")->search({ project_id => $trial_id, type_id => $year_cvterm_id } )->first->value();
  76        $longest_hash{'year'} = $year;
  77
  78        my $design_cvterm_id = $schema->resultset("Cv::Cvterm")->search({name=> 'design' })->first->cvterm_id();
  79        my $design_value = $schema->resultset("Project::Projectprop")->search({ project_id => $trial_id, type_id => $design_cvterm_id } )->first->value();
  80        if ($design_value eq "genotyping_plate") { # for genotyping plates, get "Genotyping Facility" and "Genotyping Project Name"
  81            my $genotyping_facility_cvterm_id = $schema->resultset("Cv::Cvterm")->search({name=> 'genotyping_facility' })->first->cvterm_id();
  82            my $geno_project_name_cvterm_id = $schema->resultset("Cv::Cvterm")->search({name=> 'genotyping_project_name' })->first->cvterm_id();
  83            my $genotyping_facility = $schema->resultset("Project::Projectprop")->search({ project_id => $trial_id, type_id => $genotyping_facility_cvterm_id } )->first->value();
  84            my $genotyping_project_name = $schema->resultset("NaturalDiversity::NdExperimentProject")->search({
  85                    project_id => $trial_id
  86                })->search_related('nd_experiment')->search_related('nd_experimentprops',{
  87                    'nd_experimentprops.type_id' => $geno_project_name_cvterm_id
  88                })->first->value();
  89
  90            $longest_hash{'genotyping_project_name'} = $genotyping_project_name;
  91            $longest_hash{'genotyping_facility'} = $genotyping_facility;
  92        }
  93
  94        #get all fields in this trials design
  95        my $random_plot = $design{(keys %design)[rand keys %design]};
  96        my %reps;
  97        my @keys = keys %{$random_plot};
  98        foreach my $field (@keys) {
  99
 100            # if rep_number, find unique options and return them
 101            if ($field eq 'rep_number') {
 102                print STDERR "Searching for unique rep numbers.\n";
 103             #    foreach my $key (keys %design) {
 104                $reps{$_->{'rep_number'}}++ foreach values %design;
 105                print STDERR "Reps: ".Dumper(%reps);
 106            }
 107
 108
 109            print STDERR " Searching for longest $field\n";
 110            #for each field order values by descending length, then save the first one
 111            foreach my $key ( sort { length($design{$b}{$field}) <=> length($design{$a}{$field}) or versioncmp($a, $b) } keys %design) {
 112                 print STDERR "Longest $field is: ".$design{$key}{$field}."\n";
 113                 my $longest = $design{$key}{$field};
 114                 unless (ref($longest) || length($longest) < 1) { # skip if not scalar or undefined
 115                     $longest_hash{$field} = $longest;
 116                 } elsif (ref($longest) eq 'ARRAY') { # if array (ex. plants), sort array by length and take longest
 117                     print STDERR "Processing array " . Dumper($longest) . "\n";
 118                     # my @array = @{$longest};
 119                     my @sorted = sort { length $a <=> length $b } @{$longest};
 120                     if (length($sorted[0]) > 0) {
 121                         $longest_hash{$field} = $sorted[0];
 122                     }
 123                 } elsif (ref($longest) eq 'HASH') {
 124                     print STDERR "Not handling hashes yet\n";
 125                 }
 126                 last;
 127             }
 128         }
 129
 130         # save longest pedigree string
 131         my $pedigree_strings = get_all_pedigrees($schema, \%design);
 132         my %pedigree_strings = %{$pedigree_strings};
 133
 134         foreach my $key ( sort { length($pedigree_strings{$b}) <=> length($pedigree_strings{$a}) } keys %pedigree_strings) {
 135             $longest_hash{'pedigree_string'} = $pedigree_strings{$key};
 136             last;
 137         }
 138
 139         #print STDERR "Dumped data is: ".Dumper(%longest_hash);
 140         $c->stash->{rest} = {
 141             fields => \%longest_hash,
 142             reps => \%reps,
 143         };
 144    }
 145
 146    sub label_designer_download : Path('/tools/label_designer/download') : ActionClass('REST') { }
 147
 148    sub label_designer_download_GET : Args(0) {
 149         my $self = shift;
 150         my $c = shift;
 151         $c->forward('label_designer_download_POST');
 152     }
 153
 154   sub label_designer_download_POST : Args(0) {
 155        my $self = shift;
 156        my $c = shift;
 157        my $schema = $c->dbic_schema('Bio::Chado::Schema');
 158        my $download_type = $c->req->param("download_type");
 159     #    my $trial_id = $c->req->param("trial_id");
 160        my $data_type = $c->req->param("data_type");
 161        my $value = $c->req->param("value");
 162        my $design_json = $c->req->param("design_json");
 163        my $labels_to_download = $c->req->param("labels_to_download") || 10000000000;
 164        my $conversion_factor = 2.83; # for converting from 8 dots per mmm to 2.83 per mm (72 per inch)
 165
 166        # decode json
 167        my $json = new JSON;
 168        my $design_params = $json->allow_nonref->utf8->relaxed->escape_slash->loose->allow_singlequote->allow_barekey->decode($design_json);
 169
 170        my ($trial_num, $trial_id, $plot_design, $plant_design, $subplot_design, $tissue_sample_design) = get_plot_data($c, $schema, $data_type, $value);
 171
 172        #if plant ids or names are used in design params, use plant design
 173
 174        my $design = $plot_design;
 175        my $label_params = $design_params->{'label_elements'};
 176        foreach my $element (@$label_params) {
 177            my %element = %{$element};
 178            my $filled_value = $element{'value'};
 179            print STDERR "Filled value is $filled_value\n";
 180            if ($filled_value =~ m/{plant_id}/ || $filled_value =~ m/{plant_name}/  || $filled_value =~ m/{plant_index_number}/) {
 181                $design = $plant_design;
 182            }
 183            if ($filled_value =~ m/{subplot_id}/ || $filled_value =~ m/{subplot_name}/ || $filled_value =~ m/{subplot_index_number}/) {
 184                $design = $subplot_design;
 185            }
 186            if ($filled_value =~ m/{tissue_sample_id}/ || $filled_value =~ m/{tissue_sample_name}/ || $filled_value =~ m/{tissue_sample_index_number}/) {
 187                $design = $tissue_sample_design;
 188            }
 189        }
 190
 191        if ($trial_num > 1) {
 192            $c->stash->{rest} = { error => "The selected list contains plots from more than one trial. This is not supported. Please select a different data source." };
 193            return;
 194        }
 195
 196         my $trial_name = $schema->resultset("Project::Project")->search({ project_id => $trial_id })->first->name();
 197         if (!$trial_name) {
 198             $c->stash->{rest} = { error => "Trial with id $trial_id does not exist. Can't create labels." };
 199             return;
 200         }
 201        my %design = %{$design};
 202        if (!$design) {
 203            $c->stash->{rest} = { error => "Trial $trial_name does not have a valid field design. Can't create labels." };
 204            return;
 205        }
 206
 207        my $design_cvterm_id = $schema->resultset("Cv::Cvterm")->search({name=> 'design' })->first->cvterm_id();
 208        my $design_value = $schema->resultset("Project::Projectprop")->search({ project_id => $trial_id, type_id => $design_cvterm_id } )->first->value();
 209
 210        my ($genotyping_facility, $genotyping_project_name);
 211        if ($design_value eq "genotyping_plate") { # for genotyping plates, get "Genotyping Facility" and "Genotyping Project Name"
 212            my $genotyping_facility_cvterm_id = $schema->resultset("Cv::Cvterm")->search({name=> 'genotyping_facility' })->first->cvterm_id();
 213            my $geno_project_name_cvterm_id = $schema->resultset("Cv::Cvterm")->search({name=> 'genotyping_project_name' })->first->cvterm_id();
 214            $genotyping_facility = $schema->resultset("Project::Projectprop")->search({ project_id => $trial_id, type_id => $genotyping_facility_cvterm_id } )->first->value();
 215            $genotyping_project_name = $schema->resultset("NaturalDiversity::NdExperimentProject")->search({
 216                    project_id => $trial_id
 217                })->search_related('nd_experiment')->search_related('nd_experimentprops',{
 218                    'nd_experimentprops.type_id' => $geno_project_name_cvterm_id
 219                })->first->value();
 220        }
 221
 222        my $year_cvterm_id = $schema->resultset("Cv::Cvterm")->search({name=> 'project year' })->first->cvterm_id();
 223        my $year = $schema->resultset("Project::Projectprop")->search({ project_id => $trial_id, type_id => $year_cvterm_id } )->first->value();
 224
 225        # if needed retrieve pedigrees in bulk
 226        my $pedigree_strings;
 227        foreach my $element (@$label_params) {
 228            if ($element->{'value'} =~ m/{pedigree_string}/ ) {
 229                $pedigree_strings = get_all_pedigrees($schema, $design);
 230            }
 231        }
 232
 233        # Create a blank PDF file
 234        my $dir = $c->tempfiles_subdir('labels');
 235        my $file_prefix = $trial_name;
 236        $file_prefix =~ s/[^a-zA-Z0-9-_]//g;
 237
 238        my ($FH, $filename) = $c->tempfile(TEMPLATE=>"labels/$file_prefix-XXXXX", SUFFIX=>".$download_type");
 239
 240        # initialize loop variables
 241        my $col_num = 1;
 242        my $row_num = 1;
 243        my $key_number = 0;
 244        my $sort_order = $design_params->{'sort_order'};
 245
 246        if ($download_type eq 'pdf') {
 247            # Create pdf
 248            print STDERR "Creating the PDF . . .\n";
 249            my $pdf  = PDF::API2->new(-file => $FH);
 250            my $page = $pdf->page();
 251            my $text = $page->text();
 252            my $gfx = $page->gfx();
 253            $page->mediabox($design_params->{'page_width'}, $design_params->{'page_height'});
 254
 255            # loop through plot data in design hash
 256            foreach my $key ( sort { versioncmp( $design{$a}{$sort_order} , $design{$b}{$sort_order} ) or  $a <=> $b } keys %design) {
 257
 258                if ($key_number >= $labels_to_download){
 259                    last;
 260                }
 261
 262                 #print STDERR "Design key is $key\n";
 263                 my %design_info = %{$design{$key}};
 264                 $design_info{'trial_name'} = $trial_name;
 265                 $design_info{'year'} = $year;
 266                 $design_info{'genotyping_facility'} = $genotyping_facility;
 267                 $design_info{'genotyping_project_name'} = $genotyping_project_name;
 268                 $design_info{'pedigree_string'} = $pedigree_strings->{$design_info{'accession_name'}};
 269                 #print STDERR "Design info: " . Dumper(%design_info);
 270
 271                 if ( $design_params->{'plot_filter'} eq 'all' || $design_params->{'plot_filter'} eq $design_info{'rep_number'}) { # filter by rep if needed
 272
 273                     for (my $i=0; $i < $design_params->{'copies_per_plot'}; $i++) {
 274                         #print STDERR "Working on label num $i\n";
 275                         my $label_x = $design_params->{'left_margin'} + ($design_params->{'label_width'} + $design_params->{'horizontal_gap'}) * ($col_num-1);
 276                         my $label_y = $design_params->{'page_height'} - $design_params->{'top_margin'} - ($design_params->{'label_height'} + $design_params->{'vertical_gap'}) * ($row_num-1);
 277
 278                        foreach my $element (@$label_params) {
 279                            #print STDERR "Element Dumper\n" . Dumper($element);
 280                            my %element = %{$element};
 281                            my $elementx = $label_x + ( $element{'x'} / $conversion_factor );
 282                            my $elementy = $label_y - ( $element{'y'} / $conversion_factor );
 283
 284                            my $filled_value = $element{'value'};
 285                            print STDERR "Filled value b4: $filled_value";
 286                            $filled_value =~ s/\{(.*?)\}/process_field($1,$key_number,\%design_info)/ge;
 287                            print STDERR "\tFilled value after: $filled_value\n";
 288                            #print STDERR "Element ".$element{'type'}."_".$element{'size'}." filled value is ".$filled_value." and coords are $elementx and $elementy\n";
 289                            #print STDERR "Writing to the PDF . . .\n";
 290                            if ( $element{'type'} eq "Code128" || $element{'type'} eq "QRCode" ) {
 291
 292                                 if ( $element{'type'} eq "Code128" ) {
 293
 294                                    my $barcode_object = Barcode::Code128->new();
 295
 296                                    my ($png_location, $png_uri) = $c->tempfile( TEMPLATE => [ 'barcode', 'bc-XXXXX'], SUFFIX=>'.png');
 297                                    open(PNG, ">", $png_location) or die "Can't write $png_location: $!\n";
 298                                    binmode(PNG);
 299
 300                                    $barcode_object->option("scale", $element{'size'}, "font_align", "center", "padding", 5, "show_text", 0);
 301                                    $barcode_object->barcode($filled_value);
 302                                    my $barcode = $barcode_object->gd_image();
 303                                    print PNG $barcode->png();
 304                                    close(PNG);
 305
 306                                     my $image = $pdf->image_png($png_location);
 307                                     my $height = $element{'height'} / $conversion_factor ; # scale to 72 pts per inch
 308                                     my $width = $element{'width'} / $conversion_factor ; # scale to 72 pts per inch
 309                                     my $elementy = $elementy - ($height/2); # adjust for img position sarting at bottom
 310                                     my $elementx = $elementx - ($width/2);
 311                                     #print STDERR 'adding Code 128 params $image, $elementx, $elementy, $width, $height with: '."$image, $elementx, $elementy, $width, $height\n";
 312                                     $gfx->image($image, $elementx, $elementy, $width, $height);
 313
 314
 315                               } else { #QRCode
 316
 317                                   my ($jpeg_location, $jpeg_uri) = $c->tempfile( TEMPLATE => [ 'barcode', 'bc-XXXXX'], SUFFIX=>'.jpg');
 318                                   my $barcode_generator = CXGN::QRcode->new(
 319                                       text => $filled_value,
 320                                       size => $element{'size'},
 321                                       margin => 0,
 322                                       version => 0,
 323                                       level => 'M'
 324                                   );
 325                                   my $barcode_file = $barcode_generator->get_barcode_file($jpeg_location);
 326
 327                                    my $image = $pdf->image_jpeg($jpeg_location);
 328                                    my $height = $element{'height'} / $conversion_factor ; # scale to 72 pts per inch
 329                                    my $width = $element{'width'} / $conversion_factor ; # scale to 72 pts per inch
 330                                    my $elementy = $elementy - ($height/2); # adjust for img position sarting at bottom
 331                                    my $elementx = $elementx - ($width/2);
 332                                    $gfx->image($image, $elementx, $elementy, $width, $height);
 333
 334                               }
 335                            }
 336                            else { #Text
 337
 338                                 my $font = $pdf->corefont($element{'font'}); # Add a built-in font to the PDF
 339                                 # Add text to the page
 340                                 my $adjusted_size = $element{'size'} / $conversion_factor; # scale to 72 pts per inch
 341                                 $text->font($font, $adjusted_size);
 342                                 my $height = $element{'height'} / $conversion_factor ; # scale to 72 pts per inch
 343                                 my $elementy = $elementy - ($height/4); # adjust for img position starting at bottom
 344                                 $text->translate($elementx, $elementy);
 345                                 $text->text_center($filled_value);
 346                            }
 347                        }
 348
 349                         if ($col_num < $design_params->{'number_of_columns'}) { #next column
 350                             $col_num++;
 351                         } else { #new row, reset col num
 352                             $col_num = 1;
 353                             $row_num++;
 354                         }
 355
 356                         if ($row_num > $design_params->{'number_of_rows'}) { #create new page and reset row and col num
 357                             $pdf->finishobjects($page, $gfx, $text); #flush the page to save memory on big PDFs
 358                             $page = $pdf->page();
 359                             $text = $page->text();
 360                             $gfx = $page->gfx();
 361                             $page->mediabox($design_params->{'page_width'}, $design_params->{'page_height'});
 362                             $row_num = 1;
 363                         }
 364                     }
 365                 }
 366              $key_number++;
 367              }
 368
 369            print STDERR "Saving the PDF . . .\n";
 370            $pdf->save();
 371
 372        } elsif ($download_type eq 'zpl') {
 373
 374            print STDERR "Generating zpl . . .\n";
 375            my $zpl_obj = CXGN::ZPL->new(
 376                print_width => $design_params->{'label_width'} * $conversion_factor,
 377                label_length => $design_params->{'label_height'} * $conversion_factor
 378            );
 379            $zpl_obj->start_sequence();
 380            $zpl_obj->label_format();
 381            foreach my $element (@$label_params) {
 382                my $x = $element->{'x'} - ($element->{'width'}/2);
 383                my $y = $element->{'y'} - ($element->{'height'}/2);
 384                $zpl_obj->new_element($element->{'type'}, $x, $y, $element->{'size'}, $element->{'value'});
 385            }
 386            $zpl_obj->end_sequence();
 387            my $zpl_template = $zpl_obj->render();
 388            foreach my $key ( sort { versioncmp( $design{$a}{$sort_order} , $design{$b}{$sort_order} ) or  $a <=> $b } keys %design) {
 389
 390                if ($key_number >= $labels_to_download){
 391                    last;
 392                }
 393
 394             #    print STDERR "Design key is $key\n";
 395                my %design_info = %{$design{$key}};
 396                $design_info{'trial_name'} = $trial_name;
 397                $design_info{'year'} = $year;
 398                $design_info{'pedigree_string'} = $pedigree_strings->{$design_info{'accession_name'}};
 399
 400                my $zpl = $zpl_template;
 401                $zpl =~ s/\{(.*?)\}/process_field($1,$key_number,\%design_info)/ge;
 402               for (my $i=0; $i < $design_params->{'copies_per_plot'}; $i++) {
 403                   print $FH $zpl;
 404                }
 405             $key_number++;
 406             }
 407        }
 408
 409        close($FH);
 410        print STDERR "Returning with filename . . .\n";
 411        $c->stash->{rest} = {
 412            filename => $urlencode{$filename},
 413            filepath => $c->config->{basepath}."/".$filename
 414        };
 415
 416    }
 417
 418 sub process_field {
 419     my $field = shift;
 420     my $key_number = shift;
 421     my $design_info = shift;
 422     my %design_info = %{$design_info};
 423     #print STDERR "Field is $field\n";
 424     if ($field =~ m/Number:/) {
 425         our ($placeholder, $start_num, $increment) = split ':', $field;
 426         my $length = length($start_num);
 427         #print STDERR "Increment is $increment\nKey Number is $key_number\n";
 428         my $custom_num =  $start_num + ($increment * $key_number);
 429         return sprintf("%0${length}d", $custom_num);
 430     } else {
 431         return $design_info{$field};
 432     }
 433 }
 434
 435 sub get_all_pedigrees {
 436     my $schema = shift;
 437     my $design = shift;
 438     my %design = %{$design};
 439
 440     # collect all unique accession ids for pedigree retrieval
 441     my %accession_id_hash;
 442     foreach my $key (keys %design) {
 443         $accession_id_hash{$design{$key}{'accession_id'}} = $design{$key}{'accession_name'};
 444     }
 445     my @accession_ids = keys %accession_id_hash;
 446
 447     # retrieve pedigree info using batch download (fastest method), then extract pedigree strings from download rows.
 448     my $stock = CXGN::Stock->new ( schema => $schema);
 449     my $pedigree_rows = $stock->get_pedigree_rows(\@accession_ids, 'parents_only');
 450     my %pedigree_strings;
 451     foreach my $row (@$pedigree_rows) {
 452         my ($progeny, $female_parent, $male_parent, $cross_type) = split "\t", $row;
 453         my $string = join ('/', $female_parent ? $female_parent : 'NA', $male_parent ? $male_parent : 'NA');
 454         $pedigree_strings{$progeny} = $string;
 455     }
 456     return \%pedigree_strings;
 457 }
 458
 459 sub get_plot_data {
 460     my $c = shift;
 461     my $schema = shift;
 462     my $data_type = shift;
 463     my $value = shift;
 464     my $num_trials = 1;
 465     my ($trial_id, $plot_design, $plant_design, $subplot_design, $tissue_sample_design);
 466
 467     # print STDERR "Data type is $data_type and value is $value\n";
 468
 469     if ($data_type =~ m/Plant List/) {
 470     }
 471     elsif ($data_type =~ m/Plot List/) {
 472         # get items from list, get trial id from plot id. Or, get plot data one by one
 473         my $plot_data = SGN::Controller::AJAX::List->retrieve_list($c, $value);
 474         my @plot_list = map { $_->[1] } @$plot_data;
 475         my $t = CXGN::List::Transform->new();
 476         my $acc_t = $t->can_transform("plots", "plot_ids");
 477         my $plot_id_hash = $t->transform($schema, $acc_t, \@plot_list);
 478         my @plot_ids = @{$plot_id_hash->{transform}};
 479         my $trial_rs = $schema->resultset("NaturalDiversity::NdExperimentStock")->search({
 480             stock_id => { -in => \@plot_ids }
 481         })->search_related('nd_experiment')->search_related('nd_experiment_projects');
 482         my %trials = ();
 483         while (my $row = $trial_rs->next()) {
 484             print STDERR "Looking at id ".$row->project_id()."\n";
 485             my $id = $row->project_id();
 486             $trials{$id} = 1;
 487         }
 488         $num_trials = scalar keys %trials;
 489         print STDERR "Count is $num_trials\n";
 490         $trial_id = $trial_rs->first->project_id();
 491         my $full_design = CXGN::Trial::TrialLayout->new({schema => $schema, trial_id => $trial_id, experiment_type=>'field_layout' })->get_design();
 492         #print STDERR "Full Design is: ".Dumper($full_design);
 493         # reduce design hash, removing plots that aren't in list
 494         my %full_design = %{$full_design};
 495
 496         foreach my $i (0 .. $#plot_ids) {
 497             foreach my $key (keys %full_design) {
 498                 if ($full_design{$key}->{'plot_id'} eq $plot_ids[$i]) {
 499                     print STDERR "Plot name is ".$full_design{$key}->{'plot_name'}."\n";
 500                     $plot_design->{$key} = $full_design{$key};
 501                     $plot_design->{$key}->{'list_order'} = $i;
 502                 }
 503             }
 504         }
 505
 506     }
 507     elsif ($data_type =~ m/Genotyping Plate/) {
 508         $trial_id = $value;
 509         $plot_design = CXGN::Trial::TrialLayout->new({schema => $schema, trial_id => $trial_id, experiment_type=>'genotyping_layout' })->get_design();
 510     }
 511     elsif ($data_type =~ m/Field Trials/) {
 512         $trial_id = $value;
 513         my $trial = CXGN::Trial->new({ bcs_schema => $schema, trial_id => $trial_id });
 514         my $trial_has_plant_entries = $trial->has_plant_entries;
 515         my $trial_has_subplot_entries = $trial->has_subplot_entries;
 516         my $trial_has_tissue_sample_entries = $trial->has_tissue_sample_entries;
 517         #$plot_design = CXGN::Trial::TrialLayout->new({schema => $schema, trial_id => $trial_id, experiment_type=>'field_layout' })->get_design();
 518
 519         my $trial = CXGN::Trial->new({ bcs_schema => $schema, trial_id => $trial_id });
 520         my $data = $trial->get_treatments();
 521         my $trial_layout_download = CXGN::Trial::TrialLayoutDownload->new({
 522             schema => $schema,
 523             trial_id => $trial_id,
 524             data_level => 'plots',
 525             treatment_project_ids => $self->data,
 526             selected_columns => {"plot_name":1,"plot_id":1,"block_number":1,"plot_number":1,"rep_number":1,"row_number":1,"col_number":1,"accession_name":1,"is_a_control":1,"synonyms":1,"trial_name":1,"location_name":1,"year":1,"pedigree":1,"tier":1,"seedlot_name":1,"seed_transaction_operator":1,"num_seed_per_plot":1,"range_number":1,"plot_geo_json":1},
 527             selected_trait_ids => []
 528         });
 529         $plot_design = $trial_layout_download->get_layout_output();
 530
 531         my @plot_ids = keys %{$plot_design};
 532         if ($trial_has_plant_entries) {
 533             foreach my $plot_id (keys %$plot_design) {
 534                 my @plant_ids = @{$plot_design->{$plot_id}->{'plant_ids'}};
 535                 my @plant_names = @{$plot_design->{$plot_id}->{'plant_names'}};
 536                 my @plant_index_numbers = @{$plot_design->{$plot_id}->{'plant_index_numbers'}};
 537                 my %plant_tissue_samples = %{$plot_design->{$plot_id}->{'plants_tissue_sample_names'}};
 538                 for (my $i=0; $i < scalar(@plant_ids); $i++) {
 539                     my $plant_id = $plant_ids[$i];
 540                     my $plant_name = $plant_names[$i];
 541                     foreach my $property (keys %{$plot_design->{$plot_id}}) { $plant_design->{$plant_id}->{$property} = $plot_design->{$plot_id}->{$property}; }
 542                     $plant_design->{$plant_id}->{'plant_id'} = $plant_id;
 543                     $plant_design->{$plant_id}->{'plant_name'} = $plant_name;
 544                     $plant_design->{$plant_id}->{'plant_index_number'} = $plant_index_numbers[$i];
 545                     $plant_design->{$plant_id}->{'plant_tissue_samples'} = $plant_tissue_samples{$plant_name};
 546                 }
 547             }
 548         }
 549         if ($trial_has_subplot_entries) {
 550             foreach my $plot_id (keys %$plot_design) {
 551                 my @subplot_ids = @{$plot_design->{$plot_id}->{'subplot_ids'}};
 552                 my @subplot_names = @{$plot_design->{$plot_id}->{'subplot_names'}};
 553                 my @subplot_index_numbers = @{$plot_design->{$plot_id}->{'subplot_index_numbers'}};
 554                 my %subplot_plants = %{$plot_design->{$plot_id}->{'subplots_plant_names'}};
 555                 my %subplot_tissue_samples = %{$plot_design->{$plot_id}->{'subplots_tissue_sample_names'}};
 556                 for (my $i=0; $i < scalar(@subplot_ids); $i++) {
 557                     my $subplot_id = $subplot_ids[$i];
 558                     my $subplot_name = $subplot_names[$i];
 559                     foreach my $property (keys %{$plot_design->{$plot_id}}) { $subplot_design->{$subplot_id}->{$property} = $plot_design->{$plot_id}->{$property}; }
 560                     $subplot_design->{$subplot_id}->{'subplot_id'} = $subplot_id;
 561                     $subplot_design->{$subplot_id}->{'subplot_name'} = $subplot_name;
 562                     $subplot_design->{$subplot_id}->{'subplot_index_number'} = $subplot_index_numbers[$i];
 563                     $subplot_design->{$subplot_id}->{'subplot_plant_names'} = $subplot_plants{$subplot_name};
 564                     $subplot_design->{$subplot_id}->{'subplot_tissue_sample_names'} = $subplot_tissue_samples{$subplot_name};
 565                 }
 566             }
 567         }
 568         if ($trial_has_tissue_sample_entries) {
 569             foreach my $plot_id (keys %$plot_design) {
 570                 my @tissue_sample_ids = @{$plot_design->{$plot_id}->{'tissue_sample_ids'}};
 571                 my @tissue_sample_names = @{$plot_design->{$plot_id}->{'tissue_sample_names'}};
 572                 my @tissue_sample_index_numbers = @{$plot_design->{$plot_id}->{'tissue_sample_index_numbers'}};
 573                 for (my $i=0; $i < scalar(@tissue_sample_ids); $i++) {
 574                     my $tissue_sample_id = $tissue_sample_ids[$i];
 575                     foreach my $property (keys %{$plot_design->{$plot_id}}) { $tissue_sample_design->{$tissue_sample_id}->{$property} = $plot_design->{$plot_id}->{$property}; }
 576                     $tissue_sample_design->{$tissue_sample_id}->{'tissue_sample_id'} = $tissue_sample_id;
 577                     $tissue_sample_design->{$tissue_sample_id}->{'tissue_sample_name'} = $tissue_sample_names[$i];
 578                     $tissue_sample_design->{$tissue_sample_id}->{'tissue_sample_index_number'} = $tissue_sample_index_numbers[$i];
 579                 }
 580             }
 581         }
 582     }
 583     # elsif ($data_type =~ m/Field Trial Plots/) {
 584     #     $trial_id = $value;
 585     #     $design = CXGN::Trial::TrialLayout->new({schema => $schema, trial_id => $trial_id, experiment_type=>'field_layout' })->get_design();
 586     # }
 587
 588     #turn arrays into comma separated strings
 589     $plot_design = arraystostrings($plot_design);
 590     $plant_design = arraystostrings($plant_design);
 591     $subplot_design = arraystostrings($subplot_design);
 592     $tissue_sample_design = arraystostrings($tissue_sample_design);
 593     return ($num_trials, $trial_id, $plot_design, $plant_design, $subplot_design, $tissue_sample_design);
 594 }
 595
 596 sub arraystostrings {
 597     my $hash = shift;
 598     while (my ($key, $val) = each %$hash){
 599         while (my ($prop, $value) = each %$val){
 600             if (ref $value eq 'ARRAY'){
 601                 $hash->{$key}->{$prop} = join ',', @$value;
 602             }
 603         }
 604     }
 605     return $hash;
 606 }
 607
 608
 609 #########
 610 1;
 611 #########