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