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