Bug 24545: Fix license statements
[srvgit] / C4 / Labels / Label.pm
index cb6a631..0a1d0a0 100644 (file)
@@ -7,17 +7,18 @@ use Text::Wrap;
 use Algorithm::CheckDigits;
 use Text::CSV_XS;
 use Data::Dumper;
-use Library::CallNumber::LC;
+use Text::Bidi qw( log2vis );
 
 use C4::Context;
 use C4::Debug;
 use C4::Biblio;
-
-BEGIN {
-    use version; our $VERSION = qv('3.07.00.049');
-}
-
-my $possible_decimal = qr/\d{3,}(?:\.\d+)?/; # at least three digits for a DDCN
+use Koha::ClassSources;
+use Koha::ClassSortRules;
+use Koha::ClassSplitRules;
+use C4::ClassSplitRoutine::Dewey;
+use C4::ClassSplitRoutine::LCC;
+use C4::ClassSplitRoutine::Generic;
+use C4::ClassSplitRoutine::RegEx;
 
 sub _check_params {
     my $given_params = {};
@@ -34,6 +35,7 @@ sub _check_params {
         'barcode_type',
         'printing_type',
         'guidebox',
+        'oblique_title',
         'font',
         'font_size',
         'callnum_split',
@@ -96,6 +98,17 @@ sub _get_label_item {
     my $data1 = $sth1->fetchrow_hashref;
     $data->{'itemtype'} = $data1->{'description'};
     $data->{'itype'} = $data1->{'description'};
+    # add *_description fields
+    if ($data->{'homebranch'} || $data->{'holdingbranch'}){
+        require Koha::Libraries;
+        # FIXME Is this used??
+        $data->{'homebranch_description'} = Koha::Libraries->find($data->{'homebranch'})->branchname if $data->{'homebranch'};
+        $data->{'holdingbranch_description'} = Koha::Libraries->find($data->{'holdingbranch'})->branchname if $data->{'holdingbranch'};
+    }
+    $data->{'ccode_description'} = C4::Biblio::GetAuthorisedValueDesc('','', $data->{'ccode'} ,'','','CCODE', 1) if $data->{'ccode'};
+    $data->{'location_description'} = C4::Biblio::GetAuthorisedValueDesc('','', $data->{'location'} ,'','','LOC', 1) if $data->{'location'};
+    $data->{'permanent_location_description'} = C4::Biblio::GetAuthorisedValueDesc('','', $data->{'permanent_location'} ,'','','LOC', 1) if $data->{'permanent_location'};
+
     $barcode_only ? return $data->{'barcode'} : return $data;
 }
 
@@ -104,73 +117,13 @@ sub _get_text_fields {
     my $csv = Text::CSV_XS->new({allow_whitespace => 1});
     my $status = $csv->parse($format_string);
     my @sorted_fields = map {{ 'code' => $_, desc => $_ }} 
-                        map { $_ eq 'callnumber' ? 'itemcallnumber' : $_ } # see bug 5653
+                        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;
 }
 
-
-sub _split_lccn {
-    my ($lccn) = @_;
-    $_ = $lccn;
-    # lccn examples: 'HE8700.7 .P6T44 1983', 'BS2545.E8 H39 1996';
-    my @parts = Library::CallNumber::LC->new($lccn)->components();
-    unless (scalar @parts && defined $parts[0])  {
-        warn sprintf('regexp failed to match string: %s', $_);
-        @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";
-    return @parts;
-}
-
-sub _split_ddcn {
-    my ($ddcn) = @_;
-    $_ = $ddcn;
-    s/\///g;   # in theory we should be able to simply remove all segmentation markers and arrive at the correct call number...
-    my (@parts) = m/
-        ^([-a-zA-Z]*\s?(?:$possible_decimal)?) # R220.3  CD-ROM 787.87 # will require extra splitting
-        \s+
-        (.+)                               # H2793Z H32 c.2 EAS # everything else (except bracketing spaces)
-        \s*
-        /x;
-    unless (scalar @parts)  {
-        warn sprintf('regexp failed to match string: %s', $_);
-        push @parts, $_;     # if no match, just push the whole string.
-    }
-
-    if ($parts[0] =~ /^([-a-zA-Z]+)\s?($possible_decimal)$/) {
-          shift @parts;         # pull off the mathching first element, like example 1
-        unshift @parts, $1, $2; # replace it with the two pieces
-    }
-
-    push @parts, split /\s+/, pop @parts;   # split the last piece into an arbitrary number of pieces at spaces
-    $debug and print STDERR "split_ddcn array: ", join(" | ", @parts), "\n";
-    return @parts;
-}
-
-## NOTE: Custom call number types go here. It may be necessary to create additional splitting algorithms if some custom call numbers
-##      cannot be made to work here. Presently this splits standard non-ddcn, non-lccn fiction and biography call numbers.
-
-sub _split_ccn {
-    my ($fcn) = @_;
-    my @parts = ();
-    # Split call numbers based on spaces
-    push @parts, split /\s+/, $fcn;   # split the call number into an arbitrary number of pieces at spaces
-    if ($parts[-1] !~ /^.*\d-\d.*$/ && $parts[-1] =~ /^(.*\d+)(\D.*)$/) {
-        pop @parts;            # pull off the matching last element
-        push @parts, $1, $2;    # replace it with the two pieces
-    }
-    unless (scalar @parts) {
-        warn sprintf('regexp failed to match string: %s', $_);
-        push (@parts, $_);
-    }
-    $debug and print STDERR "split_ccn array: ", join(" | ", @parts), "\n";
-    return @parts;
-}
-
 sub _get_barcode_data {
     my ( $f, $item, $record ) = @_;
     my $kohatables = _desc_koha_tables();
@@ -206,7 +159,7 @@ sub _get_barcode_data {
         elsif ( $f =~ /^([0-9a-z]{3})(\w)(\W?).*?/ ) {
             my ($field,$subf,$ws) = ($1,$2,$3);
             my $subf_data;
-            my ($itemtag, $itemsubfieldcode) = &GetMarcFromKohaField("items.itemnumber",'');
+            my ($itemtag, $itemsubfieldcode) = &GetMarcFromKohaField( "items.itemnumber" );
             my @marcfield = $record->field($field);
             if(@marcfield) {
                 if($field eq $itemtag) {  # item-level data, we need to get the right item.
@@ -314,13 +267,14 @@ sub new {
         barcode_type            => $params{'barcode_type'},
         printing_type           => $params{'printing_type'},
         guidebox                => $params{'guidebox'},
+        oblique_title           => $params{'oblique_title'},
         font                    => $params{'font'},
         font_size               => $params{'font_size'},
         callnum_split           => $params{'callnum_split'},
         justify                 => $params{'justify'},
         format_string           => $params{'format_string'},
         text_wrap_cols          => $params{'text_wrap_cols'},
-        barcode                 => 0,
+        barcode                 => $params{'barcode'},
     };
     if ($self->{'guidebox'}) {
         $self->{'guidebox'} = _guide_box($self->{'llx'}, $self->{'lly'}, $self->{'width'}, $self->{'height'});
@@ -384,10 +338,18 @@ sub draw_label_text {
     my $font = $self->{'font'};
     my $item = _get_label_item($self->{'item_number'});
     my $label_fields = _get_text_fields($self->{'format_string'});
-    my $record = GetMarcBiblio($item->{'biblionumber'});
+    my $record = GetMarcBiblio({ biblionumber => $item->{'biblionumber'} });
     # FIXME - returns all items, so you can't get data from an embedded holdings field.
     # TODO - add a GetMarcBiblio1item(bibnum,itemnum) or a GetMarcItem(itemnum).
     my $cn_source = ($item->{'cn_source'} ? $item->{'cn_source'} : C4::Context->preference('DefaultClassificationSource'));
+    my $class_source = Koha::ClassSources->find( $cn_source );
+    my ( $split_routine, $regexs );
+    if ($class_source) {
+        my $class_split_rule = Koha::ClassSplitRules->find( $class_source->class_split_rule );
+        $split_routine = $class_split_rule->split_routine;
+        $regexs        = $class_split_rule->regexs;
+    }
+    else { $split_routine = $cn_source }
     LABEL_FIELDS:       # process data for requested fields on current label
     for my $field (@$label_fields) {
         if ($field->{'code'} eq 'itemtype') {
@@ -396,7 +358,18 @@ sub draw_label_text {
         else {
             $field->{'data'} = _get_barcode_data($field->{'code'},$item,$record);
         }
-        ($field->{'code'} eq 'title') ? (($font =~ /T/) ? ($font = 'TI') : ($font = ($font . 'O'))) : ($font = $font);
+        # Find appropriate font it oblique title selected, except main font is oblique
+        if ( ( $field->{'code'} eq 'title' ) and ( $self->{'oblique_title'} == 1 ) ) {
+            if ( $font =~ /^TB$/ ) {
+                $font .= 'I';
+            }
+            elsif ( $font =~ /^TR$/ ) {
+                $font = 'TI';
+            }
+            elsif ( $font !~ /^T/ and $font !~ /O$/ ) {
+                $font .= 'O';
+            }
+        }
         my $field_data = $field->{'data'};
         if ($field_data) {
             $field_data =~ s/\n//g;
@@ -406,14 +379,18 @@ 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' || $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
-            } elsif ($cn_source eq 'ddc') {
-                @label_lines = _split_ddcn($field_data);
-                @label_lines = _split_ccn($field_data) if !@label_lines;
-                push (@label_lines, $field_data) if !@label_lines;
+            if ($split_routine eq 'LCC' || $split_routine eq 'nlm') { # NLM and LCC should be split the same way
+                @label_lines = C4::ClassSplitRoutine::LCC::split_callnumber($field_data);
+                @label_lines = C4::ClassSplitRoutine::Generic::split_callnumber($field_data) unless @label_lines; # If it was not a true lccn, try it as a custom call number
+                push (@label_lines, $field_data) unless @label_lines;         # If it was not that, send it on unsplit
+            } elsif ($split_routine eq 'Dewey') {
+                @label_lines = C4::ClassSplitRoutine::Dewey::split_callnumber($field_data);
+                @label_lines = C4::ClassSplitRoutine::Generic::split_callnumber($field_data) unless @label_lines;
+                push (@label_lines, $field_data) unless @label_lines;
+            } elsif ($split_routine eq 'RegEx' ) {
+                @label_lines = C4::ClassSplitRoutine::RegEx::split_callnumber($field_data, $regexs);
+                @label_lines = C4::ClassSplitRoutine::Generic::split_callnumber($field_data) unless @label_lines;
+                push (@label_lines, $field_data) unless @label_lines;
             } else {
                 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;
@@ -422,8 +399,9 @@ sub draw_label_text {
         else {
             if ($field_data) {
                 $field_data =~ s/\/$//g;       # Here we will strip out all trailing '/' in fields other than the call number...
-                $field_data =~ s/\(/\\\(/g;    # Escape '(' and ')' for the pdf object stream...
-                $field_data =~ s/\)/\\\)/g;
+                # Escaping the parens was causing odd output, see bug 13124
+                # $field_data =~ s/\(/\\\(/g;    # Escape '(' and ')' for the pdf object stream...
+                # $field_data =~ s/\)/\\\)/g;
             }
             eval{$Text::Wrap::columns = $self->{'text_wrap_cols'};};
             my @line = split(/\n/ ,wrap('', '', $field_data));
@@ -442,6 +420,7 @@ 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 '';
+            $line = log2vis( $line );
             my $string_width = C4::Creators::PDF->StrWidth($line, $font, $self->{'font_size'});
             if ($self->{'justify'} eq 'R') {
                 $text_llx = $params{'llx'} + $self->{'width'} - ($self->{'left_text_margin'} + $string_width);
@@ -475,7 +454,7 @@ sub draw_guide_box {
 sub barcode {
     my $self = shift;
     my %params = @_;
-    $params{'barcode_data'} = _get_label_item($self->{'item_number'}, 1) if !$params{'barcode_data'};
+    $params{'barcode_data'} = ($self->{'barcode'} || _get_label_item($self->{'item_number'}, 1)) if !$params{'barcode_data'};
     $params{'barcode_type'} = $self->{'barcode_type'} if !$params{'barcode_type'};
     my $x_scale_factor = 1;
     my $num_of_bars = length($params{'barcode_data'});
@@ -520,7 +499,7 @@ sub barcode {
             PDF::Reuse::Barcode::COOP2of5(
                 x                   => $params{'llx'},
                 y                   => $params{'lly'},
-                value               => "*$params{barcode_data}*",
+                value               => $params{barcode_data},
                 xSize               => $x_scale_factor,
                 ySize               => $params{'y_scale_factor'},
                 mode                    => 'graphic',
@@ -538,7 +517,7 @@ sub barcode {
             PDF::Reuse::Barcode::Industrial2of5(
                 x                   => $params{'llx'},
                 y                   => $params{'lly'},
-                value               => "*$params{barcode_data}*",
+                value               => $params{barcode_data},
                 xSize               => $x_scale_factor,
                 ySize               => $params{'y_scale_factor'},
                 mode                    => 'graphic',
@@ -576,7 +555,7 @@ sub csv_data {
     my $self = shift;
     my $label_fields = _get_text_fields($self->{'format_string'});
     my $item = _get_label_item($self->{'item_number'});
-    my $bib_record = GetMarcBiblio($item->{biblionumber});
+    my $bib_record = GetMarcBiblio({ biblionumber => $item->{biblionumber} });
     my @csv_data = (map { _get_barcode_data($_->{'code'},$item,$bib_record) } @$label_fields);
     return \@csv_data;
 }
@@ -620,7 +599,7 @@ This module provides methods for creating, and otherwise manipulating single lab
             CODE39MOD10     = Code 3 of 9 with modulo 10 checksum
 
 =item .
-            COOP2OF5        = A varient of 2 of 5 barcode based on NEC's "Process 8000" code
+            COOP2OF5        = A variant of 2 of 5 barcode based on NEC's "Process 8000" code
 
 =item .
             INDUSTRIAL2OF5  = The standard 2 of 5 barcode (a binary level bar code developed by Identicon Corp. and Computer Identics Corp. in 1970)
@@ -807,11 +786,18 @@ Copyright 2009 Foundations Bible College.
 
 This file is part of Koha.
 
-Koha is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software
-Foundation; either version 2 of the License, or (at your option) any later version.
+Koha is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3 of the License, or
+(at your option) any later version.
+
+Koha is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
 
-You should have received a copy of the GNU General Public License along with Koha; if not, write to the Free Software Foundation, Inc., 51 Franklin Street,
-Fifth Floor, Boston, MA 02110-1301 USA.
+You should have received a copy of the GNU General Public License
+along with Koha; if not, see <http://www.gnu.org/licenses>.
 
 =head1 DISCLAIMER OF WARRANTY