use strict;
use warnings;
-use Sys::Syslog qw(syslog);
use Text::Wrap;
use Algorithm::CheckDigits;
use Text::CSV_XS;
+use Data::Dumper;
use C4::Context;
use C4::Debug;
$given_params = {@_};
foreach my $key (keys %{$given_params}) {
if (!(grep m/$key/, @valid_label_params)) {
- syslog("LOG_ERR", "C4::Labels::Label : Unrecognized parameter type of \"%s\".", $key);
+ warn sprintf('Unrecognized parameter type of "%s".', $key);
$exit_code = 1;
}
}
}
else {
if (!(grep m/$_/, @valid_label_params)) {
- syslog("LOG_ERR", "C4::Labels::Label : Unrecognized parameter type of \"%s\".", $_);
+ warn sprintf('Unrecognized parameter type of "%s".', $_);
$exit_code = 1;
}
}
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;");
$sth->execute($item_number);
if ($sth->err) {
- syslog("LOG_ERR", "C4::Labels::Label::_get_label_item : Database returned the following error: %s", $sth->errstr);
+ warn sprintf('Database returned the following error: %s', $sth->errstr);
}
my $data = $sth->fetchrow_hashref;
# Replaced item's itemtype with the more user-friendly description...
my $sth1 = $dbh->prepare("SELECT itemtype,description FROM itemtypes WHERE itemtype = ?");
$sth1->execute($data->{'itemtype'});
if ($sth1->err) {
- syslog("LOG_ERR", "C4::Labels::Label::_get_label_item : Database returned the following error: %s", $sth1->errstr);
+ warn sprintf('Database returned the following error: %s', $sth1->errstr);
}
- my $data1 = $sth->fetchrow_hashref;
+ my $data1 = $sth1->fetchrow_hashref;
$data->{'itemtype'} = $data1->{'description'};
$data->{'itype'} = $data1->{'description'};
$barcode_only ? return $data->{'barcode'} : return $data;
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();
- syslog("LOG_ERR", "C4::Labels::Label::_get_text_fields : Text field sort failed with this error: %s", $error) if $error;
+ warn sprintf('Text field sort failed with this error: %s', $error) if $error;
return \@sorted_fields;
}
sub _split_lccn {
- my ($lccn) = @_;
+ my ($lccn) = @_;
$_ = $lccn;
# lccn examples: 'HE8700.7 .P6T44 1983', 'BS2545.E8 H39 1996';
my (@parts) = m/
\s*
/x;
unless (scalar @parts) {
- syslog("LOG_ERR", "C4::Labels::Label::_split_lccn : regexp failed to match string: %s", $_);
+ 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 print STDERR "split_lccn array: ", join(" | ", @parts), "\n";
+ $debug and warn "split_lccn array: ", join(" | ", @parts), "\n";
return @parts;
}
$_ = $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-]+(?:$possible_decimal)?) # R220.3 # BIO # first example will require extra splitting
+ ^([-a-zA-Z]*\s?(?:$possible_decimal)?) # R220.3 CD-ROM 787.87 # will require extra splitting
\s+
- (.+) # H2793Z H32 c.2 # R5c.1 # everything else (except bracketing spaces)
+ (.+) # H2793Z H32 c.2 EAS # everything else (except bracketing spaces)
\s*
/x;
unless (scalar @parts) {
- syslog("LOG_ERR", "C4::Labels::Label::_split_ddcn : regexp failed to match string: %s", $_);
+ warn sprintf('regexp failed to match string: %s', $_);
push @parts, $_; # if no match, just push the whole string.
}
- if ($parts[ 0] =~ /^([a-zA-Z]+)($possible_decimal)$/) {
+ 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
-
- if ($parts[-1] !~ /^.*\d-\d.*$/ && $parts[-1] =~ /^(.*\d+)(\D.*)$/) {
- pop @parts; # pull off the mathching last element, like example 2
- push @parts, $1, $2; # replace it with the two pieces
- }
-
$debug and print STDERR "split_ddcn array: ", join(" | ", @parts), "\n";
return @parts;
}
-sub _split_fcn {
- my ($fcn) = @_;
- my @fcn_split = ();
- # Split fiction call numbers based on spaces
- SPLIT_FCN:
- while ($fcn) {
- if ($fcn =~ m/([A-Za-z0-9]+\.?[0-9]?)(\W?).*?/x) {
- push (@fcn_split, $1);
- $fcn = $';
- }
- else {
- last SPLIT_FCN; # No match, break out of the loop
- }
- }
- unless (scalar @fcn_split) {
- syslog("LOG_ERR", "C4::Labels::Label::_split_fcn : regexp failed to match string: %s", $_);
- push (@fcn_split, $_);
- }
- return @fcn_split;
-}
+## 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 _get_fields {
- my ( $layout_id, $sorttype ) = @_;
- my @sorted_fields;
- my $sortorder = get_layout($layout_id);
- if ( !$sorttype ) {
- return $sortorder->{'formatstring'};
+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
}
- else {
- my $csv = Text::CSV_XS->new( { allow_whitespace => 1 } );
- my $line = $sortorder->{'formatstring'};
- my $status = $csv->parse($line);
- @sorted_fields =
- map { { 'code' => $_, desc => $_ } } $csv->fields();
- if (my $error = $csv->error_input()) {
- syslog("LOG_ERR", "C4::Labels::Label::_get_fields : Text::CSV_XS returned the following error: %s", $error);
- }
+ unless (scalar @parts) {
+ warn sprintf('regexp failed to match string: %s', $_);
+ push (@parts, $_);
}
-}
-
-sub _get_item_fields {
- my @fields = qw (
- barcode title
- isbn issn
- author itemtype
- itemcallnumber
- );
- return @fields;
+ $debug and print STDERR "split_ccn array: ", join(" | ", @parts), "\n";
+ return @parts;
}
sub _get_barcode_data {
)
);
FIELD_LIST:
- while ($f) {
+ while ($f) {
my $err = '';
$f =~ s/^\s?//;
if ( $f =~ /^'(.*)'.*/ ) {
elsif ( $f =~ /^($match_kohatable).*/ ) {
if ($item->{$f}) {
$datastring .= $item->{$f};
- }
- else {
- syslog("LOG_ERR", "C4::Labels::Label::_get_barcode_data : The '%s' field contains no data.", $f);
+ } else {
+ $debug and warn sprintf("The '%s' field contains no data.", $f);
}
$f = $';
next FIELD_LIST;
$datastring .= $itemfield->subfield($subf) . $ws;
}
else {
- syslog("LOG_ERR", "C4::Labels::Label::_get_barcode_data : The '%s' field contains no data.", $f);
+ warn sprintf("The '%s' field contains no data.", $f);
}
last ITEM_FIELDS;
}
$datastring .= $marcfield[0]->subfield($subf) . $ws;
}
else {
- syslog("LOG_ERR", "C4::Labels::Label::_get_barcode_data : The '%s' field contains no data.", $f);
+ warn sprintf("The '%s' field contains no data.", $f);
}
}
}
next FIELD_LIST;
}
else {
- syslog("LOG_ERR", "C4::Labels::Label::_get_barcode_data : Failed to parse label format string: %s", $f);
+ warn sprintf('Failed to parse label format string: %s', $f);
last FIELD_LIST; # Failed to match
}
}
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
return 0, 0, 0, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor;
-}
-
-sub _BIBBAR {
+}
+
+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_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_y_scale_factor = 0.01 * $self->{'height'}; # this scales the barcode height to 10% of the label height
my $line_spacer = ($self->{'font_size'} * 1); # number of pixels between text rows (This is actually leading: baseline to baseline minus font size. Recommended starting point is 20% of font size.).
my $text_lly = ($self->{'lly'} + ($self->{'height'} - $self->{'top_text_margin'}));
+ $debug and warn "Label: llx $self->{'llx'}, lly $self->{'lly'}, Text: lly $text_lly, $line_spacer, Barcode: llx $barcode_llx, lly $barcode_lly, $barcode_width, $barcode_y_scale_factor\n";
return $self->{'llx'}, $text_lly, $line_spacer, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor;
}
my $line_spacer = ($self->{'font_size'} * 1); # number of pixels between text rows (This is actually leading: baseline to baseline minus font size. Recommended starting point is 20% of font size.).
my $text_lly = (($self->{'lly'} + $self->{'height'}) - $self->{'top_text_margin'} - (($self->{'lly'} + $self->{'height'}) - $barcode_lly));
return $self->{'llx'}, $text_lly, $line_spacer, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor;
-}
+}
sub new {
my ($invocant, %params) = @_;
$field_data =~ s/\r//g;
}
my @label_lines;
- my @callnumber_list = ('itemcallnumber', '050a', '050b', '082a', '952o'); # Fields which hold call number data FIXME: ( 060? 090? 092? 099? )
+ # 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_fcn($field_data) if !@label_lines; # If it was not a true lccn, try it as a fiction call number
+ @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_fcn($field_data) if !@label_lines;
+ @label_lines = _split_ccn($field_data) if !@label_lines;
push (@label_lines, $field_data) if !@label_lines;
} else {
- syslog("LOG_ERR", "C4::Labels::Label->draw_label_text : 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;
}
}
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::Labels::PDF->StrWidth($line, $font, $self->{'font_size'});
- if ($self->{'justify'} eq 'R') {
+ 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);
- }
+ }
elsif($self->{'justify'} eq 'C') {
# some code to try and center each line on the label based on font size and string point width...
my $whitespace = ($self->{'width'} - ($string_width + (2 * $self->{'left_text_margin'})));
$text_llx = (($whitespace / 2) + $params{'llx'} + $self->{'left_text_margin'});
- }
+ }
else {
$text_llx = ($params{'llx'} + $self->{'left_text_margin'});
}
return \@label_text;
}
+sub draw_guide_box {
+ return $_[0]->{'guidebox'};
+}
+
sub barcode {
my $self = shift;
my %params = @_;
$tot_bar_length = ($bar_length * $num_of_bars) + ($guard_length * 2);
$x_scale_factor = ($params{'width'} / $tot_bar_length);
if ($params{'barcode_type'} eq 'CODE39MOD') {
- my $c39 = CheckDigits('visa'); # get modulo43 checksum
+ my $c39 = CheckDigits('code_39'); # get modulo43 checksum
$params{'barcode_data'} = $c39->complete($params{'barcode_data'});
}
elsif ($params{'barcode_type'} eq 'CODE39MOD10') {
- my $c39_10 = CheckDigits('visa'); # get modulo43 checksum
+ my $c39_10 = CheckDigits('siret'); # get modulo43 checksum
$params{'barcode_data'} = $c39_10->complete($params{'barcode_data'});
$hide_text = '';
}
);
};
if ($@) {
- syslog("LOG_ERR", "Barcode generation failed for item %s with this error: %s", $self->{'item_number'}, $@);
+ warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
}
}
elsif ($params{'barcode_type'} eq 'COOP2OF5') {
);
};
if ($@) {
- syslog("LOG_ERR", "Barcode generation failed for item %s with this error: %s", $self->{'item_number'}, $@);
+ warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
}
}
elsif ( $params{'barcode_type'} eq 'INDUSTRIAL2OF5' ) {
);
};
if ($@) {
- syslog("LOG_ERR", "Barcode generation failed for item %s with this error: %s", $self->{'item_number'}, $@);
+ warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
}
}
}
=head1 LICENSE
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.
-You should have received a copy of the GNU General Public License along with Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
-Suite 330, Boston, MA 02111-1307 USA
+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.
=head1 DISCLAIMER OF WARRANTY
projects / koha_fer / blobdiff