Bug 12456: The file C4/Maintainance.pm, and by extension the file t/Maintainance...
[koha_fer] / C4 / Labels / Label.pm
index 6437537..eb28006 100644 (file)
@@ -7,13 +7,14 @@ use Text::Wrap;
 use Algorithm::CheckDigits;
 use Text::CSV_XS;
 use Data::Dumper;
+use Library::CallNumber::LC;
 
 use C4::Context;
 use C4::Debug;
 use C4::Biblio;
 
 BEGIN {
-    use version; our $VERSION = qv('1.0.0_1');
+    use version; our $VERSION = qv('3.07.00.049');
 }
 
 my $possible_decimal = qr/\d{3,}(?:\.\d+)?/; # at least three digits for a DDCN
@@ -61,6 +62,8 @@ sub _check_params {
 
 sub _guide_box {
     my ( $llx, $lly, $width, $height ) = @_;
+    return unless ( defined $llx and defined $lly and
+                    defined $width and defined $height );
     my $obj_stream = "q\n";                            # save the graphic state
     $obj_stream .= "0.5 w\n";                          # border line width
     $obj_stream .= "1.0 0.0 0.0  RG\n";                # border color red
@@ -78,7 +81,7 @@ sub _get_label_item {
 #        FIXME This makes for a very bulky data structure; data from tables w/duplicate col names also gets overwritten.
 #        Something like this, perhaps, but this also causes problems because we need more fields sometimes.
 #        SELECT i.barcode, i.itemcallnumber, i.itype, bi.isbn, bi.issn, b.title, b.author
-    my $sth = $dbh->prepare("SELECT bi.*, i.*, b.* FROM items AS i, biblioitems AS bi ,biblio AS b WHERE itemnumber=? AND i.biblioitemnumber=bi.biblioitemnumber AND bi.biblionumber=b.biblionumber;");
+    my $sth = $dbh->prepare("SELECT bi.*, i.*, b.*,br.* FROM items AS i, biblioitems AS bi ,biblio AS b, branches AS br WHERE itemnumber=? AND i.biblioitemnumber=bi.biblioitemnumber AND bi.biblionumber=b.biblionumber AND i.homebranch=br.branchcode;");
     $sth->execute($item_number);
     if ($sth->err) {
         warn sprintf('Database returned the following error: %s', $sth->errstr);
@@ -100,7 +103,9 @@ sub _get_text_fields {
     my $format_string = shift;
     my $csv = Text::CSV_XS->new({allow_whitespace => 1});
     my $status = $csv->parse($format_string);
-    my @sorted_fields = map {{ 'code' => $_, desc => $_ }} $csv->fields();
+    my @sorted_fields = map {{ 'code' => $_, desc => $_ }} 
+                        map { $_ eq 'callnumber' ? 'itemcallnumber' : $_ } # see bug 5653
+                        $csv->fields();
     my $error = $csv->error_input();
     warn sprintf('Text field sort failed with this error: %s', $error) if $error;
     return \@sorted_fields;
@@ -111,18 +116,10 @@ sub _split_lccn {
     my ($lccn) = @_;
     $_ = $lccn;
     # lccn examples: 'HE8700.7 .P6T44 1983', 'BS2545.E8 H39 1996';
-    my (@parts) = m/
-        ^([a-zA-Z]+)      # HE          # BS
-        (\d+(?:\.\d)*)    # 8700.7      # 2545
-        \s*
-        (\.*\D+\d*)       # .P6         # .E8
-        \s*
-        (.*)              # T44 1983    # H39 1996   # everything else (except any bracketing spaces)
-        \s*
-        /x;
-    unless (scalar @parts)  {
+    my @parts = Library::CallNumber::LC->new($lccn)->components();
+    unless (scalar @parts && defined $parts[0])  {
         warn sprintf('regexp failed to match string: %s', $_);
-        push @parts, $_;     # if no match, just push the whole string.
+        @parts = $_;     # if no match, just use the whole string.
     }
     push @parts, split /\s+/, pop @parts;   # split the last piece into an arbitrary number of pieces at spaces
     $debug and warn "split_lccn array: ", join(" | ", @parts), "\n";
@@ -183,7 +180,8 @@ sub _get_barcode_data {
         (
             @{ $kohatables->{'biblio'} },
             @{ $kohatables->{'biblioitems'} },
-            @{ $kohatables->{'items'} }
+            @{ $kohatables->{'items'} },
+            @{ $kohatables->{'branches'} }
         )
     );
     FIELD_LIST:
@@ -247,7 +245,7 @@ sub _get_barcode_data {
 sub _desc_koha_tables {
        my $dbh = C4::Context->dbh();
        my $kohatables;
-       for my $table ( 'biblio','biblioitems','items' ) {
+       for my $table ( 'biblio','biblioitems','items','branches' ) {
                my $sth = $dbh->column_info(undef,undef,$table,'%');
                while (my $info = $sth->fetchrow_hashref()){
                        push @{$kohatables->{$table}} , $info->{'COLUMN_NAME'} ;
@@ -271,7 +269,7 @@ sub _BIB {
 
 sub _BAR {
     my $self = shift;
-    my $barcode_llx = $self->{'llx'} + $self->{'left_text_margin'};     # this places the bottom left of the barcode the left text margin distance to right of the the left edge of the label ($llx)
+    my $barcode_llx = $self->{'llx'} + $self->{'left_text_margin'};     # this places the bottom left of the barcode the left text margin distance to right of the left edge of the label ($llx)
     my $barcode_lly = $self->{'lly'} + $self->{'top_text_margin'};      # this places the bottom left of the barcode the top text margin distance above the bottom of the label ($lly)
     my $barcode_width = 0.8 * $self->{'width'};                         # this scales the barcode width to 80% of the label width
     my $barcode_y_scale_factor = 0.01 * $self->{'height'};              # this scales the barcode height to 10% of the label height
@@ -280,7 +278,7 @@ sub _BAR {
 
 sub _BIBBAR {
     my $self = shift;
-    my $barcode_llx = $self->{'llx'} + $self->{'left_text_margin'};     # this places the bottom left of the barcode the left text margin distance to right of the the left edge of the label ($self->{'llx'})
+    my $barcode_llx = $self->{'llx'} + $self->{'left_text_margin'};     # this places the bottom left of the barcode the left text margin distance to right of the left edge of the label ($self->{'llx'})
     my $barcode_lly = $self->{'lly'} + $self->{'top_text_margin'};      # this places the bottom left of the barcode the top text margin distance above the bottom of the label ($lly)
     my $barcode_width = 0.8 * $self->{'width'};                         # this scales the barcode width to 80% of the label width
     my $barcode_y_scale_factor = 0.01 * $self->{'height'};              # this scales the barcode height to 10% of the label height
@@ -292,7 +290,7 @@ sub _BIBBAR {
 
 sub _BARBIB {
     my $self = shift;
-    my $barcode_llx = $self->{'llx'} + $self->{'left_text_margin'};                             # this places the bottom left of the barcode the left text margin distance to right of the the left edge of the label ($self->{'llx'})
+    my $barcode_llx = $self->{'llx'} + $self->{'left_text_margin'};                             # this places the bottom left of the barcode the left text margin distance to right of the left edge of the label ($self->{'llx'})
     my $barcode_lly = ($self->{'lly'} + $self->{'height'}) - $self->{'top_text_margin'};        # this places the bottom left of the barcode the top text margin distance below the top of the label ($self->{'lly'})
     my $barcode_width = 0.8 * $self->{'width'};                                                 # this scales the barcode width to 80% of the label width
     my $barcode_y_scale_factor = 0.01 * $self->{'height'};                                      # this scales the barcode height to 10% of the label height
@@ -398,6 +396,7 @@ sub draw_label_text {
         else {
             $field->{'data'} = _get_barcode_data($field->{'code'},$item,$record);
         }
+        #FIXME: We should not force the title to oblique; this should be selectible in the layout configuration
         ($field->{'code'} eq 'title') ? (($font =~ /T/) ? ($font = 'TI') : ($font = ($font . 'O'))) : ($font = $font);
         my $field_data = $field->{'data'};
         if ($field_data) {
@@ -408,7 +407,7 @@ sub draw_label_text {
         # Fields which hold call number data  FIXME: ( 060? 090? 092? 099? )
         my @callnumber_list = qw(itemcallnumber 050a 050b 082a 952o 995k);
         if ((grep {$field->{'code'} =~ m/$_/} @callnumber_list) and ($self->{'printing_type'} eq 'BIB') and ($self->{'callnum_split'})) { # If the field contains the call number, we do some sp
-            if ($cn_source eq 'lcc') {
+            if ($cn_source eq 'lcc' || $cn_source eq 'nlm') { # NLM and LCC should be split the same way
                 @label_lines = _split_lccn($field_data);
                 @label_lines = _split_ccn($field_data) if !@label_lines;    # If it was not a true lccn, try it as a custom call number
                 push (@label_lines, $field_data) if !@label_lines;         # If it was not that, send it on unsplit
@@ -417,7 +416,7 @@ sub draw_label_text {
                 @label_lines = _split_ccn($field_data) if !@label_lines;
                 push (@label_lines, $field_data) if !@label_lines;
             } else {
-                warn sprintf('Call number splitting failed for: %s. Please add this call number to bug #2500 at bugs.koha.org', $field_data);
+                warn sprintf('Call number splitting failed for: %s. Please add this call number to bug #2500 at bugs.koha-community.org', $field_data);
                 push @label_lines, $field_data;
             }
         }
@@ -444,7 +443,8 @@ sub draw_label_text {
         LABEL_LINES:    # generate lines of label text for current field
         foreach my $line (@label_lines) {
             next LABEL_LINES if $line eq '';
-            my $string_width = C4::Creators::PDF->StrWidth($line, $font, $self->{'font_size'});
+            my $fontName = C4::Creators::PDF->Font($font);
+            my $string_width = C4::Creators::PDF->StrWidth($line, $fontName, $self->{'font_size'});
             if ($self->{'justify'} eq 'R') {
                 $text_llx = $params{'llx'} + $self->{'width'} - ($self->{'left_text_margin'} + $string_width);
             }
@@ -550,6 +550,28 @@ sub barcode {
             warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
         }
     }
+    elsif ($params{'barcode_type'} eq 'EAN13') {
+        $bar_length = 4; # FIXME
+    $num_of_bars = 13;
+        $tot_bar_length = ($bar_length * $num_of_bars) + ($guard_length * 2);
+        $x_scale_factor = ($params{'width'} / $tot_bar_length) * 0.9;
+        eval {
+            PDF::Reuse::Barcode::EAN13(
+                x                   => $params{'llx'},
+                y                   => $params{'lly'},
+                value               => sprintf('%013d',$params{barcode_data}),
+#                xSize               => $x_scale_factor,
+#                ySize               => $params{'y_scale_factor'},
+                mode                    => 'graphic',
+            );
+        };
+        if ($@) {
+            warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
+        }
+    }
+    else {
+    warn "unknown barcode_type: $params{barcode_type}";
+    }
 }
 
 sub csv_data {
@@ -605,6 +627,9 @@ This module provides methods for creating, and otherwise manipulating single lab
 =item .
             INDUSTRIAL2OF5  = The standard 2 of 5 barcode (a binary level bar code developed by Identicon Corp. and Computer Identics Corp. in 1970)
 
+=item .
+            EAN13           = The standard EAN-13 barcode
+
 =back
 
         C<printing_type>        Defines the general layout to be used on labels. NOTE: At present there are only five printing types supported in the label creator code: