fixing permissions on scripts
[koha.git] / C4 / Labels.pm
1 package C4::Labels;
2
3 # Copyright 2006 Katipo Communications.
4 #
5 # This file is part of Koha.
6 #
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
10 # version.
11 #
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public License along with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA  02111-1307 USA
19
20 use strict;
21 require Exporter;
22
23 use vars qw($VERSION @ISA @EXPORT);
24
25 use PDF::Reuse;
26 use Text::Wrap;
27
28 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;
29     shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v );
30 };
31
32 =head1 NAME
33
34 C4::Labels - Functions for printing spine labels and barcodes in Koha
35
36 =head1 FUNCTIONS
37
38 =over 2
39
40 =cut
41
42 @ISA = qw(Exporter);
43 @EXPORT = qw(
44         &get_label_options &get_label_items
45         &build_circ_barcode &draw_boundaries
46   &drawbox &GetActiveLabelTemplate
47   &GetAllLabelTemplates &DeleteTemplate
48   &GetSingleLabelTemplate &SaveTemplate
49   &CreateTemplate &SetActiveTemplate
50   &SaveConf &DrawSpineText &GetTextWrapCols
51   &GetUnitsValue &DrawBarcode
52
53 );
54
55 =item get_label_options;
56
57         $options = get_label_options()
58
59
60 Return a pointer on a hash list containing info from labels_conf table in Koha DB.
61
62 =cut
63
64 #'
65 sub get_label_options {
66     my $dbh    = C4::Context->dbh;
67     my $query2 = " SELECT * FROM labels_conf LIMIT 1 ";
68     my $sth    = $dbh->prepare($query2);
69     $sth->execute();
70     my $conf_data = $sth->fetchrow_hashref;
71     $sth->finish;
72     return $conf_data;
73 }
74
75 sub GetUnitsValue {
76     my ($units) = @_;
77     my $unitvalue;
78
79     $unitvalue = '1'          if ( $units eq 'POINT' );
80     $unitvalue = '2.83464567' if ( $units eq 'MM' );
81     $unitvalue = '28.3464567' if ( $units eq 'CM' );
82     $unitvalue = 72           if ( $units eq 'INCH' );
83     warn $units, $unitvalue;
84     return $unitvalue;
85 }
86
87 sub GetTextWrapCols {
88     my ( $fontsize, $label_width ) = @_;
89     my $string           = "0";
90     my $left_text_margin = 3;
91     my ( $strtmp, $strwidth );
92     my $count     = 0;
93     my $textlimit = $label_width - $left_text_margin;
94
95     while ( $strwidth < $textlimit ) {
96         $strwidth = prStrWidth( $string, 'C', $fontsize );
97         $string   = $string . '0';
98
99         #       warn "strwidth $strwidth, $textlimit, $string";
100         $count++;
101     }
102     return $count;
103 }
104
105 sub GetActiveLabelTemplate {
106     my $dbh   = C4::Context->dbh;
107     my $query = " SELECT * FROM labels_templates where active = 1 limit 1";
108     my $sth   = $dbh->prepare($query);
109     $sth->execute();
110     my $active_tmpl = $sth->fetchrow_hashref;
111     $sth->finish;
112     return $active_tmpl;
113 }
114
115 sub GetSingleLabelTemplate {
116     my ($tmpl_code) = @_;
117     my $dbh         = C4::Context->dbh;
118     my $query       = " SELECT * FROM labels_templates where tmpl_code = ?";
119     my $sth         = $dbh->prepare($query);
120     $sth->execute($tmpl_code);
121     my $template = $sth->fetchrow_hashref;
122     $sth->finish;
123     return $template;
124 }
125
126 sub SetActiveTemplate {
127
128     my ($tmpl_id) = @_;
129     warn "TMPL_ID = $tmpl_id";
130     my $dbh   = C4::Context->dbh;
131     my $query = " UPDATE labels_templates SET active = NULL";
132     my $sth   = $dbh->prepare($query);
133     $sth->execute;
134
135     $query = "UPDATE labels_templates SET active = 1 WHERE tmpl_id = ?";
136     $sth   = $dbh->prepare($query);
137     $sth->execute($tmpl_id);
138     $sth->finish;
139 }
140
141 sub DeleteTemplate {
142     my ($tmpl_code) = @_;
143     my $dbh         = C4::Context->dbh;
144     my $query       = " DELETE  FROM labels_templates where tmpl_code = ?";
145     my $sth         = $dbh->prepare($query);
146     $sth->execute($tmpl_code);
147     $sth->finish;
148 }
149
150 sub SaveTemplate {
151
152     my (
153         $tmpl_id,     $tmpl_code,   $tmpl_desc,    $page_width,
154         $page_height, $label_width, $label_height, $topmargin,
155         $leftmargin,  $cols,        $rows,         $colgap,
156         $rowgap,      $active,      $fontsize,     $units
157       )
158       = @_;
159
160     #warn "FONTSIZE =$fontsize";
161
162     my $dbh   = C4::Context->dbh;
163     my $query =
164       " UPDATE labels_templates SET tmpl_code=?, tmpl_desc=?, page_width=?,
165                          page_height=?, label_width=?, label_height=?, topmargin=?,
166                          leftmargin=?, cols=?, rows=?, colgap=?, rowgap=?, fontsize=?,
167                                                  units=? 
168                   WHERE tmpl_id = ?";
169
170     my $sth = $dbh->prepare($query);
171     $sth->execute(
172         $tmpl_code,   $tmpl_desc,    $page_width, $page_height,
173         $label_width, $label_height, $topmargin,  $leftmargin,
174         $cols,        $rows,         $colgap,     $rowgap,
175         $fontsize,    $units,        $tmpl_id
176     );
177     $sth->finish;
178
179     SetActiveTemplate($tmpl_id) if ( $active eq '1' );
180 }
181
182 sub CreateTemplate {
183     my $tmpl_id;
184     my (
185         $tmpl_code,   $tmpl_desc,    $page_width, $page_height,
186         $label_width, $label_height, $topmargin,  $leftmargin,
187         $cols,        $rows,         $colgap,     $rowgap,
188         $active,      $fontsize,     $units
189       )
190       = @_;
191
192     my $dbh = C4::Context->dbh;
193
194     my $query = "INSERT INTO labels_templates (tmpl_code, tmpl_desc, page_width,
195                          page_height, label_width, label_height, topmargin,
196                          leftmargin, cols, rows, colgap, rowgap, fontsize, units)
197                          VALUES(?,?,?,?,?,?,?,?,?,?,?,?,?,?)";
198
199     my $sth = $dbh->prepare($query);
200     $sth->execute(
201         $tmpl_code,   $tmpl_desc,    $page_width, $page_height,
202         $label_width, $label_height, $topmargin,  $leftmargin,
203         $cols,        $rows,         $colgap,     $rowgap,
204         $fontsize,    $units
205     );
206
207     warn "ACTIVE = $active";
208
209     if ( $active eq '1' ) {
210
211   # get the tmpl_id of the newly created template, then call SetActiveTemplate()
212         my $query =
213           "SELECT tmpl_id from labels_templates order by tmpl_id desc limit 1";
214         my $sth = $dbh->prepare($query);
215         $sth->execute();
216
217         my $data    = $sth->fetchrow_hashref;
218         my $tmpl_id = $data->{'tmpl_id'};
219
220         SetActiveTemplate($tmpl_id);
221         $sth->finish;
222     }
223     return $tmpl_id;
224 }
225
226 sub GetAllLabelTemplates {
227     my $dbh = C4::Context->dbh;
228
229     # get the actual items to be printed.
230     my @data;
231     my $query = " Select * from labels_templates ";
232     my $sth   = $dbh->prepare($query);
233     $sth->execute();
234     my @resultsloop;
235     while ( my $data = $sth->fetchrow_hashref ) {
236         push( @resultsloop, $data );
237     }
238     $sth->finish;
239
240     return @resultsloop;
241 }
242
243 sub SaveConf {
244
245     my (
246         $barcodetype,    $title,  $isbn,    $itemtype,
247         $bcn,            $dcn,    $classif, $subclass,
248         $itemcallnumber, $author, $tmpl_id, $printingtype,
249         $guidebox,       $startlabel
250       )
251       = @_;
252
253     my $dbh    = C4::Context->dbh;
254     my $query2 = "DELETE FROM labels_conf";
255     my $sth2   = $dbh->prepare($query2);
256     $sth2->execute;
257     $query2 = "INSERT INTO labels_conf
258             ( barcodetype, title, isbn, itemtype, barcode,
259               dewey, class, subclass, itemcallnumber, author, printingtype,
260                 guidebox, startlabel )
261                values ( ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ? )";
262     $sth2 = $dbh->prepare($query2);
263     $sth2->execute(
264         $barcodetype,    $title,  $isbn,         $itemtype,
265         $bcn,            $dcn,    $classif,      $subclass,
266         $itemcallnumber, $author, $printingtype, $guidebox,
267         $startlabel
268     );
269     $sth2->finish;
270
271     SetActiveTemplate($tmpl_id);
272     return;
273 }
274
275 =item get_label_items;
276
277         $options = get_label_items()
278
279
280 Returns an array of references-to-hash, whos keys are the field from the biblio, biblioitems, items and labels tables in the Koha database.
281
282 =cut
283
284 #'
285 sub get_label_items {
286     my $dbh = C4::Context->dbh;
287
288     # get the actual items to be printed.
289     my @data;
290     my $query3 = " Select * from labels ";
291     my $sth    = $dbh->prepare($query3);
292     $sth->execute();
293     my @resultsloop;
294     my $cnt = $sth->rows;
295     my $i1  = 1;
296     while ( my $data = $sth->fetchrow_hashref ) {
297
298         # lets get some summary info from each item
299         my $query1 =
300           " select * from biblio, biblioitems, items where itemnumber = ? and
301                                 items.biblioitemnumber=biblioitems.biblioitemnumber and
302                                 biblioitems.biblionumber=biblio.biblionumber";
303
304         my $sth1 = $dbh->prepare($query1);
305         $sth1->execute( $data->{'itemnumber'} );
306         my $data1 = $sth1->fetchrow_hashref();
307
308         push( @resultsloop, $data1 );
309         $sth1->finish;
310
311         $i1++;
312     }
313     $sth->finish;
314     return @resultsloop;
315 }
316
317 sub DrawSpineText {
318
319     my ( $y_pos, $label_height, $fontsize, $x_pos, $left_text_margin,
320         $text_wrap_cols, $item, $conf_data )
321       = @_;
322
323     $Text::Wrap::columns   = $text_wrap_cols;
324     $Text::Wrap::separator = "\n";
325
326     my $str;
327
328     my $top_text_margin = ( $fontsize + 3 );
329     my $line_spacer = ($fontsize);    # number of pixels between text rows.
330
331     # add your printable fields manually in here
332     my @fields =
333       qw (dewey isbn classification itemtype subclass itemcallnumber);
334     my $vPos = ( $y_pos + ( $label_height - $top_text_margin ) );
335     my $hPos = ( $x_pos + $left_text_margin );
336
337     foreach my $field (@fields) {
338
339         # if the display option for this field is selected in the DB,
340         # and the item record has some values for this field, display it.
341         if ( $$conf_data->{"$field"} && $$item->{"$field"} ) {
342
343             #            warn "CONF_TYPE = $field";
344
345             # get the string
346             $str = $$item->{"$field"};
347
348             # strip out naughty existing nl/cr's
349             $str =~ s/\n//g;
350             $str =~ s/\r//g;
351
352             # chop the string up into _upto_ 12 chunks
353             # and seperate the chunks with newlines
354
355             $str = wrap( "", "", "$str" );
356             $str = wrap( "", "", "$str" );
357
358             # split the chunks between newline's, into an array
359             my @strings = split /\n/, $str;
360
361             # then loop for each string line
362             foreach my $str (@strings) {
363
364                 #warn "HPOS ,  VPOS $hPos, $vPos ";
365                 prText( $hPos, $vPos, $str );
366                 $vPos = $vPos - $line_spacer;
367             }
368         }    # if field is valid
369     }    #foreach feild
370 }
371
372 sub DrawBarcode {
373
374     my ( $x_pos, $y_pos, $height, $width, $barcode, $barcodetype ) = @_;
375     $barcode = '123456789';
376     my $num_of_bars = length($barcode);
377     my $bar_width = ( ( $width / 10 ) * 8 );    # %80 of lenght of label width
378     my $tot_bar_length;
379     my $bar_length;
380     my $guard_length = 10;
381     my $xsize_ratio;
382
383     if ( $barcodetype eq 'Code39' ) {
384         $bar_length     = '14.4333333333333';
385         $tot_bar_length =
386           ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
387         $xsize_ratio = ( $bar_width / $tot_bar_length );
388         eval {
389             PDF::Reuse::Barcode::Code39(
390                 x => ( $x_pos + ( $width / 10 ) ),
391                 y => ( $y_pos + ( $height / 10 ) ),
392                 value => "*$barcode*",
393                 ySize => ( .02 * $height ),
394                 xSize => $xsize_ratio,
395                 hide_asterisk => $xsize_ratio,
396             );
397         };
398         if ($@) {
399             warn "$barcodetype, $barcode FAILED:$@";
400         }
401     }
402
403     elsif ( $barcodetype eq 'COOP2of5' ) {
404         $bar_length     = '9.43333333333333';
405         $tot_bar_length =
406           ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
407         $xsize_ratio = ( $bar_width / $tot_bar_length ) * .9;
408         eval {
409             PDF::Reuse::Barcode::COOP2of5(
410                 x => ( $x_pos + ( $width / 10 ) ),
411                 y => ( $y_pos + ( $height / 10 ) ),
412                 value => $barcode,
413                 ySize => ( .02 * $height ),
414                 xSize => $xsize_ratio,
415             );
416         };
417         if ($@) {
418             warn "$barcodetype, $barcode FAILED:$@";
419         }
420     }
421
422     elsif ( $barcodetype eq 'Industrial2of5' ) {
423         $bar_length     = '13.1333333333333';
424         $tot_bar_length =
425           ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
426         $xsize_ratio = ( $bar_width / $tot_bar_length ) * .9;
427         eval {
428             PDF::Reuse::Barcode::Industrial2of5(
429                 x => ( $x_pos + ( $width / 10 ) ),
430                 y => ( $y_pos + ( $height / 10 ) ),
431                 value => $barcode,
432                 ySize => ( .02 * $height ),
433                 xSize => $xsize_ratio,
434             );
435         };
436         if ($@) {
437             warn "$barcodetype, $barcode FAILED:$@";
438         }
439     }
440     my $moo2 = $tot_bar_length * $xsize_ratio;
441
442     warn " $x_pos, $y_pos, $barcode, $barcodetype\n";
443     warn
444 "BAR_WDTH = $bar_width, TOT.BAR.LGHT=$tot_bar_length  R*TOT.BAR =$moo2 \n";
445 }
446
447 =item build_circ_barcode;
448
449   build_circ_barcode( $x_pos, $y_pos, $barcode,
450                 $barcodetype, \$item);
451
452 $item is the result of a previous call to get_label_items();
453
454 =cut
455
456 #'
457 sub build_circ_barcode {
458     my ( $x_pos_circ, $y_pos, $value, $barcodetype, $item ) = @_;
459
460     #warn "value = $value\n";
461
462     #$DB::single = 1;
463
464     if ( $barcodetype eq 'EAN13' ) {
465
466         #testing EAN13 barcodes hack
467         $value = $value . '000000000';
468         $value =~ s/-//;
469         $value = substr( $value, 0, 12 );
470
471         #warn $value;
472         eval {
473             PDF::Reuse::Barcode::EAN13(
474                 x     => ( $x_pos_circ + 27 ),
475                 y     => ( $y_pos + 15 ),
476                 value => $value,
477
478                 #            prolong => 2.96,
479                 #            xSize   => 1.5,
480
481                 # ySize   => 1.2,
482
483 # added for xpdf compat. doesnt use type3 fonts., but increases filesize from 20k to 200k
484 # i think its embedding extra fonts in the pdf file.
485 #  mode => 'graphic',
486             );
487         };
488         if ($@) {
489             $item->{'barcodeerror'} = 1;
490
491             #warn "EAN13BARCODE FAILED:$@";
492         }
493
494         #warn $barcodetype;
495
496     }
497     elsif ( $barcodetype eq 'Code39' ) {
498         eval {
499             PDF::Reuse::Barcode::Code39(
500                 x     => ( $x_pos_circ + 9 ),
501                 y     => ( $y_pos + 15 ),
502                 #           prolong => 2.96,
503                 xSize => .85,
504                 ySize => 1.3,
505                                 value => "*$value*",
506                                 #hide_asterisk => $xsize_ratio,
507             );
508         };
509         if ($@) {
510             $item->{'barcodeerror'} = 1;
511
512             #warn "CODE39BARCODE $value FAILED:$@";
513         }
514
515         #warn $barcodetype;
516
517     }
518
519     elsif ( $barcodetype eq 'Matrix2of5' ) {
520
521         #warn "MATRIX ELSE:";
522
523         #testing MATRIX25  barcodes hack
524         #    $value = $value.'000000000';
525         $value =~ s/-//;
526
527         #    $value = substr( $value, 0, 12 );
528         #warn $value;
529
530         eval {
531             PDF::Reuse::Barcode::Matrix2of5(
532                 x     => ( $x_pos_circ + 27 ),
533                 y     => ( $y_pos + 15 ),
534                 value => $value,
535
536                 #        prolong => 2.96,
537                 #       xSize   => 1.5,
538
539                 # ySize   => 1.2,
540             );
541         };
542         if ($@) {
543             $item->{'barcodeerror'} = 1;
544
545             #warn "BARCODE FAILED:$@";
546         }
547
548         #warn $barcodetype;
549
550     }
551
552     elsif ( $barcodetype eq 'EAN8' ) {
553
554         #testing ean8 barcodes hack
555         $value = $value . '000000000';
556         $value =~ s/-//;
557         $value = substr( $value, 0, 8 );
558
559         #warn $value;
560
561         #warn "EAN8 ELSEIF";
562         eval {
563             PDF::Reuse::Barcode::EAN8(
564                 x       => ( $x_pos_circ + 42 ),
565                 y       => ( $y_pos + 15 ),
566                 value   => $value,
567                 prolong => 2.96,
568                 xSize   => 1.5,
569
570                 # ySize   => 1.2,
571             );
572         };
573
574         if ($@) {
575             $item->{'barcodeerror'} = 1;
576
577             #warn "BARCODE FAILED:$@";
578         }
579
580         #warn $barcodetype;
581
582     }
583
584     elsif ( $barcodetype eq 'UPC-E' ) {
585         eval {
586             PDF::Reuse::Barcode::UPCE(
587                 x       => ( $x_pos_circ + 27 ),
588                 y       => ( $y_pos + 15 ),
589                 value   => $value,
590                 prolong => 2.96,
591                 xSize   => 1.5,
592
593                 # ySize   => 1.2,
594             );
595         };
596
597         if ($@) {
598             $item->{'barcodeerror'} = 1;
599
600             #warn "BARCODE FAILED:$@";
601         }
602
603         #warn $barcodetype;
604
605     }
606     elsif ( $barcodetype eq 'NW7' ) {
607         eval {
608             PDF::Reuse::Barcode::NW7(
609                 x       => ( $x_pos_circ + 27 ),
610                 y       => ( $y_pos + 15 ),
611                 value   => $value,
612                 prolong => 2.96,
613                 xSize   => 1.5,
614
615                 # ySize   => 1.2,
616             );
617         };
618
619         if ($@) {
620             $item->{'barcodeerror'} = 1;
621
622             #warn "BARCODE FAILED:$@";
623         }
624
625         #warn $barcodetype;
626
627     }
628     elsif ( $barcodetype eq 'ITF' ) {
629         eval {
630             PDF::Reuse::Barcode::ITF(
631                 x       => ( $x_pos_circ + 27 ),
632                 y       => ( $y_pos + 15 ),
633                 value   => $value,
634                 prolong => 2.96,
635                 xSize   => 1.5,
636
637                 # ySize   => 1.2,
638             );
639         };
640
641         if ($@) {
642             $item->{'barcodeerror'} = 1;
643
644             #warn "BARCODE FAILED:$@";
645         }
646
647         #warn $barcodetype;
648
649     }
650     elsif ( $barcodetype eq 'Industrial2of5' ) {
651         eval {
652             PDF::Reuse::Barcode::Industrial2of5(
653                 x       => ( $x_pos_circ + 27 ),
654                 y       => ( $y_pos + 15 ),
655                 value   => $value,
656                 prolong => 2.96,
657                 xSize   => 1.5,
658
659                 # ySize   => 1.2,
660             );
661         };
662         if ($@) {
663             $item->{'barcodeerror'} = 1;
664
665             #warn "BARCODE FAILED:$@";
666         }
667
668         #warn $barcodetype;
669
670     }
671     elsif ( $barcodetype eq 'IATA2of5' ) {
672         eval {
673             PDF::Reuse::Barcode::IATA2of5(
674                 x       => ( $x_pos_circ + 27 ),
675                 y       => ( $y_pos + 15 ),
676                 value   => $value,
677                 prolong => 2.96,
678                 xSize   => 1.5,
679
680                 # ySize   => 1.2,
681             );
682         };
683         if ($@) {
684             $item->{'barcodeerror'} = 1;
685
686             #warn "BARCODE FAILED:$@";
687         }
688
689         #warn $barcodetype;
690
691     }
692
693     elsif ( $barcodetype eq 'COOP2of5' ) {
694         eval {
695             PDF::Reuse::Barcode::COOP2of5(
696                 x       => ( $x_pos_circ + 27 ),
697                 y       => ( $y_pos + 15 ),
698                 value   => $value,
699                 prolong => 2.96,
700                 xSize   => 1.5,
701
702                 # ySize   => 1.2,
703             );
704         };
705         if ($@) {
706             $item->{'barcodeerror'} = 1;
707
708             #warn "BARCODE FAILED:$@";
709         }
710
711         #warn $barcodetype;
712
713     }
714     elsif ( $barcodetype eq 'UPC-A' ) {
715
716         eval {
717             PDF::Reuse::Barcode::UPCA(
718                 x       => ( $x_pos_circ + 27 ),
719                 y       => ( $y_pos + 15 ),
720                 value   => $value,
721                 prolong => 2.96,
722                 xSize   => 1.5,
723
724                 # ySize   => 1.2,
725             );
726         };
727         if ($@) {
728             $item->{'barcodeerror'} = 1;
729
730             #warn "BARCODE FAILED:$@";
731         }
732
733         #warn $barcodetype;
734
735     }
736
737 }
738
739 =item draw_boundaries
740
741  sub draw_boundaries ($x_pos_spine, $x_pos_circ1, $x_pos_circ2,
742                 $y_pos, $spine_width, $label_height, $circ_width)  
743
744 This sub draws boundary lines where the label outlines are, to aid in printer testing, and debugging.
745
746 =cut
747
748 #'
749 sub draw_boundaries {
750
751     my (
752         $x_pos_spine, $x_pos_circ1,  $x_pos_circ2, $y_pos,
753         $spine_width, $label_height, $circ_width
754       )
755       = @_;
756
757     my $y_pos_initial = ( ( 792 - 36 ) - 90 );
758     $y_pos            = $y_pos_initial;
759     my $i             = 1;
760
761     for ( $i = 1 ; $i <= 8 ; $i++ ) {
762
763         &drawbox( $x_pos_spine, $y_pos, ($spine_width), ($label_height) );
764
765    #warn "OLD BOXES  x=$x_pos_spine, y=$y_pos, w=$spine_width, h=$label_height";
766         &drawbox( $x_pos_circ1, $y_pos, ($circ_width), ($label_height) );
767         &drawbox( $x_pos_circ2, $y_pos, ($circ_width), ($label_height) );
768
769         $y_pos = ( $y_pos - $label_height );
770
771     }
772 }
773
774 =item drawbox
775
776         sub drawbox {   $lower_left_x, $lower_left_y, 
777                         $upper_right_x, $upper_right_y )
778
779 this is a low level sub, that draws a pdf box, it is called by draw_boxes
780
781 FYI: the  $upper_right_x and $upper_right_y values are RELATIVE to  $lower_left_x and $lower_left_y
782
783 and $lower_left_x, $lower_left_y are ABSOLUTE, this caught me out!
784
785 =cut
786
787 #'
788 sub drawbox {
789     my ( $llx, $lly, $urx, $ury ) = @_;
790
791     #    warn "llx,y= $llx,$lly  ,   urx,y=$urx,$ury \n";
792
793     my $str = "q\n";    # save the graphic state
794     $str .= "0.5 w\n";                     # border color red
795     $str .= "1.0 0.0 0.0  RG\n";           # border color red
796     $str .= "0.5 0.75 1.0 rg\n";           # fill color blue
797     $str .= "$llx $lly $urx $ury re\n";    # a rectangle
798     $str .= "B\n";                         # fill (and a little more)
799     $str .= "Q\n";                         # save the graphic state
800
801     prAdd($str);
802
803 }
804
805 END { }    # module clean-up code here (global destructor)
806
807 1;
808 __END__
809
810 =back
811
812 =head1 AUTHOR
813
814 Mason James <mason@katipo.co.nz>
815 =cut
816