lib/SGN/Controller/Barcode.pm

   1
   2 package SGN::Controller::Barcode;
   3
   4 use Moose;
   5 use GD;
   6
   7 use DateTime;
   8 use File::Slurp;
   9 use Barcode::Code128;
  10 use GD::Barcode::QRcode;
  11 use Tie::UrlEncoder;
  12 use PDF::LabelPage;
  13 use Math::Base36 ':all';
  14 use CXGN::QRcode;
  15 use Data::Dumper;
  16
  17 our %urlencode;
  18
  19 BEGIN { extends 'Catalyst::Controller'; }
  20
  21 sub index : Path('/barcode') Args(0) {
  22     my $self =shift;
  23     my $c = shift;
  24
  25     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
  26     # get projects
  27     my @rows = $schema->resultset('Project::Project')->all();
  28     my @projects = ();
  29     foreach my $row (@rows) {
  30         push @projects, [ $row->project_id, $row->name, $row->description ];
  31     }
  32     $c->stash->{projects} = \@projects;
  33     @rows = $schema->resultset('NaturalDiversity::NdGeolocation')->all();
  34     my @locations = ();
  35     foreach my $row (@rows) {
  36         push @locations,  [ $row->nd_geolocation_id,$row->description ];
  37     }
  38
  39     # get tool description info
  40     #
  41     my @tools_def = read_file($c->path_to("../cassava/documents/barcode/tools.def"));
  42
  43     print STDERR join "\n", @tools_def;
  44
  45     $c->stash->{tools_def} = \@tools_def;
  46     $c->stash->{locations} = \@locations;
  47     $c->stash->{template} = '/barcode/index.mas';
  48 }
  49
  50
  51 =head2 barcode_image
  52
  53  URL:          mapped to URL /barcode/image
  54  Params:       code : the code to represent in the barcode
  55                text : human readable text
  56                size : either small, large
  57                top  : pixels from the top
  58  Desc:         creates the barcode image, sets the content type to
  59                image/png and returns the barcode image to the browser
  60  Ret:
  61  Side Effects:
  62  Example:
  63
  64 =cut
  65
  66 sub barcode_image : Path('/barcode/image') Args(0) {
  67     my $self = shift;
  68     my $c = shift;
  69
  70     my $code = $c->req->param("code");
  71     my $text = $c->req->param("text");
  72     my $size = $c->req->param("size");
  73     my $top  = $c->req->param("top");
  74
  75     my $barcode = $self->barcode($code, $text, $size, $top);
  76
  77     $c->res->headers->content_type('image/png');
  78
  79     $c->res->body($barcode->png());
  80 }
  81
  82
  83 sub barcode_tempfile_jpg : Path('/barcode/tempfile') Args(4) {
  84     my $self = shift;
  85     my $c = shift;
  86
  87     my $code = shift;
  88     my $text = shift;
  89     my $size = shift;
  90     my $top = shift;
  91
  92     my $barcode = $self->barcode($code,
  93                                  $text,
  94                                  $size,
  95                                  $top,
  96         );
  97
  98     $c->tempfiles_subdir('barcode');
  99     my ($file, $uri) = $c->tempfile( TEMPLATE => [ 'barcode', 'bc-XXXXX'], SUFFIX=>'.jpg');
 100
 101     open(my $F, ">", $file) || die "Can't open file $file $@";
 102     print $F $barcode->jpeg();
 103     close($F);
 104
 105     return $file;
 106 }
 107
 108 sub barcode_qrcode_jpg : Path('/barcode/tempfile') Args(2){
 109    my $self = shift;
 110    my $c = shift;
 111    my $stock_id = shift;
 112    my $stock_name = shift;
 113    my $field_info = shift;
 114    my $fieldbook_enabled = shift // "";
 115    my $stock_type = shift;
 116    print "STOCK TYPE!!!: $stock_type\n";
 117    my $text;
 118    if ($fieldbook_enabled eq "enable_fieldbook_2d_barcode"){
 119        $text = $stock_name;
 120    }
 121    elsif ($stock_type eq 'crossing') {
 122        #$text = $stock_id;
 123        $text = "stock name: ".$stock_name. "\n plot_id: ".$stock_id. "\n".$field_info;
 124    }
 125    else {
 126        $text = "stock name: ".$stock_name. "\n stock id: ". $stock_id. "\n".$field_info;
 127    }
 128
 129
 130
 131    $c->tempfiles_subdir('barcode');
 132    my ($file_location, $uri) = $c->tempfile( TEMPLATE => [ 'barcode', 'bc-XXXXX'], SUFFIX=>'.jpg');
 133
 134    my $barcode_generator = CXGN::QRcode->new( text => $text );
 135    my $barcode_file = $barcode_generator->get_barcode_file($file_location);
 136
 137    close($barcode_file);
 138    return $barcode_file;
 139  }
 140
 141  sub phenotyping_qrcode_jpg : Path('/barcode/tempfile') Args(2){
 142     my $self = shift;
 143     my $c = shift;
 144     my $stock_id = shift;
 145     my $stock_name = shift;
 146     my $field_info = shift;
 147     my $base_url = $c->config->{main_production_site_url};
 148     my $text = "$base_url/breeders/plot_phenotyping?stock_id=$stock_id";
 149     if ($field_info eq "trial"){
 150        $text =  "TrailID:".$stock_id."\n TrialName:".$stock_name;
 151     }
 152
 153     $c->tempfiles_subdir('barcode');
 154     my ($file_location, $uri) = $c->tempfile( TEMPLATE => [ 'barcode', 'bc-XXXXX'], SUFFIX=>'.jpg');
 155
 156     my $barcode_generator = CXGN::QRcode->new( text => $text );
 157     my $barcode_file = $barcode_generator->get_barcode_file($file_location);
 158
 159     return $barcode_file;
 160   }
 161
 162   sub trial_qrcode_jpg : Path('/barcode/trial') Args(2){
 163      my $self = shift;
 164      my $c = shift;
 165      my $trial_id = shift;
 166      my $format = shift;
 167      my $base_url = $c->config->{main_production_site_url};
 168      my $text = "$base_url/breeders/trial_phenotyping?trial_id=$trial_id";
 169      if ($format eq "stock_qrcode"){
 170         $text =  $trial_id;
 171      }
 172
 173       $c->tempfiles_subdir('barcode');
 174       my ($file_location, $uri) = $c->tempfile( TEMPLATE => [ 'barcode', 'bc-XXXXX'], SUFFIX=>'.jpg');
 175
 176       my $barcode_generator = CXGN::QRcode->new( text => $text );
 177       my $barcode_file = $barcode_generator->get_barcode_file($file_location);
 178
 179        $c->res->headers->content_type('image/jpg');
 180        $c->res->body($barcode_file);
 181    }
 182
 183 =head2 barcode
 184
 185  Usage:        $self->barcode($code, $text, $size, 30);
 186  Desc:         generates a barcode (GD image)
 187  Ret:          a GD::Image object
 188  Args:         $code, $text, $size, upper margin
 189  Side Effects: none
 190  Example:
 191
 192 =cut
 193
 194 sub barcode {
 195     my $self = shift;
 196     my $code = shift;
 197     my $text = shift;
 198     my $size = shift;
 199     my $top = shift;
 200
 201     my $scale = 2;
 202     if ($size eq "small") { $scale = 1; }
 203     if ($size eq "huge") { $scale = 5; }
 204     my $barcode_object = Barcode::Code128->new();
 205     $barcode_object->barcode($code);
 206     $barcode_object->font('large');
 207     $barcode_object->border(2);
 208     $barcode_object->scale($scale);
 209     $barcode_object->top_margin($top);
 210     #$barcode_object->show_text($show_text);
 211     $barcode_object->font_align("center");
 212     my  $barcode = $barcode_object ->gd_image();
 213     my $text_width = gdLargeFont->width()*length($text);
 214     $barcode->string(gdLargeFont,int(($barcode->width()-$text_width)/2),10,$text, $barcode->colorAllocate(0, 0, 0));
 215     return $barcode;
 216 }
 217
 218 #deprecated
 219 sub code128_png :Path('/barcode/code128png') :Args(2) {
 220     my $self = shift;
 221     my $c = shift;
 222     my $identifier = shift;
 223     my $text = shift;
 224
 225     $text =~ s/\+/ /g;
 226     $identifier =~ s/\+/ /g;
 227
 228     my $barcode_object = Barcode::Code128->new();
 229     $barcode_object->barcode($identifier);
 230     $barcode_object->font('large');
 231     $barcode_object->border(2);
 232     $barcode_object->top_margin(30);
 233     $barcode_object->font_align("center");
 234     my  $barcode = $barcode_object ->gd_image();
 235     my $text_width = gdLargeFont->width()*length($text);
 236     $barcode->string(gdLargeFont,int(($barcode->width()-$text_width)/2),10,$text, $barcode->colorAllocate(0, 0, 0));
 237     $c->res->headers->content_type('image/png');
 238
 239     $c->res->body($barcode->png());
 240 }
 241
 242 # a barcode element for a continuous barcode
 243
 244 sub barcode_element : Path('/barcode/element/') :Args(2) {
 245     my $self = shift;
 246     my $c = shift;
 247     my $text = shift;
 248     my $height = shift;
 249
 250     my $size = $c->req->param("size");
 251
 252     my $scale = 1;
 253     if ($size eq "large") {
 254         $scale = 2;
 255     }
 256
 257     my $barcode_object = Barcode::Code128->new();
 258     $barcode_object->barcode($text);
 259     $barcode_object->height(100);
 260     $barcode_object->scale($scale);
 261     #$barcode_object->width(200);
 262     $barcode_object->font('large');
 263     $barcode_object->border(0);
 264     $barcode_object->top_margin(0);
 265     my  $barcode = $barcode_object ->gd_image();
 266
 267     my $barcode_slice = GD::Image->new($barcode->width, $height);
 268     my $white = $barcode_slice->colorAllocate(255,255,255);
 269     $barcode_slice->filledRectangle(0, 0, $barcode->width, $height, $white);
 270
 271     print STDERR "Creating barcode with width ".($barcode->width)." and height $height\n";
 272     $barcode_slice->copy($barcode, 0, 0, 0, 0, $barcode->width, $height);
 273
 274     $c->res->headers->content_type('image/png');
 275
 276     $c->res->body($barcode_slice->png());
 277 }
 278
 279 sub qrcode_png :Path('/barcode/qrcodepng') :Args(2) {
 280     my $self = shift;
 281     my $c = shift;
 282     my $link = shift;
 283     my $text = shift;
 284
 285     $text =~ s/\+/ /g;
 286     $link =~ s/\+/ /g;
 287
 288     my $bc = GD::Barcode::QRcode->new($link, { Ecc => 'L', Version=>2, ModuleSize => 2 });
 289     my $image = $bc->plot();
 290
 291     $c->res->headers->content_type('image/png');
 292     $c->res->body($image->png());
 293 }
 294
 295 sub barcode_tool :Path('/barcode/tool') Args(3) {
 296     my $self = shift;
 297     my $c = shift;
 298     my $cvterm = shift;
 299     my $tool_version = shift;
 300     my $values = shift;
 301
 302     my ($db, $accession) = split ":", $cvterm;
 303
 304     print STDERR "Searching $cvterm, DB $db...\n";
 305     my ($db_row) = $c->dbic_schema('Bio::Chado::Schema')->resultset('General::Db')->search( { name => $db } );
 306
 307     print STDERR $db_row->db_id;
 308     print STDERR "DB_ID for $db: $\n";
 309
 310
 311     my $dbxref_rs = $c->dbic_schema('Bio::Chado::Schema')->resultset('General::Dbxref')->search_rs( { accession=>$accession, db_id=>$db_row->db_id } );
 312
 313     my $cvterm_rs = $c->dbic_schema('Bio::Chado::Schema')->resultset('Cv::Cvterm')->search( { dbxref_id => $dbxref_rs->first->dbxref_id });
 314
 315     my $cvterm_id = $cvterm_rs->first()->cvterm_id();
 316     my $cvterm_synonym_rs = ""; #$c->dbic_schema('Bio::Chado::Schema')->resultset('Cv::Cvtermsynonym')->search->( { cvterm_id=>$cvterm_id });
 317
 318     $c->stash->{cvterm} = $cvterm;
 319     $c->stash->{cvterm_name} = $cvterm_rs->first()->name();
 320     $c->stash->{cvterm_definition} = $cvterm_rs->first()->definition();
 321     $c->stash->{cvterm_values} = $values;
 322     $c->stash->{tool_version} = $tool_version;
 323     $c->stash->{template} = '/barcode/tool/tool.mas';
 324 #    $c->stash->{cvterm_synonym} = $cvterm_synonym_rs->synonym();
 325     $c->forward('View::Mason');
 326 }
 327
 328
 329 sub barcode_multitool :Path('/barcode/multitool') Args(0) {
 330
 331     my $self  =shift;
 332     my $c = shift;
 333
 334     $c->stash->{operator} = $c->req->param('operator');
 335     $c->stash->{date}     = $c->req->param('date');
 336     $c->stash->{project}  = $c->req->param('project');
 337     $c->stash->{location} = $c->req->param('location');
 338
 339     my @cvterms = $c->req->param('cvterms');
 340
 341     my $cvterm_data = [];
 342
 343     foreach my $cvterm (@cvterms) {
 344
 345         my ($db, $accession) = split ":", $cvterm;
 346
 347         print STDERR "Searching $cvterm, DB $db...\n";
 348         my ($db_row) = $c->dbic_schema('Bio::Chado::Schema')->resultset('General::Db')->search( { name => $db } );
 349
 350         print STDERR $db_row->db_id;
 351         print STDERR "DB_ID for $db: $\n";
 352
 353
 354         my $dbxref_rs = $c->dbic_schema('Bio::Chado::Schema')->resultset('General::Dbxref')->search_rs( { accession=>$accession, db_id=>$db_row->db_id } );
 355
 356         my $cvterm_rs = $c->dbic_schema('Bio::Chado::Schema')->resultset('Cv::Cvterm')->search( { dbxref_id => $dbxref_rs->first->dbxref_id });
 357
 358         my $cvterm_id = $cvterm_rs->first()->cvterm_id();
 359         my $cvterm_synonym_rs = ""; #$c->dbic_schema('Bio::Chado::Schema')->resultset('Cv::Cvtermsynonym')->search->( { cvterm_id=>$cvterm_id });
 360
 361         push @$cvterm_data, { cvterm => $cvterm,
 362                               cvterm_name => $cvterm_rs->first()->name(),
 363                               cvterm_definition => $cvterm_rs->first->definition,
 364         };
 365
 366     }
 367
 368     $c->stash->{cvterms} = $cvterm_data;
 369
 370     $c->stash->{template} = '/barcode/tool/multi_tool.mas';
 371
 372
 373 }
 374
 375 sub continuous_scale : Path('/barcode/continuous_scale') Args(0) {
 376     my $self = shift;
 377     my $c = shift;
 378     my $start = $c->req->param("start");
 379     my $end = $c->req->param("end");
 380     my $step = $c->req->param("step");
 381     my $height = $c->req->param("height");
 382
 383     my @barcodes = ();
 384
 385     # barcodes all have to have the same with - use with of end value
 386     my $text_width = length($end);
 387
 388     for(my $i = $start; $i <= $end; $i += $step) {
 389         my $text = $urlencode{sprintf "%".$text_width."d", $i};
 390         print STDERR "TEXT: $text\n";
 391         push @barcodes, qq { <img src="/barcode/element/$i/$height" align="right" /> };
 392
 393     }
 394
 395     $c->res->body("<table cellpadding=\"0\" cellspacing=\"0\">". (join "\n", (map { "<tr><td>$_</td></tr>"}  @barcodes)). "</table>");
 396
 397
 398 }
 399
 400 sub continuous_scale_form : Path('/barcode/continuous_scale/input') :Args(0) {
 401     my $self = shift;
 402     my $c = shift;
 403
 404     my $form = <<HTML;
 405 <h1>Create continuous barcode</h1>
 406
 407 <form action="/barcode/continuous_scale">
 408 Start value <input name="start" /><br />
 409 End value <input name="end" /><br />
 410 Step size <input name="step" /><br />
 411 Increment (pixels) <input name="height" />
 412
 413 <input type="submit"  />
 414 </form>
 415
 416 HTML
 417
 418 $c->res->body($form);
 419
 420 }
 421
 422 sub generate_barcode : Path('/barcode/generate') Args(0) {
 423     my $self = shift;
 424     my $c = shift;
 425
 426     my $text = $c->req->param("text");
 427     my $size = $c->req->param("size");
 428
 429     $c->stash->{code} = $text;
 430     $c->stash->{size} = $size;
 431
 432     $c->stash->{template} = "/barcode/tool/generate.mas";
 433
 434 }
 435
 436 sub metadata_barcodes : Path('/barcode/metadata') Args(0) {
 437     my $self = shift;
 438     my $c = shift;
 439
 440
 441
 442     $c->stash->{operator} = $c->req->param("operator");
 443     $c->stash->{date}     = $c->req->param("date");
 444     $c->stash->{size}     = $c->req->param("size");
 445     $c->stash->{project}  = $c->req->param("project");
 446     $c->stash->{location} = $c->req->param("location");
 447
 448     $c->stash->{template} = '/barcode/tool/metadata.mas';
 449 }
 450
 451 sub new_barcode_tool : Path('/barcode/tool/') Args(1) {
 452     my $self = shift;
 453     my $c = shift;
 454
 455     my $term = shift;
 456
 457     $c->stash->{template} = '/barcode/tool/'.$term.'.mas';
 458 }
 459
 460 sub cross_tool : Path('/barcode/tool/cross') {
 461     my $self = shift;
 462     my $c = shift;
 463
 464     $c->stash->{template} = '/barcode/tool/cross.mas';
 465 }
 466
 467 sub dna_tool   : Path('/barcode/tool/dna/') {
 468     my $self =shift;
 469     my $c = shift;
 470     $c->stash->{template} = '/barcode/tool/dna.mas';
 471 }
 472
 473 sub generate_unique_barcode_labels : Path('/barcode/unique') Args(0) {
 474     my $self = shift;
 475     my $c = shift;
 476
 477     if (! $c->user()) {
 478         $c->stash->{template} = 'generic_message.mas';
 479         $c->stash->{message} = 'You must be logged in to use the unique barcode tool.';
 480         return;
 481     }
 482
 483     my $label_pages = $c->req->param("label_pages");
 484     my $label_rows = $c->req->param("label_rows") || 10;
 485     my $label_cols  = $c->req->param("label_cols") || 1;
 486     my $page_format = $c->req->param("page_format") || "letter";
 487     my $top_margin_mm = $c->req->param("top_margin");
 488     my $left_margin_mm = $c->req->param("left_margin");
 489     my $bottom_margin_mm = $c->req->param("bottom_margin");
 490     my $right_margin_mm = $c->req->param("right_margin");
 491
 492     # convert mm into pixels
 493     #
 494     my ($top_margin, $left_margin, $bottom_margin, $right_margin) = map { int($_ * 2.846) } ($top_margin_mm,
 495                                                                                         $left_margin_mm,
 496                                                                                         $bottom_margin_mm,
 497                                                                                         $right_margin_mm);
 498     my $total_labels = $label_pages * $label_cols * $label_rows;
 499
 500
 501     my $dir = $c->tempfiles_subdir('pdfs');
 502     my ($FH, $filename) = $c->tempfile(TEMPLATE=>"pdfs/pdf-XXXXX", SUFFIX=>".pdf", UNLINK=>0);
 503     print STDERR "FILENAME: $filename \n\n\n";
 504     my $pdf = PDF::Create->new(filename=>$c->path_to($filename),
 505                                Author=>$c->config->{project_name},
 506                                Title=>'Labels',
 507                                CreationDate => [ localtime ],
 508                                Version=>1.2,
 509         );
 510
 511     if (!$page_format) { $page_format = "Letter"; }
 512
 513     print STDERR "PAGE FORMAT IS: $page_format. LABEL ROWS: $label_rows, COLS: $label_cols. TOTAL LABELS: $total_labels\n";
 514
 515     my @pages = ();
 516     push @pages, PDF::LabelPage->new( { top_margin=>$top_margin, bottom_margin=>$bottom_margin, left_margin=>$left_margin, right_margin=>$right_margin, pdf=>$pdf, cols => $label_cols, rows => $label_rows });
 517
 518     foreach my $label_count (1..$total_labels) {
 519         my $label_code = $self->generate_label_code($c);
 520
 521         print STDERR "LABEL CODE: $label_code\n";
 522
 523         # generate barcode
 524         #
 525         my $tempfile = $c->forward('/barcode/barcode_tempfile_jpg', [ $label_code, $label_code ,  'large',  20  ]);
 526         my $image = $pdf->image($tempfile);
 527         print STDERR "IMAGE: ".Data::Dumper::Dumper($image);
 528
 529         # note: pdf coord system zero is lower left corner
 530         #
 531
 532         if ($pages[-1]->need_more_labels()) {
 533             print STDERR "ADDING LABEL...\n";
 534             $pages[-1]->add_label($image);
 535         }
 536
 537         else {
 538             print STDERR "CREATING NEW PAGE...\n";
 539
 540             push @pages, PDF::LabelPage->new({ top_margin=>$top_margin, bottom_margin=>$bottom_margin, left_margin=>$left_margin, right_margin=>$right_margin, pdf=>$pdf, cols => $label_cols, rows => $label_rows });
 541
 542             $pages[-1]->add_label($image);
 543         }
 544
 545     }
 546
 547     foreach my $p (@pages) {
 548         $p->render();
 549     }
 550
 551     $pdf->close();
 552
 553     #$c->stash->{not_found} = \@not_found;
 554     #$c->stash->{found} = \@found;
 555     $c->stash->{file} = $filename;
 556     $c->stash->{filetype} = 'PDF';
 557     $c->stash->{template} = '/barcode/unique_barcode_download.mas';
 558 }
 559
 560
 561
 562 sub generate_label_code {
 563     my $self = shift;
 564     my $c = shift;
 565
 566     my $dbh = $c->dbc->dbh();
 567
 568     my $h = $dbh->prepare("SELECT nextval('phenome.unique_barcode_label_id_seq')");
 569     $h->execute();
 570     my ($next_val) = $h->fetchrow_array();
 571
 572     print STDERR "nextval is $next_val\n";
 573
 574     my $encoded = Math::Base36::encode_base36($next_val, 7);
 575
 576     return $encoded;
 577
 578 }
 579
 580
 581 1;