X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FLabels%2FLabel.pm;h=bd3ee4fe7bbdc723d9b8b13bbb22ba8da3686086;hb=fe4da2f721c371540fe88d0014a49a866b403ca4;hp=930e0f6ef407134c4046eb3156e641a23eb255d4;hpb=d8a36ca1f80460029ec5442fb1bf5de8b00a2138;p=koha-ffzg.git diff --git a/C4/Labels/Label.pm b/C4/Labels/Label.pm index 930e0f6ef4..bd3ee4fe7b 100644 --- a/C4/Labels/Label.pm +++ b/C4/Labels/Label.pm @@ -7,13 +7,15 @@ use Text::Wrap; use Algorithm::CheckDigits; use Text::CSV_XS; use Data::Dumper; +use Library::CallNumber::LC; +use Text::Bidi qw( log2vis ); use C4::Context; use C4::Debug; use C4::Biblio; BEGIN { - use version; our $VERSION = qv('1.0.0_1'); + use version; our $VERSION = qv('3.07.00.049'); } my $possible_decimal = qr/\d{3,}(?:\.\d+)?/; # at least three digits for a DDCN @@ -61,6 +63,8 @@ sub _check_params { 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 @@ -78,7 +82,7 @@ sub _get_label_item { # 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); @@ -113,18 +117,10 @@ 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) { + my @parts = Library::CallNumber::LC->new($lccn)->components(); + unless (scalar @parts && defined $parts[0]) { warn sprintf('regexp failed to match string: %s', $_); - push @parts, $_; # if no match, just push the whole string. + @parts = $_; # if no match, just use 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"; @@ -185,7 +181,8 @@ sub _get_barcode_data { ( @{ $kohatables->{'biblio'} }, @{ $kohatables->{'biblioitems'} }, - @{ $kohatables->{'items'} } + @{ $kohatables->{'items'} }, + @{ $kohatables->{'branches'} } ) ); FIELD_LIST: @@ -249,7 +246,7 @@ sub _get_barcode_data { 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'} ; @@ -273,7 +270,7 @@ sub _BIB { 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 @@ -282,7 +279,7 @@ sub _BAR { 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 @@ -294,7 +291,7 @@ sub _BIBBAR { 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 @@ -400,6 +397,7 @@ sub draw_label_text { else { $field->{'data'} = _get_barcode_data($field->{'code'},$item,$record); } + #FIXME: We should not force the title to oblique; this should be selectible in the layout configuration ($field->{'code'} eq 'title') ? (($font =~ /T/) ? ($font = 'TI') : ($font = ($font . 'O'))) : ($font = $font); my $field_data = $field->{'data'}; if ($field_data) { @@ -426,8 +424,9 @@ sub draw_label_text { 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)); @@ -446,7 +445,9 @@ sub draw_label_text { 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::Creators::PDF->StrWidth($line, $font, $self->{'font_size'}); + my $fontName = C4::Creators::PDF->Font($font); + $line = log2vis( $line ); + my $string_width = C4::Creators::PDF->StrWidth($line, $fontName, $self->{'font_size'}); if ($self->{'justify'} eq 'R') { $text_llx = $params{'llx'} + $self->{'width'} - ($self->{'left_text_margin'} + $string_width); } @@ -552,6 +553,28 @@ sub barcode { 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 { @@ -607,6 +630,9 @@ This module provides methods for creating, and otherwise manipulating single lab =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 Defines the general layout to be used on labels. NOTE: At present there are only five printing types supported in the label creator code: