use Algorithm::CheckDigits;
use Text::CSV_XS;
use Data::Dumper;
+use Text::Bidi qw( log2vis );
use C4::Context;
use C4::Debug;
use C4::Biblio;
-
-BEGIN {
- use version; our $VERSION = qv('1.0.0_1');
-}
-
-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 = {};
'barcode_type',
'printing_type',
'guidebox',
+ 'oblique_title',
'font',
'font_size',
'callnum_split',
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
# 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);
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;
}
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) = 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) {
- warn sprintf('regexp failed to match string: %s', $_);
- push @parts, $_; # if no match, just push 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();
(
@{ $kohatables->{'biblio'} },
@{ $kohatables->{'biblioitems'} },
- @{ $kohatables->{'items'} }
+ @{ $kohatables->{'items'} },
+ @{ $kohatables->{'branches'} }
)
);
FIELD_LIST:
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.
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'} ;
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
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
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
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'});
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') {
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;
# 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;
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));
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);
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'});
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',
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',
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 {
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;
}
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)
+=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:
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
projects / srvgit / blobdiff