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