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
  17 BEGIN { extends 'Catalyst::Controller::REST' }
  18
  19 __PACKAGE__->config(
  20     default   => 'application/json',
  21     stash_key => 'rest',
  22     map       => { 'application/json' => 'JSON', 'text/html' => 'JSON' },
  23    );
  24
  25    sub retrieve_longest_fields :Path('/tools/label_designer/retrieve_longest_fields') {
  26         my $self = shift;
  27         my $c = shift;
  28         my $schema = $c->dbic_schema('Bio::Chado::Schema');
  29         my $data_type = $c->req->param("data_type");
  30         my $value = $c->req->param("value");
  31         my %longest_hash;
  32         print STDERR "Data type is $data_type and id is $value\n";
  33        my ($trial_num, $trial_id, $design) = get_plot_data($c, $schema, $data_type, $value);
  34        print STDERR "AFTER SUB: \nTrial_id is $trial_id and design is ". Dumper($design) ."\n";
  35        if ($trial_num > 1) {
  36            $c->stash->{rest} = { error => "The selected list contains plots from more than one trial. This is not supported. Please select a different data source." };
  37            return;
  38        }
  39
  40        my $trial_name = $schema->resultset("Project::Project")->search({ project_id => $trial_id })->first->name();
  41        if (!$trial_name) {
  42            $c->stash->{rest} = { error => "Trial with id $trial_id does not exist. Can't create labels." };
  43            return;
  44        }
  45
  46        my %design = %{$design};
  47        if (!%design) {
  48            $c->stash->{rest} = { error => "Trial $trial_name does not have a valid field design. Can't create labels." };
  49            return;
  50        }
  51        $longest_hash{'trial_name'} = $trial_name;
  52
  53        my $year_cvterm_id = $schema->resultset("Cv::Cvterm")->search({name=> 'project year' })->first->cvterm_id();
  54        my $year = $schema->resultset("Project::Projectprop")->search({ project_id => $trial_id, type_id => $year_cvterm_id } )->first->value();
  55        $longest_hash{'year'} = $year;
  56
  57        my $design_cvterm_id = $schema->resultset("Cv::Cvterm")->search({name=> 'design' })->first->cvterm_id();
  58        my $design_value = $schema->resultset("Project::Projectprop")->search({ project_id => $trial_id, type_id => $design_cvterm_id } )->first->value();
  59        if ($design_value eq "genotyping_plate") { # for genotyping trials, get "Genotyping Facility" and "Genotyping Project Name"
  60            my $genotyping_facility_cvterm_id = $schema->resultset("Cv::Cvterm")->search({name=> 'genotyping_facility' })->first->cvterm_id();
  61            my $geno_project_name_cvterm_id = $schema->resultset("Cv::Cvterm")->search({name=> 'genotyping_project_name' })->first->cvterm_id();
  62            my $genotyping_facility = $schema->resultset("Project::Projectprop")->search({ project_id => $trial_id, type_id => $genotyping_facility_cvterm_id } )->first->value();
  63            my $genotyping_project_name = $schema->resultset("NaturalDiversity::NdExperimentProject")->search({
  64                    project_id => $trial_id
  65                })->search_related('nd_experiment')->search_related('nd_experimentprops',{
  66                    'nd_experimentprops.type_id' => $geno_project_name_cvterm_id
  67                })->first->value();
  68
  69            $longest_hash{'genotyping_project_name'} = $genotyping_project_name;
  70            $longest_hash{'genotyping_facility'} = $genotyping_facility;
  71        }
  72
  73        #get all fields in this trials design
  74        my $random_plot = $design{(keys %design)[rand keys %design]};
  75        my %reps;
  76        my @keys = keys %{$random_plot};
  77        foreach my $field (@keys) {
  78
  79            # if rep_number, find unique options and return them
  80            if ($field eq 'rep_number') {
  81                print STDERR "Searching for unique rep numbers.\n";
  82             #    foreach my $key (keys %design) {
  83                $reps{$_->{'rep_number'}}++ foreach values %design;
  84                print STDERR "Reps: ".Dumper(%reps);
  85            }
  86
  87
  88            print STDERR " Searching for longest $field\n";
  89            #for each field order values by descending length, then save the first one
  90            foreach my $key ( sort { length($design{$b}{$field}) <=> length($design{$a}{$field}) or  $a <=> $b } keys %design) {
  91                 print STDERR "Longest $field is: ".$design{$key}{$field}."\n";
  92                 my $longest = $design{$key}{$field};
  93                 unless (ref($longest) || length($longest) < 1) { # skip if not scalar or undefined
  94                     $longest_hash{$field} = $design{$key}{$field};
  95                 }
  96                 last;
  97             }
  98         }
  99
 100         # save longest pedigree string
 101         my $pedigree_strings = get_all_pedigrees($schema, \%design);
 102         my %pedigree_strings = %{$pedigree_strings};
 103
 104         foreach my $key ( sort { length($pedigree_strings{$b}) <=> length($pedigree_strings{$a}) } keys %pedigree_strings) {
 105             $longest_hash{'pedigree_string'} = $pedigree_strings{$key};
 106             last;
 107         }
 108
 109         #print STDERR "Dumped data is: ".Dumper(%longest_hash);
 110         $c->stash->{rest} = {
 111             fields => \%longest_hash,
 112             reps => \%reps,
 113         };
 114    }
 115
 116    sub label_designer_download : Path('/tools/label_designer/download') : ActionClass('REST') { }
 117
 118    sub label_designer_download_GET : Args(0) {
 119         my $self = shift;
 120         my $c = shift;
 121         $c->forward('label_designer_download_POST');
 122     }
 123
 124   sub label_designer_download_POST : Args(0) {
 125        my $self = shift;
 126        my $c = shift;
 127        my $schema = $c->dbic_schema('Bio::Chado::Schema');
 128        my $download_type = $c->req->param("download_type");
 129     #    my $trial_id = $c->req->param("trial_id");
 130        my $data_type = $c->req->param("data_type");
 131        my $value = $c->req->param("value");
 132        my $design_json = $c->req->param("design_json");
 133        my $conversion_factor = 2.83; # for converting from 8 dots per mmm to 2.83 per mm (72 per inch)
 134
 135        # decode json
 136        my $json = new JSON;
 137        my $design_params = $json->allow_nonref->utf8->relaxed->escape_slash->loose->allow_singlequote->allow_barekey->decode($design_json);
 138
 139        my ($trial_num, $trial_id, $design) = get_plot_data($c, $schema, $data_type, $value);
 140        if ($trial_num > 1) {
 141            $c->stash->{rest} = { error => "The selected list contains plots from more than one trial. This is not supported. Please select a different data source." };
 142            return;
 143        }
 144
 145         my $trial_name = $schema->resultset("Project::Project")->search({ project_id => $trial_id })->first->name();
 146         if (!$trial_name) {
 147             $c->stash->{rest} = { error => "Trial with id $trial_id does not exist. Can't create labels." };
 148             return;
 149         }
 150        my %design = %{$design};
 151        if (!$design) {
 152            $c->stash->{rest} = { error => "Trial $trial_name does not have a valid field design. Can't create labels." };
 153            return;
 154        }
 155
 156        my $design_cvterm_id = $schema->resultset("Cv::Cvterm")->search({name=> 'design' })->first->cvterm_id();
 157        my $design_value = $schema->resultset("Project::Projectprop")->search({ project_id => $trial_id, type_id => $design_cvterm_id } )->first->value();
 158
 159        my ($genotyping_facility, $genotyping_project_name);
 160        if ($design_value eq "genotyping_plate") { # for genotyping trials, get "Genotyping Facility" and "Genotyping Project Name"
 161            my $genotyping_facility_cvterm_id = $schema->resultset("Cv::Cvterm")->search({name=> 'genotyping_facility' })->first->cvterm_id();
 162            my $geno_project_name_cvterm_id = $schema->resultset("Cv::Cvterm")->search({name=> 'genotyping_project_name' })->first->cvterm_id();
 163            $genotyping_facility = $schema->resultset("Project::Projectprop")->search({ project_id => $trial_id, type_id => $genotyping_facility_cvterm_id } )->first->value();
 164            $genotyping_project_name = $schema->resultset("NaturalDiversity::NdExperimentProject")->search({
 165                    project_id => $trial_id
 166                })->search_related('nd_experiment')->search_related('nd_experimentprops',{
 167                    'nd_experimentprops.type_id' => $geno_project_name_cvterm_id
 168                })->first->value();
 169        }
 170
 171        my $year_cvterm_id = $schema->resultset("Cv::Cvterm")->search({name=> 'project year' })->first->cvterm_id();
 172        my $year = $schema->resultset("Project::Projectprop")->search({ project_id => $trial_id, type_id => $year_cvterm_id } )->first->value();
 173
 174        my $label_params = $design_params->{'label_elements'};
 175        # if needed retrieve pedigrees in bulk
 176        my $pedigree_strings;
 177        foreach my $element (@$label_params) {
 178            if ($element->{'value'} eq '{pedigree_string}') {
 179                $pedigree_strings = get_all_pedigrees($schema, $design);
 180            }
 181        }
 182
 183        # Create a blank PDF file
 184        my $dir = $c->tempfiles_subdir('labels');
 185        my $file_prefix = $trial_name;
 186        $file_prefix =~ s/[^a-zA-Z0-9-_]//g;
 187
 188        my ($FH, $filename) = $c->tempfile(TEMPLATE=>"labels/$file_prefix-XXXXX", SUFFIX=>".$download_type");
 189
 190        # initialize loop variables
 191        my $col_num = 1;
 192        my $row_num = 1;
 193        my $key_number = 0;
 194        my $sort_order = $design_params->{'sort_order'};
 195
 196        if ($download_type eq 'pdf') {
 197            # Create pdf
 198            print STDERR "Creating the PDF . . .\n";
 199            my $pdf  = PDF::API2->new(-file => $FH);
 200            my $page = $pdf->page();
 201            my $text = $page->text();
 202            my $gfx = $page->gfx();
 203            $page->mediabox($design_params->{'page_width'}, $design_params->{'page_height'});
 204
 205            # loop through plot data in design hash
 206            foreach my $key ( sort { versioncmp( $design{$a}{$sort_order} , $design{$b}{$sort_order} ) or  $a <=> $b } keys %design) {
 207
 208                 #print STDERR "Design key is $key\n";
 209                 my %design_info = %{$design{$key}};
 210                 $design_info{'trial_name'} = $trial_name;
 211                 $design_info{'year'} = $year;
 212                 $design_info{'genotyping_facility'} = $genotyping_facility;
 213                 $design_info{'genotyping_project_name'} = $genotyping_project_name;
 214                 $design_info{'pedigree_string'} = $pedigree_strings->{$design_info{'accession_name'}};
 215                 #print STDERR "Design info: " . Dumper(%design_info);
 216
 217                 if ( $design_params->{'plot_filter'} eq 'all' || $design_params->{'plot_filter'} eq $design_info{'rep_number'}) { # filter by rep if needed
 218
 219                     for (my $i=0; $i < $design_params->{'copies_per_plot'}; $i++) {
 220                         #print STDERR "Working on label num $i\n";
 221                         my $label_x = $design_params->{'left_margin'} + ($design_params->{'label_width'} + $design_params->{'horizontal_gap'}) * ($col_num-1);
 222                         my $label_y = $design_params->{'page_height'} - $design_params->{'top_margin'} - ($design_params->{'label_height'} + $design_params->{'vertical_gap'}) * ($row_num-1);
 223
 224                        foreach my $element (@$label_params) {
 225                            #print STDERR "Element Dumper\n" . Dumper($element);
 226                            my %element = %{$element};
 227                            my $elementx = $label_x + ( $element{'x'} / $conversion_factor );
 228                            my $elementy = $label_y - ( $element{'y'} / $conversion_factor );
 229
 230                            my $filled_value = $element{'value'};
 231                            $filled_value =~ s/\{(.*?)\}/process_field($1,$key_number,\%design_info)/ge;
 232                            #print STDERR "Element ".$element{'type'}."_".$element{'size'}." filled value is ".$filled_value." and coords are $elementx and $elementy\n";
 233                            #print STDERR "Writing to the PDF . . .\n";
 234                            if ( $element{'type'} eq "Code128" || $element{'type'} eq "QRCode" ) {
 235
 236                                 if ( $element{'type'} eq "Code128" ) {
 237
 238                                    my $barcode_object = Barcode::Code128->new();
 239
 240                                    my ($png_location, $png_uri) = $c->tempfile( TEMPLATE => [ 'barcode', 'bc-XXXXX'], SUFFIX=>'.png');
 241                                    open(PNG, ">", $png_location) or die "Can't write $png_location: $!\n";
 242                                    binmode(PNG);
 243
 244                                    $barcode_object->option("scale", $element{'size'}, "font_align", "center", "padding", 5, "show_text", 0);
 245                                    $barcode_object->barcode($filled_value);
 246                                    my $barcode = $barcode_object->gd_image();
 247                                    print PNG $barcode->png();
 248                                    close(PNG);
 249
 250                                     my $image = $pdf->image_png($png_location);
 251                                     my $height = $element{'height'} / $conversion_factor ; # scale to 72 pts per inch
 252                                     my $width = $element{'width'} / $conversion_factor ; # scale to 72 pts per inch
 253                                     my $elementy = $elementy - ($height/2); # adjust for img position sarting at bottom
 254                                     my $elementx = $elementx - ($width/2);
 255                                     #print STDERR 'adding Code 128 params $image, $elementx, $elementy, $width, $height with: '."$image, $elementx, $elementy, $width, $height\n";
 256                                     $gfx->image($image, $elementx, $elementy, $width, $height);
 257
 258
 259                               } else { #QRCode
 260
 261                                   my ($jpeg_location, $jpeg_uri) = $c->tempfile( TEMPLATE => [ 'barcode', 'bc-XXXXX'], SUFFIX=>'.jpg');
 262                                   my $barcode_generator = CXGN::QRcode->new(
 263                                       text => $filled_value,
 264                                       size => $element{'size'},
 265                                       margin => 0,
 266                                       version => 0,
 267                                       level => 'M'
 268                                   );
 269                                   my $barcode_file = $barcode_generator->get_barcode_file($jpeg_location);
 270
 271                                    my $image = $pdf->image_jpeg($jpeg_location);
 272                                    my $height = $element{'height'} / $conversion_factor ; # scale to 72 pts per inch
 273                                    my $width = $element{'width'} / $conversion_factor ; # scale to 72 pts per inch
 274                                    my $elementy = $elementy - ($height/2); # adjust for img position sarting at bottom
 275                                    my $elementx = $elementx - ($width/2);
 276                                    $gfx->image($image, $elementx, $elementy, $width, $height);
 277
 278                               }
 279                            }
 280                            else { #Text
 281
 282                                 my $font = $pdf->corefont($element{'font'}); # Add a built-in font to the PDF
 283                                 # Add text to the page
 284                                 my $adjusted_size = $element{'size'} / $conversion_factor; # scale to 72 pts per inch
 285                                 $text->font($font, $adjusted_size);
 286                                 my $height = $element{'height'} / $conversion_factor ; # scale to 72 pts per inch
 287                                 my $elementy = $elementy - ($height/4); # adjust for img position starting at bottom
 288                                 $text->translate($elementx, $elementy);
 289                                 $text->text_center($filled_value);
 290                            }
 291                        }
 292
 293                         if ($col_num < $design_params->{'number_of_columns'}) { #next column
 294                             $col_num++;
 295                         } else { #new row, reset col num
 296                             $col_num = 1;
 297                             $row_num++;
 298                         }
 299
 300                         if ($row_num > $design_params->{'number_of_rows'}) { #create new page and reset row and col num
 301                             $pdf->finishobjects($page, $gfx, $text); #flush the page to save memory on big PDFs
 302                             $page = $pdf->page();
 303                             $text = $page->text();
 304                             $gfx = $page->gfx();
 305                             $page->mediabox($design_params->{'page_width'}, $design_params->{'page_height'});
 306                             $row_num = 1;
 307                         }
 308                     }
 309                 }
 310              $key_number++;
 311              }
 312
 313            print STDERR "Saving the PDF . . .\n";
 314            $pdf->save();
 315
 316        } elsif ($download_type eq 'zpl') {
 317
 318            print STDERR "Generating zpl . . .\n";
 319            my $zpl_obj = CXGN::ZPL->new(
 320                print_width => $design_params->{'label_width'} * $conversion_factor,
 321                label_length => $design_params->{'label_height'} * $conversion_factor
 322            );
 323            $zpl_obj->start_sequence();
 324            $zpl_obj->label_format();
 325            foreach my $element (@$label_params) {
 326                my $x = $element->{'x'} - ($element->{'width'}/2);
 327                my $y = $element->{'y'} - ($element->{'height'}/2);
 328                $zpl_obj->new_element($element->{'type'}, $x, $y, $element->{'size'}, $element->{'value'});
 329            }
 330            $zpl_obj->end_sequence();
 331            my $zpl_template = $zpl_obj->render();
 332            foreach my $key ( sort { versioncmp( $design{$a}{$sort_order} , $design{$b}{$sort_order} ) or  $a <=> $b } keys %design) {
 333             #    print STDERR "Design key is $key\n";
 334                my %design_info = %{$design{$key}};
 335                $design_info{'trial_name'} = $trial_name;
 336                $design_info{'year'} = $year;
 337                $design_info{'pedigree_string'} = $pedigree_strings->{$design_info{'accession_name'}};
 338
 339                my $zpl = $zpl_template;
 340                $zpl =~ s/\{(.*?)\}/process_field($1,$key_number,\%design_info)/ge;
 341               for (my $i=0; $i < $design_params->{'copies_per_plot'}; $i++) {
 342                   print $FH $zpl;
 343                }
 344             $key_number++;
 345             }
 346        }
 347
 348        close($FH);
 349        print STDERR "Returning with filename . . .\n";
 350        $c->stash->{rest} = {
 351            filename => $urlencode{$filename},
 352            filepath => $c->config->{basepath}."/".$filename
 353        };
 354
 355    }
 356
 357 sub process_field {
 358     my $field = shift;
 359     my $key_number = shift;
 360     my $design_info = shift;
 361     my %design_info = %{$design_info};
 362     #print STDERR "Field is $field\n";
 363     if ($field =~ m/Number:/) {
 364         our ($placeholder, $start_num, $increment) = split ':', $field;
 365         my $length = length($start_num);
 366         #print STDERR "Increment is $increment\nKey Number is $key_number\n";
 367         my $custom_num =  $start_num + ($increment * $key_number);
 368         return sprintf("%0${length}d", $custom_num);
 369     } else {
 370         return $design_info{$field};
 371     }
 372 }
 373
 374 sub get_all_pedigrees {
 375     my $schema = shift;
 376     my $design = shift;
 377     my %design = %{$design};
 378
 379     # collect all unique accession ids for pedigree retrieval
 380     my %accession_id_hash;
 381     foreach my $key (keys %design) {
 382         $accession_id_hash{$design{$key}{'accession_id'}} = $design{$key}{'accession_name'};
 383     }
 384     my @accession_ids = keys %accession_id_hash;
 385
 386     # retrieve pedigree info using batch download (fastest method), then extract pedigree strings from download rows.
 387     my $stock = CXGN::Stock->new ( schema => $schema);
 388     my $pedigree_rows = $stock->get_pedigree_rows(\@accession_ids, 'parents_only');
 389     my %pedigree_strings;
 390     foreach my $row (@$pedigree_rows) {
 391         my ($progeny, $female_parent, $male_parent, $cross_type) = split "\t", $row;
 392         my $string = join ('/', $female_parent ? $female_parent : 'NA', $male_parent ? $male_parent : 'NA');
 393         $pedigree_strings{$progeny} = $string;
 394     }
 395     return \%pedigree_strings;
 396 }
 397
 398 sub get_plot_data {
 399     my $c = shift;
 400     my $schema = shift;
 401     my $data_type = shift;
 402     my $value = shift;
 403     my $num_trials = 1;
 404     my ($trial_id, $design);
 405     print STDERR "Data type is $data_type and value is $value\n";
 406     if ($data_type =~ m/Plot List/) {
 407         # get items from list, get trial id from plot id. Or, get plot dta one by one
 408         my $plot_data = SGN::Controller::AJAX::List->retrieve_list($c, $value);
 409         my @plot_list = map { $_->[1] } @$plot_data;
 410         my $t = CXGN::List::Transform->new();
 411         my $acc_t = $t->can_transform("plots", "plot_ids");
 412         my $plot_id_hash = $t->transform($schema, $acc_t, \@plot_list);
 413         my @plot_ids = @{$plot_id_hash->{transform}};
 414         my $trial_rs = $schema->resultset("NaturalDiversity::NdExperimentStock")->search({
 415             stock_id => { -in => \@plot_ids }
 416         })->search_related('nd_experiment')->search_related('nd_experiment_projects');
 417         my %trials = ();
 418         while (my $row = $trial_rs->next()) {
 419             print STDERR "Looking at id ".$row->project_id()."\n";
 420             my $id = $row->project_id();
 421             $trials{$id} = 1;
 422         }
 423         $num_trials = scalar keys %trials;
 424         print STDERR "Count is $num_trials\n";
 425         $trial_id = $trial_rs->first->project_id();
 426         my $full_design = CXGN::Trial::TrialLayout->new({schema => $schema, trial_id => $trial_id, experiment_type=>'field_layout' })->get_design();
 427         print STDERR "Full Design is: ".Dumper($full_design);
 428         # reduce design hash, removing plots that aren't in list
 429         my %full_design = %{$full_design};
 430
 431         foreach my $i (0 .. $#plot_ids) {
 432             foreach my $key (keys %full_design) {
 433                 if ($full_design{$key}->{'plot_id'} eq $plot_ids[$i]) {
 434                     print STDERR "Plot name is ".$full_design{$key}->{'plot_name'}."\n";
 435                     $design->{$key} = $full_design{$key};
 436                     $design->{$key}->{'list_order'} = $i;
 437                 }
 438             }
 439         }
 440
 441     } elsif ($data_type =~ m/Trial/) {
 442         $trial_id = $value;
 443         $design = CXGN::Trial::TrialLayout->new({schema => $schema, trial_id => $trial_id, experiment_type=>'field_layout' })->get_design();
 444     }
 445     return ($num_trials, $trial_id, $design);
 446 }
 447
 448
 449 #########
 450 1;
 451 #########