[Koha-patches] [PATCH] kohabug 2475 [1/2] Porting LCCN splitting code to Labels.pm
Chris Nighswonger
chris.nighswonger at liblime.com
Sat Aug 9 14:36:25 CEST 2008
This patch ports LCCN splitting code from Koha 2.2.9 to Koha 3.0
This algorithm has been ported just as it appears on some production
systems. LCCNs that do not split correctly should have a bug opened
and include an exact example so that the regexp's can be adjusted.
This patch also adds code to split DDCNs using the *loosest* possible
interpretation of DDCN rules. On the simple end, the DDCN split
algorithm will handle being passed just a Dewey call number.
However, there may be some unusually complex DDCNs that will not
split properly. These will need to have a bug submitted for them
including a specific example so that the regexp's can be adjusted.
The correct choice of splitting alogrithm is determimed by the
item level classification source (items.cn_source).
Documentation should be updated to reflect these changes. Please include
the bit about complex call numbers and the need of a bug report.
[LL Bug 26]
---
C4/Labels.pm | 104 ++++++++++++++++++++++++++++++---------------
labels/label-print-pdf.pl | 49 ++-------------------
2 files changed, 75 insertions(+), 78 deletions(-)
diff --git a/C4/Labels.pm b/C4/Labels.pm
index 82d4c6b..3bed6da 100644
--- a/C4/Labels.pm
+++ b/C4/Labels.pm
@@ -28,7 +28,7 @@ use C4::Branch;
use C4::Debug;
use C4::Biblio;
use Text::CSV_XS;
-use Data::Dumper;
+#use Data::Dumper;
# use Smart::Comments;
BEGIN {
@@ -89,8 +89,6 @@ sub get_label_options {
}
sub get_layouts {
-
-## FIXME: this if/else could be compacted...
my $dbh = C4::Context->dbh;
my @data;
my $query = " Select * from labels_conf";
@@ -103,9 +101,6 @@ sub get_layouts {
push( @resultsloop, $data );
}
$sth->finish;
-
- # @resultsloop
-
return @resultsloop;
}
@@ -208,7 +203,7 @@ sub get_text_fields {
}
} else {
# These fields are hardcoded based on the template for label-edit-layout.pl
- my @text_fields = (
+ my @text_fields = (
{
code => 'itemtype',
desc => "Item Type",
@@ -787,8 +782,8 @@ sub GetLabelItems {
while ( my $data = $sth->fetchrow_hashref ) {
# lets get some summary info from each item
- my $query1 = "
- select i.*, bi.*, b.* from items i,biblioitems bi,biblio b
+ my $query1 = "
+ select i.*, bi.*, b.* from items i,biblioitems bi,biblio b
where itemnumber=? and i.biblioitemnumber=bi.biblioitemnumber and
bi.biblionumber=b.biblionumber";
@@ -817,7 +812,6 @@ sub GetItemFields {
barcode title subtitle
dewey isbn issn author class
itemtype subclass itemcallnumber
-
);
return @fields;
}
@@ -936,11 +930,56 @@ sub deduplicate_batch {
return $killed, undef;
}
+sub split_lccn {
+ my ($lccn) = @_;
+ my ( $ll, $wnl, $dec, $cutter, $pubdate);
+
+ $_ = $lccn;
+
+ # lccn example 'HE8700.7 .P6T44 1983';
+ my @splits = m/
+ (^[a-zA-Z]+) # HE
+ ([0-9]+\.*[0-9]*) # 8700.7
+ \s*
+ (\.*[a-zA-Z0-9]*) # P6T44
+ \s*
+ ([0-9]*) # 1983
+ /x;
+
+ # strip something occuring spaces too
+ $splits[0] =~ s/\s+$//;
+ $splits[1] =~ s/\s+$//;
+ $splits[2] =~ s/\s+$//;
+
+ # if the regex fails, then just return the whole string,
+ # better than nothing
+ # FIXME It seems we should handle all cases, have some graceful error handling, or at least inform the caller of the failure to split
+ $splits[0] = $lccn if $splits[0] eq '' ;
+ return @splits;
+}
+
+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...
+ $_ = $ddcn;
+ # ddcn example R220.3 H2793Z H32 c.2
+ my @splits = m/^([A-Z]{0,3}) # R (OS, REF, etc. up do three letters)
+ ([0-9]+\.[0-9]*) # 220.3
+ \s? # space (not requiring anything beyond the call number)
+ ([a-zA-Z0-9]*\.?[a-zA-Z0-9])# cutter number... maybe, but if so it is in this position (Z indicates literary criticism)
+ \s? # space if it exists
+ ([a-zA-Z]*\.?[0-9]*) # other indicators such as cutter for author of literary criticism in this example if it exists
+ \s? # space if ie exists
+ ([a-zA-Z]*\.?[0-9]*) # other indicators such as volume number, copy number, edition date, etc. if it exists
+ /x;
+ return @splits;
+}
+
sub DrawSpineText {
my ( $x_pos, $y_pos, $label_height, $label_width, $fontname, $fontsize, $left_text_margin,
- $text_wrap_cols, $item, $conf_data, $printingtype, $nowrap ) = @_;
-
+ $text_wrap_cols, $item, $conf_data, $printingtype ) = @_;
+
# Replaced item's itemtype with the more user-friendly description...
my $dbh = C4::Context->dbh;
my %itemtypes;
@@ -960,20 +999,19 @@ sub DrawSpineText {
my $vPos = ( $y_pos + ( $label_height - $top_text_margin ) );
my @str_fields = get_text_fields($layout_id, 'codes' );
- my $record = GetMarcBiblio($$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 $record = GetMarcBiblio($$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 $old_fontname = $fontname; # We need to keep track of the original font passed in...
-
+ my $cn_source = $$item->{'cn_source'};
for my $field (@str_fields) {
- $field->{'code'} or warn "get_text_fields($layout_id, 'codes') element missing 'code' field";
- if ($$conf_data->{'formatstring'}) {
- $field->{'data'} = GetBarcodeData($field->{'code'},$$item,$record) ;
- } else {
- $field->{data} = $$item->{$field->{'code'}} ;
- }
-
+ $field->{'code'} or warn "get_text_fields($layout_id, 'codes') element missing 'code' field";
+ if ($$conf_data->{'formatstring'}) {
+ $field->{'data'} = GetBarcodeData($field->{'code'},$$item,$record) ;
+ } else {
+ $field->{data} = $$item->{$field->{'code'}} ;
+ }
# This allows us to print the title in italic (oblique) type... (Times Roman has a different nomenclature.)
# It seems there should be a better way to handle fonts in the label/patron card tool altogether -fbcit
($field->{code} eq 'title') ? (($old_fontname =~ /T/) ? ($fontname = 'TI') : ($fontname = ($old_fontname . 'O'))) : ($fontname = $old_fontname);
@@ -987,16 +1025,14 @@ sub DrawSpineText {
$str =~ s/\n//g;
$str =~ s/\r//g;
my @strings;
- if ($field->{code} eq 'itemcallnumber') { # If the field contains the call number, we do some special processing on it here...
- if (($nowrap == 0) || (!$nowrap)) { # wrap lines based on segmentation markers: '/' (other types of segmentation markers can be added as needed here or this could be added as a syspref.)
- while ( $str =~ /\// ) {
- $str =~ /^(.*)\/(.*)$/;
- unshift @strings, $2;
- $str = $1;
- }
- unshift @strings, $str;
+ if ($field->{code} eq 'itemcallnumber' and $printingtype eq 'BIB') { # If the field contains the call number, we do some special processing on it here...
+ if ($cn_source eq 'lcc') {
+ @strings = split_lccn($str);
+ } elsif ($cn_source eq 'ddc') {
+ @strings = split_ddcn($str);
} else {
- push @strings, $str; # if $nowrap == 1 do not wrap or remove segmentation markers...
+ # FIXME Need error trapping here; something to be informative to the user perhaps -crn
+ push @strings, $str;
}
} else {
$str =~ s/\/$//g; # Here we will strip out all trailing '/' in fields other than the call number...
@@ -1032,8 +1068,8 @@ sub DrawSpineText {
PrintText( $hPos, $vPos, $font, $fontsize, $str );
$vPos = $vPos - $line_spacer;
}
- }
- } #foreach field
+ }
+ } #foreach field
}
sub PrintText {
diff --git a/labels/label-print-pdf.pl b/labels/label-print-pdf.pl
index 7d54a6f..8855f9f 100755
--- a/labels/label-print-pdf.pl
+++ b/labels/label-print-pdf.pl
@@ -13,7 +13,6 @@ use PDF::Reuse;
use PDF::Reuse::Barcode;
use POSIX;
use Data::Dumper;
-#use Smart::Comments;
my $DEBUG = 0;
my $DEBUG_LPT = 0;
@@ -24,8 +23,6 @@ print $cgi->header( -type => 'application/pdf', -attachment => 'barcode.pdf' );
my $spine_text = "";
-#warn "label-print-pdf ***";
-
# get the printing settings
my $template = GetActiveLabelTemplate();
my $conf_data = get_label_options();
@@ -34,8 +31,6 @@ my $profile = GetAssociatedProfile($template->{'tmpl_id'});
my $batch_id = $cgi->param('batch_id');
my @resultsloop;
-#$DB::single = 1;
-
my $batch_type = $conf_data->{'type'};
my $barcodetype = $conf_data->{'barcodetype'};
my $printingtype = $conf_data->{'printingtype'};
@@ -112,9 +107,6 @@ my $upperRightY = $page_height;
prMbox( $lowerLeftX, $lowerLeftY, $upperRightX, $upperRightY );
-#warn "STARTROW = $startrow\n";
-
-#my $page_break_count = $startrow;
my $codetype; # = 'Code39';
#do page border
@@ -158,8 +150,6 @@ if ( $DEBUG && $profile->{'prof_id'} ) {
my $item;
my ( $i, $i2 ); # loop counters
-# big row loop
-
#warn " $lowerLeftX, $lowerLeftY, $upperRightX, $upperRightY";
#warn "$label_rows, $label_cols\n";
#warn "$label_height, $label_width\n";
@@ -175,30 +165,17 @@ if ( $start_label eq 1 ) {
}
else {
-
- #eval {
$rowcount = ceil( $start_label / $label_cols );
-
- #} ;
- #$rowcount = 1 if $@;
-
$colcount = ( $start_label - ( ( $rowcount - 1 ) * $label_cols ) );
-
$x_pos = $left_margin + ( $label_width * ( $colcount - 1 ) ) +
( $colspace * ( $colcount - 1 ) );
-
$y_pos = $page_height - $top_margin - ( $label_height * $rowcount ) -
( $rowspace * ( $rowcount - 1 ) );
-
warn "Start label specified: $start_label Beginning in row $rowcount, column $colcount" if $DEBUG;
warn "X position = $x_pos Y position = $y_pos" if $DEBUG;
warn "Rowspace = $rowspace Label height = $label_height" if $DEBUG;
}
-#warn "ROW COL $rowcount, $colcount";
-
-#my $barcodetype; # = 'Code39';
-
#
# main foreach loop
#
@@ -222,7 +199,7 @@ foreach $item (@resultsloop) {
DrawBarcode( $x_pos, $barcode_y, $barcode_height, $label_width,
$item->{'barcode'}, $barcodetype );
DrawSpineText( $x_pos, $y_pos, $label_height, $label_width, $fontname, $fontsize,
- $left_text_margin, $text_wrap_cols, \$item, \$conf_data, $printingtype, '1' );
+ $left_text_margin, $text_wrap_cols, \$item, \$conf_data, $printingtype );
CalcNextLabelPos();
@@ -233,7 +210,7 @@ foreach $item (@resultsloop) {
DrawBarcode( $x_pos, $y_pos, $barcode_height, $label_width, $item->{'barcode'},
$barcodetype );
DrawSpineText( $x_pos, $y_pos, $label_height, $label_width, $fontname, $fontsize,
- $left_text_margin, $text_wrap_cols, \$item, \$conf_data, $printingtype, '1' );
+ $left_text_margin, $text_wrap_cols, \$item, \$conf_data, $printingtype );
CalcNextLabelPos();
}
@@ -245,7 +222,7 @@ foreach $item (@resultsloop) {
CalcNextLabelPos();
drawbox( $x_pos, $y_pos, $label_width, $label_height ) if $guidebox;
DrawSpineText( $x_pos, $y_pos, $label_height, $label_width, $fontname, $fontsize,
- $left_text_margin, $text_wrap_cols, \$item, \$conf_data, $printingtype, '1' );
+ $left_text_margin, $text_wrap_cols, \$item, \$conf_data, $printingtype );
CalcNextLabelPos();
}
@@ -254,7 +231,7 @@ foreach $item (@resultsloop) {
elsif ( $printingtype eq 'BIB' ) {
drawbox( $x_pos, $y_pos, $label_width, $label_height ) if $guidebox;
DrawSpineText( $x_pos, $y_pos, $label_height, $label_width, $fontname, $fontsize,
- $left_text_margin, $text_wrap_cols, \$item, \$conf_data, $printingtype, '0' );
+ $left_text_margin, $text_wrap_cols, \$item, \$conf_data, $printingtype );
CalcNextLabelPos();
}
@@ -268,7 +245,7 @@ foreach $item (@resultsloop) {
$patron_data->{'branchname'} => ($fontsize + 3),
};
- warn "Generating patron card for cardnumber $patron_data->{'cardnumber'}";
+ $DEBUG and warn "Generating patron card for cardnumber $patron_data->{'cardnumber'}";
drawbox( $x_pos, $y_pos, $label_width, $label_height ) if $guidebox;
my $barcode_height = $label_height / 2.75; #FIXME: Scaling barcode height; this needs to be a user parameter.
@@ -278,25 +255,9 @@ foreach $item (@resultsloop) {
$left_text_margin, $text_wrap_cols, $text, $printingtype );
CalcNextLabelPos();
}
-
-
-
-
-
-
-
-
-
-
-
} # end for item loop
prEnd();
-#
-#
-#
-#
-#
sub CalcNextLabelPos {
if ( $colcount lt $label_cols ) {
--
1.5.5.GIT
More information about the Koha-patches
mailing list