=head1 FUNCTIONS
-=over 2
-
-=item get_label_options;
+=head2 get_label_options;
$options = get_label_options()
}
=head2 sub add_batch
+
=over 4
+
add_batch($batch_type,\@batch_list);
if $batch_list is supplied,
create a new batch with those items.
else, return the next available batch_id.
-=return
+
+=back
+
=cut
sub add_batch ($;$) {
my $table = (@_ and 'patroncards' eq shift) ? 'patroncards' : 'labels';
my $batch_list = (@_) ? shift : undef;
my $dbh = C4::Context->dbh;
- my $q ="SELECT MAX(DISTINCT batch_id) FROM $table";
+ # FIXME : batch_id should be an auto_incr INT. Temporarily casting as int ( see koha bug 2555 )
+ # until a label_batches table is added, and we can convert batch_id to int.
+ my $q ="SELECT MAX( CAST(batch_id AS SIGNED) ) FROM $table";
my $sth = $dbh->prepare($q);
$sth->execute();
my ($batch_id) = $sth->fetchrow_array || 0;
return;
}
-=item GetAllPrinterProfiles;
+=head2 GetAllPrinterProfiles;
@profiles = GetAllPrinterProfiles()
return @resultsloop;
}
-=item GetSinglePrinterProfile;
+=head2 GetSinglePrinterProfile;
$profile = GetSinglePrinterProfile()
return $template;
}
-=item SaveProfile;
+=head2 SaveProfile;
SaveProfile('parameters')
$sth->finish;
}
-=item CreateProfile;
+=head2 CreateProfile;
CreateProfile('parameters')
return $error;
}
-=item DeleteProfile;
+=head2 DeleteProfile;
DeleteProfile(prof_id)
return $error;
}
-=item GetAssociatedProfile;
+=head2 GetAssociatedProfile;
$assoc_prof = GetAssociatedProfile(tmpl_id)
return $assoc_prof;
}
-=item SetAssociatedProfile;
+=head2 SetAssociatedProfile;
SetAssociatedProfile($prof_id, $tmpl_id)
}
-=item GetLabelItems;
+=head2 GetLabelItems;
$options = GetLabelItems()
return @fields;
}
-=head GetBarcodeData
+=head2 GetBarcodeData
=over 4
+
Parse labels_conf.formatstring value
(one value of the csv, which has already been split)
and return string from koha tables or MARC record.
+
=back
+
=cut
-#'
+
sub GetBarcodeData {
my ( $f, $item, $record ) = @_;
my $kohatables = &_descKohaTables();
-use Data::Dumper;
-warn Dumper($kohatables);
my $datastring = '';
my $match_kohatable = join(
'|',
@{ $kohatables->{items} }
)
);
- while ($f) { warn $f;
+ while ($f) {
$f =~ s/^\s?//;
if ( $f =~ /^'(.*)'.*/ ) {
# single quotes indicate a static text string.
$f = $';
}
elsif ( $f =~ /^([0-9a-z]{3})(\w)(\W?).*?/ ) {
- my $marc_field = $1;
- $datastring .= $record->subfield($1,$2) . $3 if($record->subfield($1,$2)) ;
- foreach my $subfield ($record->field($marc_field)) {
- if ( $subfield->subfield('9') eq $item->{'itemnumber'} ) {
- $datastring .= $subfield->subfield($2 ) . $3;
- last;
+ my ($field,$subf,$ws) = ($1,$2,$3);
+ my $subf_data;
+ 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.
+ foreach my $itemfield (@marcfield) {
+ if ( $itemfield->subfield($itemsubfieldcode) eq $item->{'itemnumber'} ) {
+ $datastring .= $itemfield->subfield($subf ) . $ws;
+ last;
+ }
+ }
+ } else { # bib-level data, we'll take the first matching tag/subfield.
+ $datastring .= $marcfield[0]->subfield($subf) . $ws ;
}
}
$f = $';
return $datastring;
}
-=head descKohaTables
+=head2 descKohaTables
+
Return a hashref of an array of hashes,
with name,type keys.
+
=cut
sub _descKohaTables {
return $killed, undef;
}
+our $possible_decimal = qr/\d+(?:\.\d+)?/;
+
sub split_lccn {
my ($lccn) = @_;
- my ($ll, $wnl, $dec, $cutter, $pubdate) = (0, 0, 0, 0, 0);
$_ = $lccn;
- # lccn example 'HE8700.7 .P6T44 1983';
- my @splits = m/
- (^[a-zA-Z]+) # HE
- ([0-9]+\.*[0-9]*) # 8700.7
+ # lccn examples: 'HE8700.7 .P6T44 1983', 'BS2545.E8 H39 1996';
+ my (@parts) = m/
+ ^([a-zA-Z]+) # HE # BS
+ (\d+(?:\.\d)*) # 8700.7 # 2545
\s*
- (\.*[a-zA-Z0-9]*) # P6T44
+ (\.*\D+\d*) # .P6 # .E8
\s*
- ([0-9]*) # 1983
- /x;
-
- # strip something occuring spaces too
- $splits[0] =~ s/\s+$//;
- $splits[1] =~ s/\s+$//;
- $splits[2] =~ s/\s+$//;
-
- return @splits;
+ (.*) # T44 1983 # H39 1996 # everything else (except any bracketing spaces)
+ \s*
+ /x;
+ unless (scalar @parts) {
+ $debug and print STDERR "split_lccn regexp failed to match string: $_\n";
+ 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";
+ 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...
$_ = $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;
+ s/\///g; # in theory we should be able to simply remove all segmentation markers and arrive at the correct call number...
+ # ddcn examples: 'R220.3 H2793Z H32 c.2', 'BIO JP2 R5c.1'
+
+ my (@parts) = m/
+ ^([a-zA-Z-]+(?:$possible_decimal)?) # R220.3 # BIO # first example will require extra splitting
+ \s*
+ (.+) # H2793Z H32 c.2 # R5c.1 # everything else (except bracketing spaces)
+ \s*
+ /x;
+ unless (scalar @parts) {
+ $debug and print STDERR "split_ddcn regexp failed to match string: $_\n";
+ push @parts, $_; # if no match, just push the whole string.
+ }
+
+ if ($parts[ 0] =~ /^([a-zA-Z]+)($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 {
# Split fiction call numbers based on spaces
SPLIT_FCN:
while ($fcn) {
- if ($fcn =~ m/([A-Za-z0-9]+)(\W?).*?/x) {
+ if ($fcn =~ m/([A-Za-z0-9]+\.?[0-9]?)(\W?).*?/x) {
push (@fcn_split, $1);
$fcn = $';
}
}
# loop for each string line
foreach my $str (@strings) {
+ next if $str eq '';
my $hPos = 0;
my $stringwidth = prStrWidth($str, $fontname, $fontsize);
if ( $$conf_data->{'text_justify'} eq 'R' ) {
ySize => ( .02 * $height ),
xSize => $xsize_ratio,
hide_asterisk => 1,
+ mode => 'graphic', # the only other option here is Type3...
);
};
if ($@) {
ySize => ( .02 * $height ),
xSize => $xsize_ratio,
hide_asterisk => 1,
+ mode => 'graphic', # the only other option here is Type3...
);
};
ySize => ( .02 * $height ),
xSize => $xsize_ratio,
hide_asterisk => 1,
- text => 0,
+ text => 0,
+ mode => 'graphic', # the only other option here is Type3...
);
};
warn "BAR_WDTH = $bar_width, TOT.BAR.LGHT=$tot_bar_length R*TOT.BAR =$moo2" if $debug;
}
-=item build_circ_barcode;
+=head2 build_circ_barcode;
build_circ_barcode( $x_pos, $y_pos, $barcode,
$barcodetype, \$item);
xSize => .85,
ySize => 1.3,
+ mode => 'graphic', # the only other option here is Type3...
);
};
if ($@) {
}
-=item draw_boundaries
+=head2 draw_boundaries
sub draw_boundaries ($x_pos_spine, $x_pos_circ1, $x_pos_circ2,
$y_pos, $spine_width, $label_height, $circ_width)
}
}
-=item drawbox
+=head2 drawbox
sub drawbox { $lower_left_x, $lower_left_y,
$upper_right_x, $upper_right_y )
1;
__END__
-=back
-
=head1 AUTHOR
Mason James <mason@katipo.co.nz>
projects / koha.git / blobdiff