use Algorithm::CheckDigits;
use C4::Members;
use C4::Branch;
-# use Data::Dumper;
+use C4::Debug;
+use C4::Biblio;
+use Text::CSV_XS;
+use Data::Dumper;
# use Smart::Comments;
BEGIN {
&GetItemFields
&get_text_fields
get_layout &save_layout &add_layout
- &set_active_layout &by_order
+ &set_active_layout
&build_text_dropbox
&delete_layout &get_active_layout
&get_highest_batch
);
}
-my $DEBUG = 0;
=head1 NAME
#'
sub get_label_options {
- my $dbh = C4::Context->dbh;
- my $query2 = " SELECT * FROM labels_conf where active = 1";
- my $sth = $dbh->prepare($query2);
+ my $query2 = " SELECT * FROM labels_conf where active = 1"; # FIXME: exact same as get_active_layout
+ my $sth = C4::Context->dbh->prepare($query2);
$sth->execute();
- my $conf_data = $sth->fetchrow_hashref;
- $sth->finish;
- return $conf_data;
+ return $sth->fetchrow_hashref;
}
sub get_layouts {
}
sub get_active_layout {
- my ($layout_id) = @_;
- my $dbh = C4::Context->dbh;
-
- # get the actual items to be printed.
- my $query = " Select * from labels_conf where active = 1";
- my $sth = $dbh->prepare($query);
+ my $query = " Select * from labels_conf where active = 1"; # FIXME: exact same as get_label_options
+ my $sth = C4::Context->dbh->prepare($query);
$sth->execute();
- my $data = $sth->fetchrow_hashref;
- $sth->finish;
- return $data;
+ return $sth->fetchrow_hashref;
}
sub delete_layout {
sub get_printingtypes {
my ($layout_id) = @_;
my @printtypes;
-
- push( @printtypes, { code => 'BAR', desc => "barcode" } );
- push( @printtypes, { code => 'BIB', desc => "biblio" } );
+# FIXME: hard coded print types
+ push( @printtypes, { code => 'BAR', desc => "barcode only" } );
+ push( @printtypes, { code => 'BIB', desc => "biblio only" } );
push( @printtypes, { code => 'BARBIB', desc => "barcode / biblio" } );
push( @printtypes, { code => 'BIBBAR', desc => "biblio / barcode" } );
push( @printtypes, { code => 'ALT', desc => "alternating labels" } );
+ push( @printtypes, { code => 'CSV', desc => "csv output" } );
+ push( @printtypes, { code => 'PATCRD', desc => "patron cards" } );
my $conf = get_layout($layout_id);
my $active_printtype = $conf->{'printingtype'};
foreach my $printtype (@printtypes) {
if ( $printtype->{'code'} eq $active_printtype ) {
- $printtype->{'active'} = 'MOO';
+ $printtype->{'active'} = 1;
}
}
return @printtypes;
}
+# this sub (build_text_dropbox) is deprecated and should be deleted.
+# rch 2008.04.15
+#
sub build_text_dropbox {
my ($order) = @_;
sub get_text_fields {
my ($layout_id, $sorttype) = @_;
-
- my ( $a, $b, $c, $d, $e, $f, $g, $h, $i ,$j, $k );
-
+ my @sorted_fields;
+ my $error;
my $sortorder = get_layout($layout_id);
-
- # $sortorder
-
- $a = {
+ if( $sortorder->{formatstring}) {
+ if(! $sorttype) {
+ return $sortorder->{formatstring} ;
+ } 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() ;
+ $error = $csv->error_input();
+ warn $error if $error ; # TODO - do more with this.
+ }
+ } else {
+ # These fields are hardcoded based on the template for label-edit-layout.pl
+ my @text_fields = (
+ {
code => 'itemtype',
desc => "Item Type",
order => $sortorder->{'itemtype'}
- };
- $b = {
+ },
+ {
code => 'dewey',
desc => "Dewey",
order => $sortorder->{'dewey'}
- };
- $c = { code => 'issn', desc => "ISSN",
- order => $sortorder->{'issn'} };
- $d = { code => 'isbn', desc => "ISBN",
- order => $sortorder->{'isbn'} };
- $e = {
+ },
+ {
+ code => 'issn',
+ desc => "ISSN",
+ order => $sortorder->{'issn'}
+ },
+ {
+ code => 'isbn',
+ desc => "ISBN",
+ order => $sortorder->{'isbn'}
+ },
+ {
code => 'class',
desc => "Classification",
order => $sortorder->{'class'}
- };
- $f = {
+ },
+ {
code => 'subclass',
desc => "Sub-Class",
order => $sortorder->{'subclass'}
- };
- $g = {
+ },
+ {
code => 'barcode',
desc => "Barcode",
order => $sortorder->{'barcode'}
- };
- $h =
- { code => 'author', desc => "Author", order => $sortorder->{'author'} };
- $i = { code => 'title', desc => "Title", order => $sortorder->{'title'} };
- $j = { code => 'itemcallnumber', desc => "Call Number", order => $sortorder->{'itemcallnumber'} };
- $k = { code => 'subtitle', desc => "Subtitle", order => $sortorder->{'subtitle'} };
+ },
+ {
+ code => 'author',
+ desc => "Author",
+ order => $sortorder->{'author'}
+ },
+ {
+ code => 'title',
+ desc => "Title",
+ order => $sortorder->{'title'}
+ },
+ {
+ code => 'itemcallnumber',
+ desc => "Call Number",
+ order => $sortorder->{'itemcallnumber'}
+ },
+ {
+ code => 'subtitle',
+ desc => "Subtitle",
+ order => $sortorder->{'subtitle'}
+ }
+ );
- my @text_fields = ( $a, $b, $c, $d, $e, $f, $g, $h, $i ,$j, $k );
- my @new_fields;
- foreach my $field (@text_fields) {
- push( @new_fields, $field ) if $field->{'order'} > 0;
+ my @new_fields;
+ foreach my $field (@text_fields) {
+ push( @new_fields, $field ) if $field->{'order'} > 0;
+ }
+
+ @sorted_fields = sort { $$a{order} <=> $$b{order} } @new_fields;
}
-
- my @sorted_fields = sort by_order @new_fields;
+ # if we have a 'formatstring', then we ignore these hardcoded fields.
my $active_fields;
- foreach my $field (@sorted_fields) {
- $sorttype eq 'codes' ? $active_fields .= "$field->{'code'} " :
- $active_fields .= "$field->{'desc'} ";
- }
- return $active_fields;
-}
+ if ($sorttype eq 'codes') { # FIXME: This sub should really always return the array of hashrefs and let the caller take what he wants from that -fbcit
+ return @sorted_fields;
+ } else {
+ foreach my $field (@sorted_fields) {
+ $active_fields .= "$field->{'desc'} ";
+ }
+ return $active_fields;
+ }
-sub by_order {
- $$a{order} <=> $$b{order};
}
=head2 sub add_batch
else, return the next available batch_id.
=return
=cut
-sub add_batch {
- my ( $batch_type,$batch_list ) = @_;
- my $new_batch;
+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 $batch_type";
+ my $q ="SELECT MAX(DISTINCT batch_id) FROM $table";
my $sth = $dbh->prepare($q);
$sth->execute();
- my ($batch_id) = $sth->fetchrow_array;
- $sth->finish;
- if($batch_id) {
- $batch_id++;
- } else {
- $batch_id = 1;
- }
- # TODO: let this block use $batch_type
- if(ref($batch_list) && ($batch_type eq 'labels') ) {
- my $sth = $dbh->prepare("INSERT INTO labels (`batch_id`,`itemnumber`) VALUES (?,?)");
- for my $item (@$batch_list) {
- $sth->execute($batch_id,$item);
+ my ($batch_id) = $sth->fetchrow_array || 0;
+ $batch_id++;
+ if ($batch_list) {
+ if ($table eq 'patroncards') {
+ $sth = $dbh->prepare("INSERT INTO $table (`batch_id`,`borrowernumber`) VALUES (?,?)");
+ } else {
+ $sth = $dbh->prepare("INSERT INTO $table (`batch_id`,`itemnumber` ) VALUES (?,?)");
+ }
+ for (@$batch_list) {
+ $sth->execute($batch_id,$_);
}
}
return $batch_id;
#FIXME: Needs to be ported to receive $batch_type
# ... this looks eerily like add_batch() ...
sub get_highest_batch {
- my $new_batch;
- my $dbh = C4::Context->dbh;
+ my $table = (@_ and 'patroncards' eq shift) ? 'patroncards' : 'labels';
my $q =
- "select distinct batch_id from labels order by batch_id desc limit 1";
- my $sth = $dbh->prepare($q);
+ "select distinct batch_id from $table order by batch_id desc limit 1";
+ my $sth = C4::Context->dbh->prepare($q);
$sth->execute();
- my $data = $sth->fetchrow_hashref;
- $sth->finish;
-
- if ( !$data->{'batch_id'} ) {
- $new_batch = 1;
- }
- else {
- $new_batch = $data->{'batch_id'};
- }
-
- return $new_batch;
+ my $data = $sth->fetchrow_hashref or return 1;
+ return ($data->{'batch_id'} || 1);
}
-sub get_batches {
- my ( $batch_type ) = @_;
- my $dbh = C4::Context->dbh;
- my $q = "SELECT batch_id, COUNT(*) AS num FROM $batch_type GROUP BY batch_id";
- my $sth = $dbh->prepare($q);
+sub get_batches (;$) {
+ my $table = (@_ and 'patroncards' eq shift) ? 'patroncards' : 'labels';
+ my $q = "SELECT batch_id, COUNT(*) AS num FROM $table GROUP BY batch_id";
+ my $sth = C4::Context->dbh->prepare($q);
$sth->execute();
- my @resultsloop;
- while ( my $data = $sth->fetchrow_hashref ) {
- push( @resultsloop, $data );
- }
- $sth->finish;
-
-# Not sure why we are doing this rather than simply telling the user that no batches are currently defined.
-# So I'm commenting this out and modifying label-manager.tmpl to properly inform the user as stated. -fbcit
- # adding a dummy batch=1 value , if none exists in the db
-# if ( !scalar(@resultsloop) ) {
-# push( @resultsloop, { batch_id => '1' , num => '0' } );
-# }
- return @resultsloop;
+ my $batches = $sth->fetchall_arrayref({});
+ return @$batches;
}
sub delete_batch {
my $strwidth;
my $count = 0;
# my $textlimit = $label_width - ($left_text_margin);
- my $textlimit = $label_width - ( 2* $left_text_margin);
+ my $textlimit = $label_width - ( 3 * $left_text_margin);
while ( $strwidth < $textlimit ) {
$strwidth = prStrWidth( $string, $font, $fontsize );
$leftmargin, $cols, $rows, $colgap,
$rowgap, $font, $fontsize, $units
) = @_;
- warn "Passed \$font:$font";
+ $debug and warn "Passed \$font:$font";
my $dbh = C4::Context->dbh;
my $query =
" UPDATE labels_templates SET tmpl_code=?, tmpl_desc=?, page_width=?,
$barcodetype, $title, $subtitle, $isbn, $issn,
$itemtype, $bcn, $dcn, $classif,
$subclass, $itemcallnumber, $author, $tmpl_id,
- $printingtype, $guidebox, $startlabel, $layoutname
+ $printingtype, $guidebox, $startlabel, $layoutname, $formatstring
) = @_;
my $dbh = C4::Context->dbh;
$sth2->execute();
$query2 = "INSERT INTO labels_conf
( barcodetype, title, subtitle, isbn,issn, itemtype, barcode,
- dewey, class, subclass, itemcallnumber, author, printingtype,
- guidebox, startlabel, layoutname, active )
- values ( ?, ?, ?, ?, ?, ?, ?, ?,?, ?, ?, ?, ?, ?,?,?, 1 )";
+ dewey, classification, subclass, itemcallnumber, author, printingtype,
+ guidebox, startlabel, layoutname, formatstring, active )
+ values ( ?, ?,?, ?, ?, ?, ?, ?, ?,?, ?, ?, ?, ?, ?,?,?, 1 )";
$sth2 = $dbh->prepare($query2);
$sth2->execute(
$barcodetype, $title, $subtitle, $isbn, $issn,
$itemtype, $bcn, $dcn, $classif,
$subclass, $itemcallnumber, $author, $printingtype,
- $guidebox, $startlabel, $layoutname
+ $guidebox, $startlabel, $layoutname, $formatstring
);
$sth2->finish;
$barcodetype, $title, $subtitle, $isbn, $issn,
$itemtype, $bcn, $dcn, $classif,
$subclass, $itemcallnumber, $author, $tmpl_id,
- $printingtype, $guidebox, $startlabel, $layoutname,
+ $printingtype, $guidebox, $startlabel, $layoutname, $formatstring,
$layout_id
) = @_;
### $layoutname
my $dbh = C4::Context->dbh;
my $query2 = "update labels_conf set
barcodetype=?, title=?, subtitle=?, isbn=?,issn=?,
- itemtype=?, barcode=?, dewey=?, class=?,
+ itemtype=?, barcode=?, dewey=?, classification=?,
subclass=?, itemcallnumber=?, author=?, printingtype=?,
- guidebox=?, startlabel=?, layoutname=? where id = ?";
+ guidebox=?, startlabel=?, layoutname=?, formatstring=? where id = ?";
my $sth2 = $dbh->prepare($query2);
$sth2->execute(
$barcodetype, $title, $subtitle, $isbn, $issn,
$itemtype, $bcn, $dcn, $classif,
$subclass, $itemcallnumber, $author, $printingtype,
- $guidebox, $startlabel, $layoutname, $layout_id
+ $guidebox, $startlabel, $layoutname, $formatstring, $layout_id
);
$sth2->finish;
return @fields;
}
+=head 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();
+ my $datastring;
+ my $last_f = $f;
+ my $match_kohatable = join('|', (@{$kohatables->{biblio}},@{$kohatables->{biblioitems}},@{$kohatables->{items}}) );
+ while( $f ) {
+ if( $f =~ /^'(.*)'.*/ ) {
+ # single quotes indicate a static text string.
+ $datastring .= $1 ;
+ $f = $';
+ } elsif ( $f =~ /^($match_kohatable).*/ ) {
+ # grep /$f/, (@$kohatables->{biblio},@$kohatables->{biblioitems},@$kohatables->{items}) ) {
+ $datastring .= $item->{$f};
+ $f = $';
+ } elsif ( $f =~ /^([0-9a-z]{3})(\w)(\W*).*/ ) {
+ $datastring .= $record->subfield($1,$2) . $3 if($record->subfield($1,$2)) ;
+ $f = $';
+ }
+ last if ( $f eq $last_f ); # failed to match
+ }
+ return $datastring;
+}
+
+=head descKohaTables
+Return a hashref of an array of hashes,
+with name,type keys.
+=cut
+
+sub _descKohaTables {
+ my $dbh = C4::Context->dbh();
+ my $kohatables;
+ for my $table ( 'biblio','biblioitems','items' ) {
+ my $sth = $dbh->column_info(undef,undef,$table,'%');
+ while (my $info = $sth->fetchrow_hashref()){
+ push @{$kohatables->{$table}} , $info->{'COLUMN_NAME'} ;
+ }
+ $sth->finish;
+ }
+ return $kohatables;
+}
+
sub GetPatronCardItems {
my ( $batch_id ) = @_;
my @resultsloop;
my $dbh = C4::Context->dbh;
- my $query = "SELECT * FROM patroncards WHERE batch_id = ? ORDER BY borrowernumber";
+# my $query = "SELECT * FROM patroncards WHERE batch_id = ? ORDER BY borrowernumber";
+ my $query = "SELECT * FROM patroncards WHERE batch_id = ? ORDER BY cardid";
my $sth = $dbh->prepare($query);
$sth->execute($batch_id);
my $cardno = 1;
sub DrawSpineText {
my ( $x_pos, $y_pos, $label_height, $label_width, $fontname, $fontsize, $left_text_margin,
- $text_wrap_cols, $item, $conf_data, $printingtype )
- = @_;
-# hack to fix column name mismatch betwen labels_conf.class, and bibitems.classification
- $$item->{'class'} = $$item->{'classification'};
-
- $Text::Wrap::columns = $text_wrap_cols;
- $Text::Wrap::separator = "\n";
+ $text_wrap_cols, $item, $conf_data, $printingtype, $nowrap ) = @_;
+
+ # Replaced item's itemtype with the more user-friendly description...
+ my $dbh = C4::Context->dbh;
+ my %itemtypes;
+ my $sth = $dbh->prepare("SELECT itemtype,description FROM itemtypes");
+ $sth->execute();
+ while ( my $data = $sth->fetchrow_hashref ) {
+ $$item->{'itemtype'} = $data->{'description'} if ($$item->{'itemtype'} eq $data->{'itemtype'});
+ }
my $str;
my $top_text_margin = ( $fontsize + 3 ); #FIXME: This should be a template parameter and passed in...
my $line_spacer = ( $fontsize * 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.).
- # add your printable fields manually in here
-
my $layout_id = $$conf_data->{'id'};
-# my @fields = GetItemFields();
-
- my $str_fields = get_text_fields($layout_id, 'codes' );
- my @fields = split(/ /, $str_fields);
- #warn Dumper(@fields);
-
- my $vPos = ( $y_pos + ( $label_height - $top_text_margin ) );
- my $font = prFont($fontname);
-
- # warn Dumper $conf_data;
- #warn Dumper $item;
+ my $vPos = ( $y_pos + ( $label_height - $top_text_margin ) );
- foreach my $field (@fields) {
+ 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).
- # testing hack
-# $$item->{"$field"} = $field . ": " . $$item->{"$field"};
+ my $old_fontname = $fontname; # We need to keep track of the original font passed in...
+
+ 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'}} ;
+ }
+ # 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);
+ my $font = prFont($fontname);
# if the display option for this field is selected in the DB,
# and the item record has some values for this field, display it.
- if ( $$conf_data->{"$field"} && $$item->{"$field"} ) {
-
- # warn "CONF_TYPE = $field";
-
+ if ( ($$conf_data->{'formatstring'}) || ( $$conf_data->{$field->{code}} && $$item->{$field->{code}} ) ) {
# get the string
- $str = $$item->{"$field"};
+ my $str = $field->{data} ;
# strip out naughty existing nl/cr's
$str =~ s/\n//g;
$str =~ s/\r//g;
- # wrap lines based on call number dividers '/'
my @strings;
-
- while ( $str =~ /\// ) {
- $str =~ /^(.*)\/(.*)$/;
-
- #warn "\$2=$2";
- unshift @strings, $2;
- $str = $1;
+ 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;
+ } else {
+ push @strings, $str; # if $nowrap == 1 do not wrap or remove segmentation markers...
+ }
+ } else {
+ $str =~ s/\/$//g; # Here we will strip out all trailing '/' in fields other than the call number...
+ $str =~ s/\(/\\\(/g; # Escape '(' and ')' for the postscript stream...
+ $str =~ s/\)/\\\)/g;
+ # Wrap text lines exceeding $text_wrap_cols length...
+ $Text::Wrap::columns = $text_wrap_cols;
+ my @line = split(/\n/ ,wrap('', '', $str));
+ # If this is a title field, limit to two lines; all others limit to one...
+ if ($field->{code} eq 'title' && scalar(@line) >= 2) {
+ while (scalar(@line) > 2) {
+ pop @line;
+ }
+ } else {
+ while (scalar(@line) > 1) {
+ pop @line;
+ }
+ }
+ push(@strings, @line);
}
-
- unshift @strings, $str;
-
- # strip out division slashes
- #$str =~ s/\///g;
- #warn "\$str after striping division marks: $str";
- # chop the string up into _upto_ 12 chunks
- # and seperate the chunks with newlines
-
- #$str = wrap( "", "", "$str" );
- #$str = wrap( "", "", "$str" );
-
- # split the chunks between newline's, into an array
- #my @strings = split /\n/, $str;
-
- # then loop for each string line
+ # loop for each string line
foreach my $str (@strings) {
my $hPos;
if ( $printingtype eq 'BIB' ) { #FIXME: This is a hack and needs to be implimented as a text justification option in the template...
}
PrintText( $hPos, $vPos, $font, $fontsize, $str );
$vPos = $vPos - $line_spacer;
-
}
- } # if field is
- } #foreach feild
+ }
+ } #foreach field
}
sub PrintText {
my ( $hPos, $vPos, $font, $fontsize, $text ) = @_;
my $str = "BT /$font $fontsize Tf $hPos $vPos Td ($text) Tj ET";
- warn $str;
prAdd($str);
}
my $hPos;
foreach my $line (keys %$text) {
- warn "Current text is \"$line\" and font size for \"$line\" is $text->{$line} points";
+ $debug and warn "Current text is \"$line\" and font size for \"$line\" is $text->{$line} points";
# some code to try and center each line on the label based on font size and string point width...
my $stringwidth = prStrWidth($line, $fontname, $text->{$line});
my $whitespace = ( $label_width - ( $stringwidth + (2 * $left_text_margin) ) );
my $moo2 = $tot_bar_length * $xsize_ratio;
- warn "$x_pos, $y_pos, $barcode, $barcodetype" if $DEBUG;
- warn "BAR_WDTH = $bar_width, TOT.BAR.LGHT=$tot_bar_length R*TOT.BAR =$moo2" if $DEBUG;
+ warn "$x_pos, $y_pos, $barcode, $barcodetype" if $debug;
+ warn "BAR_WDTH = $bar_width, TOT.BAR.LGHT=$tot_bar_length R*TOT.BAR =$moo2" if $debug;
}
=item build_circ_barcode;
projects / koha_fer / blobdiff