From ff13d25bb3874152737f61de04eeed3bb9b72341 Mon Sep 17 00:00:00 2001 From: Chris Nighswonger Date: Tue, 19 Jan 2010 14:43:41 -0500 Subject: [PATCH] Bugfix: Various Label Creator bugs This fixes: * A bug which caused the label template editor to throw an error when saving when no previous profile was applied. * A typo which caused a 'fetch without execute' error in Labels.pm It also comments out several useless warns --- C4/Acquisition.pm | 28 ++++---- C4/Labels/Label.pm | 3 +- C4/Search.pm | 132 +++++++++++++++++----------------- labels/label-edit-template.pl | 26 +++++-- 4 files changed, 102 insertions(+), 87 deletions(-) diff --git a/C4/Acquisition.pm b/C4/Acquisition.pm index 1f1132b9ca..c2d5bf9156 100644 --- a/C4/Acquisition.pm +++ b/C4/Acquisition.pm @@ -41,8 +41,8 @@ BEGIN { @EXPORT = qw( &GetBasket &NewBasket &CloseBasket &DelBasket &ModBasket &GetBasketsByBookseller &GetBasketsByBasketgroup - - &ModBasketHeader + + &ModBasketHeader &ModBasketgroup &NewBasketgroup &DelBasketgroup &GetBasketgroup &CloseBasketgroup &GetBasketgroups &ReOpenBasketgroup @@ -50,7 +50,7 @@ BEGIN { &NewOrder &DelOrder &ModOrder &GetPendingOrders &GetOrder &GetOrders &GetOrderNumber &GetLateOrders &GetOrderFromItemnumber &SearchOrder &GetHistory &GetRecentAcqui - &ModReceiveOrder &ModOrderBiblioitemNumber + &ModReceiveOrder &ModOrderBiblioitemNumber &NewOrderItem &ModOrderItem @@ -76,7 +76,7 @@ sub GetOrderFromItemnumber { my $sth = $dbh->prepare($query); - $sth->trace(3); +# $sth->trace(3); $sth->execute($itemnumber); @@ -85,7 +85,7 @@ sub GetOrderFromItemnumber { } -# Returns the itemnumber(s) associated with the ordernumber given in parameter +# Returns the itemnumber(s) associated with the ordernumber given in parameter sub GetItemnumbersFromOrder { my ($ordernumber) = @_; my $dbh = C4::Context->dbh; @@ -95,7 +95,7 @@ sub GetItemnumbersFromOrder { my @tab; while (my $order = $sth->fetchrow_hashref) { - push @tab, $order->{'itemnumber'}; + push @tab, $order->{'itemnumber'}; } return @tab; @@ -574,10 +574,10 @@ sub ModBasketgroup { push(@params, $basketgroupinfo->{'id'}); my $sth = $dbh->prepare($query); $sth->execute(@params); - + $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?'); $sth->execute($basketgroupinfo->{'id'}); - + if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){ $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?"); foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) { @@ -914,7 +914,7 @@ table of the Koha database. =item $hashref->{'basketno'} is the basketno foreign key in aqorders, it is mandatory -=item $hashref->{'ordernumber'} is a "minimum order number." +=item $hashref->{'ordernumber'} is a "minimum order number." =item $hashref->{'budgetdate'} is effectively ignored. If it's undef (anything false) or the string 'now', the current day is used. @@ -1141,14 +1141,14 @@ sub ModReceiveOrder { $datereceived = C4::Dates->output('iso') unless $datereceived; my $suggestionid = GetSuggestionFromBiblionumber( $dbh, $biblionumber ); if ($suggestionid) { - ModSuggestion( {suggestionid=>$suggestionid, - STATUS=>'AVAILABLE', - biblionumber=> $biblionumber} + ModSuggestion( {suggestionid=>$suggestionid, + STATUS=>'AVAILABLE', + biblionumber=> $biblionumber} ); } my $sth=$dbh->prepare(" - SELECT * FROM aqorders + SELECT * FROM aqorders WHERE biblionumber=? AND aqorders.ordernumber=?"); $sth->execute($biblionumber,$ordernumber); @@ -1234,7 +1234,7 @@ sub SearchOrder { LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno WHERE (datecancellationprinted is NULL)"; - + if($ordernumber){ $query .= " AND (aqorders.ordernumber=?)"; push @args, $ordernumber; diff --git a/C4/Labels/Label.pm b/C4/Labels/Label.pm index b1c1e28926..a6b7aa2b56 100644 --- a/C4/Labels/Label.pm +++ b/C4/Labels/Label.pm @@ -90,7 +90,7 @@ sub _get_label_item { if ($sth1->err) { 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; @@ -286,6 +286,7 @@ sub _BIBBAR { 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'})); + 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; } diff --git a/C4/Search.pm b/C4/Search.pm index 2fe57ed958..8741072929 100644 --- a/C4/Search.pm +++ b/C4/Search.pm @@ -197,7 +197,7 @@ $template->param(result=>\@results); sub SimpleSearch { my ( $query, $offset, $max_results, $servers ) = @_; - + if ( C4::Context->preference('NoZebra') ) { my $result = NZorder( NZanalyse($query) )->{'biblioserver'}; my $search_result = @@ -283,7 +283,7 @@ sub SimpleSearch { ); The all singing, all dancing, multi-server, asynchronous, scanning, -searching, record nabbing, facet-building +searching, record nabbing, facet-building See verbse embedded documentation. @@ -517,9 +517,9 @@ sub getRecords { # if it's a branch, label by the name, not the code, if ( $link_value =~ /branch/ ) { - if (defined $branches - && ref($branches) eq "HASH" - && defined $branches->{$one_facet} + if (defined $branches + && ref($branches) eq "HASH" + && defined $branches->{$one_facet} && ref ($branches->{$one_facet}) eq "HASH") { $facet_label_value = @@ -550,7 +550,7 @@ sub getRecords { push @facets_loop, { type_link_value => $link_value, type_id => $link_value . "_id", - "type_label_" . $facets_info->{$link_value}->{'label_value'} => 1, + "type_label_" . $facets_info->{$link_value}->{'label_value'} => 1, facets => \@this_facets_array, expandable => $expandable, expand => $link_value, @@ -578,10 +578,10 @@ sub pazGetRecords { my $results_hashref = {}; my $stats = XMLin($paz->stat); my $results = XMLin($paz->show($offset, $results_per_page, 'work-title:1'), forcearray => 1); - + # for a grouped search result, the number of hits # is the number of groups returned; 'bib_hits' will have - # the total number of bibs. + # the total number of bibs. $results_hashref->{'biblioserver'}->{'hits'} = $results->{'merged'}->[0]; $results_hashref->{'biblioserver'}->{'bib_hits'} = $stats->{'hits'}; @@ -613,7 +613,7 @@ sub pazGetRecords { push @{ $results_hashref->{'biblioserver'}->{'GROUPS'} }, $result_group; } - + # pass through facets my $termlist_xml = $paz->termlist('author,subject'); my $terms = XMLin($termlist_xml, forcearray => 1); @@ -647,7 +647,7 @@ sub _remove_stopwords { # we use IsAlpha unicode definition, to deal correctly with diacritics. # otherwise, a French word like "leçon" woudl be split into "le" "çon", "le" # is a stopword, we'd get "çon" and wouldn't find anything... -# +# foreach ( keys %{ C4::Context->stopwords } ) { next if ( $_ =~ /(and|or|not)/ ); # don't remove operators $debug && warn "$_ Dump($operand)"; @@ -700,13 +700,13 @@ sub _build_stemmed_operand { # If operand contains a digit, it is almost certainly an identifier, and should # not be stemmed. This is particularly relevant for ISBNs and ISSNs, which - # can contain the letter "X" - for example, _build_stemmend_operand would reduce + # can contain the letter "X" - for example, _build_stemmend_operand would reduce # "014100018X" to "x ", which for a MARC21 database would bring up irrelevant # results (e.g., "23 x 29 cm." from the 300$c). Bug 2098. return $operand if $operand =~ /\d/; # FIXME: the locale should be set based on the user's language and/or search choice - warn "$lang"; + #warn "$lang"; my $stemmer = Lingua::Stem::Snowball->new( lang => $lang, encoding => "UTF-8" ); @@ -905,7 +905,7 @@ sub buildQuery { # ISBN,ISSN,Standard Number, don't need special treatment elsif ( $index eq 'nb' || $index eq 'ns' ) { $indexes_set++; - ( + ( $stemming, $auto_truncation, $weight_fields, $fuzzy_enabled, $remove_stopwords @@ -1195,20 +1195,20 @@ sub searchResults { } my $marcflavour = C4::Context->preference("marcflavour"); - # We get the biblionumber position in MARC + # We get the biblionumber position in MARC my ($bibliotag,$bibliosubf)=GetMarcFromKohaField('biblio.biblionumber',''); my $fw; - + # loop through all of the records we've retrieved for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) { my $marcrecord = MARC::File::USMARC::decode( $marcresults[$i] ); - + if ($bibliotag<10){ $fw = GetFrameworkCode($marcrecord->field($bibliotag)->data); }else{ $fw = GetFrameworkCode($marcrecord->subfield($bibliotag,$bibliosubf)); } - + my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, $fw ); $oldbiblio->{subtitle} = GetRecordValue('subtitle', $marcrecord, $fw); $oldbiblio->{result_number} = $i + 1; @@ -1231,7 +1231,7 @@ sub searchResults { if ( $itemtypes{ $oldbiblio->{itemtype} }->{summary} ) { my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary}; my @fields = $marcrecord->fields(); - + my $newsummary; foreach my $line ( "$summary\n" =~ /(.*)\n/g ){ my $tags = {}; @@ -1242,28 +1242,28 @@ sub searchResults { $tags->{$tag} = $#abc + 1 ; } } - + # We catch how many times to repeat this line my $max = 0; foreach my $tag (keys(%$tags)){ $max = $tags->{$tag} if($tags->{$tag} > $max); } - + # we replace, and repeat each line for (my $i = 0 ; $i < $max ; $i++){ my $newline = $line; foreach my $tag ( $newline =~ /\[(\d{3}[\w|\d])\]/g ) { $tag =~ /(.{3})(.)/; - + if($marcrecord->field($1)){ my @repl = $marcrecord->field($1)->subfield($2); my $subfieldvalue = $repl[$i]; - + if (! utf8::is_utf8($subfieldvalue)) { utf8::decode($subfieldvalue); } - + $newline =~ s/\[$tag\]/$subfieldvalue/g; } } @@ -1313,7 +1313,7 @@ sub searchResults { foreach my $code ( keys %subfieldstosearch ) { $item->{$code} = $field->subfield( $subfieldstosearch{$code} ); } - + my $hbranch = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'homebranch' : 'holdingbranch'; my $otherbranch = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'holdingbranch' : 'homebranch'; # set item's branch name, use HomeOrHoldingBranch syspref first, fall back to the other one @@ -1321,7 +1321,7 @@ sub searchResults { $item->{'branchname'} = $branches{$item->{$hbranch}}; } elsif ($item->{$otherbranch}) { # Last resort - $item->{'branchname'} = $branches{$item->{$otherbranch}}; + $item->{'branchname'} = $branches{$item->{$otherbranch}}; } my $prefix = $item->{$hbranch} . '--' . $item->{location} . $item->{itype} . $item->{itemcallnumber}; @@ -1355,7 +1355,7 @@ sub searchResults { # is item in transit? my $transfertwhen = ''; my ($transfertfrom, $transfertto); - + unless ($item->{wthdrawn} || $item->{itemlost} || $item->{damaged} @@ -1381,7 +1381,7 @@ sub searchResults { if ( $item->{wthdrawn} || $item->{itemlost} || $item->{damaged} - || $item->{notforloan} + || $item->{notforloan} || ($transfertwhen ne '')) { $wthdrawn_count++ if $item->{wthdrawn}; @@ -1460,34 +1460,34 @@ sub searchResults { $oldbiblio->{orderedcount} = $ordered_count; $oldbiblio->{isbn} =~ s/-//g; # deleting - in isbn to enable amazon content - push( @newresults, $oldbiblio ) + push( @newresults, $oldbiblio ) if(not $hidelostitems - or (($items_count > $itemlost_count ) + or (($items_count > $itemlost_count ) && $hidelostitems)); } - + return @newresults; } =head2 SearchAcquisitions - Search for acquisitions + Search for acquisitions =cut sub SearchAcquisitions{ my ($datebegin, $dateend, $itemtypes,$criteria, $orderby) = @_; - + my $dbh=C4::Context->dbh; # Variable initialization my $str=qq| - SELECT marcxml - FROM biblio + SELECT marcxml + FROM biblio LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber LEFT JOIN items ON items.biblionumber=biblio.biblionumber - WHERE dateaccessioned BETWEEN ? AND ? + WHERE dateaccessioned BETWEEN ? AND ? |; - + my (@params,@loopcriteria); - + push @params, $datebegin->output("iso"); push @params, $dateend->output("iso"); @@ -1496,53 +1496,53 @@ sub SearchAcquisitions{ $str .= "AND items.itype IN (?".( ',?' x scalar @$itemtypes - 1 ).") "; }else{ $str .= "AND biblioitems.itemtype IN (?".( ',?' x scalar @$itemtypes - 1 ).") "; - } + } push @params, @$itemtypes; } - + if ($criteria =~/itemtype/){ if(C4::Context->preference("item-level_itypes")){ $str .= "AND items.itype=? "; }else{ $str .= "AND biblioitems.itemtype=? "; } - + if(scalar(@$itemtypes) == 0){ my $itypes = GetItemTypes(); for my $key (keys %$itypes){ push @$itemtypes, $key; } } - + @loopcriteria= @$itemtypes; }elsif ($criteria=~/itemcallnumber/){ - $str .= "AND (items.itemcallnumber LIKE CONCAT(?,'%') + $str .= "AND (items.itemcallnumber LIKE CONCAT(?,'%') OR items.itemcallnumber is NULL OR items.itemcallnumber = '')"; - @loopcriteria = ("AA".."ZZ", "") unless (scalar(@loopcriteria)>0); + @loopcriteria = ("AA".."ZZ", "") unless (scalar(@loopcriteria)>0); }else { $str .= "AND biblio.title LIKE CONCAT(?,'%') "; - @loopcriteria = ("A".."z") unless (scalar(@loopcriteria)>0); + @loopcriteria = ("A".."z") unless (scalar(@loopcriteria)>0); } - + if ($orderby =~ /date_desc/){ $str.=" ORDER BY dateaccessioned DESC"; } else { $str.=" ORDER BY title"; } - + my $qdataacquisitions=$dbh->prepare($str); - + my @loopacquisitions; foreach my $value(@loopcriteria){ push @params,$value; my %cell; $cell{"title"}=$value; $cell{"titlecode"}=$value; - + eval{$qdataacquisitions->execute(@params);}; - + if ($@){ warn "recentacquisitions Error :$@";} else { my @loopdata; @@ -1632,7 +1632,7 @@ sub NZanalyse { # depending of operand, intersect, union or exclude both lists # to get a result list if ( $operator eq ' and ' ) { - return NZoperatorAND($leftresult,$rightresult); + return NZoperatorAND($leftresult,$rightresult); } elsif ( $operator eq ' or ' ) { @@ -1640,13 +1640,13 @@ sub NZanalyse { return $leftresult . $rightresult; } elsif ( $operator eq ' not ' ) { - return NZoperatorNOT($leftresult,$rightresult); + return NZoperatorNOT($leftresult,$rightresult); } - } + } else { # this error is impossible, because of the regexp that isolate the operand, but just in case... return $leftresult; - } + } } warn "string :" . $string if $DEBUG; my $left = ""; @@ -1738,7 +1738,7 @@ sub NZanalyse { $left = 'subject' if $left =~ '^su$'; $left = 'koha-Auth-Number' if $left =~ '^an$'; $left = 'keyword' if $left =~ '^kw$'; - $left = 'itemtype' if $left =~ '^mc$'; # Fix for Bug 2599 - Search limits not working for NoZebra + $left = 'itemtype' if $left =~ '^mc$'; # Fix for Bug 2599 - Search limits not working for NoZebra warn "handling leaf... left:$left operator:$operator right:$right" if $DEBUG; my $dbh = C4::Context->dbh; if ( $operator && $left ne 'keyword' ) { @@ -1814,10 +1814,10 @@ sub NZanalyse { sub NZoperatorAND{ my ($rightresult, $leftresult)=@_; - + my @leftresult = split /;/, $leftresult; warn " @leftresult / $rightresult \n" if $DEBUG; - + # my @rightresult = split /;/,$leftresult; my $finalresult; @@ -1838,7 +1838,7 @@ sub NZoperatorAND{ warn "NZAND DONE : $finalresult \n" if $DEBUG; return $finalresult; } - + sub NZoperatorOR{ my ($rightresult, $leftresult)=@_; return $rightresult.$leftresult; @@ -1846,7 +1846,7 @@ sub NZoperatorOR{ sub NZoperatorNOT{ my ($leftresult, $rightresult)=@_; - + my @leftresult = split /;/, $leftresult; # my @rightresult = split /;/,$leftresult; @@ -1864,7 +1864,7 @@ sub NZoperatorNOT{ =head2 NZorder $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset); - + TODO :: Description =cut @@ -2299,12 +2299,12 @@ sub BiblioAddAuthorities{ my $dbh=C4::Context->dbh; my $query=$dbh->prepare(qq| SELECT authtypecode,tagfield -FROM marc_subfield_structure -WHERE frameworkcode=? +FROM marc_subfield_structure +WHERE frameworkcode=? AND (authtypecode IS NOT NULL AND authtypecode<>\"\")|); # SELECT authtypecode,tagfield -# FROM marc_subfield_structure -# WHERE frameworkcode=? +# FROM marc_subfield_structure +# WHERE frameworkcode=? # AND (authtypecode IS NOT NULL OR authtypecode<>\"\")|); $query->execute($frameworkcode); my ($countcreated,$countlinked); @@ -2316,7 +2316,7 @@ AND (authtypecode IS NOT NULL AND authtypecode<>\"\")|); my $query='at='.$data->{authtypecode}.' '; map {$query.= ' and he,ext="'.$_->[1].'"' if ($_->[0]=~/[A-z]/)} $field->subfields(); my ($error, $results, $total_hits)=SimpleSearch( $query, undef, undef, [ "authorityserver" ] ); - # there is only 1 result + # there is only 1 result if ( $error ) { warn "BIBLIOADDSAUTHORITIES: $error"; return (0,0) ; @@ -2326,14 +2326,14 @@ AND (authtypecode IS NOT NULL AND authtypecode<>\"\")|); $field->add_subfields('9'=>$marcrecord->field('001')->data); $countlinked++; } elsif (scalar(@$results)>1) { - #More than One result + #More than One result #This can comes out of a lack of a subfield. # my $marcrecord = MARC::File::USMARC::decode($results->[0]); # $record->field($data->{tagfield})->add_subfields('9'=>$marcrecord->field('001')->data); $countlinked++; } else { #There are no results, build authority record, add it to Authorities, get authid and add it to 9 - ###NOTICE : This is only valid if a subfield is linked to one and only one authtypecode + ###NOTICE : This is only valid if a subfield is linked to one and only one authtypecode ###NOTICE : This can be a problem. We should also look into other types and rejected forms. my $authtypedata=C4::AuthoritiesMarc->GetAuthType($data->{authtypecode}); next unless $authtypedata; diff --git a/labels/label-edit-template.pl b/labels/label-edit-template.pl index 259bd2737d..40540d688b 100755 --- a/labels/label-edit-template.pl +++ b/labels/label-edit-template.pl @@ -27,6 +27,7 @@ use C4::Auth qw(get_template_and_user); use C4::Output qw(output_html_with_http_headers); use C4::Creators::Lib 1.000000 qw(get_all_profiles get_unit_values); use C4::Labels::Template 1.000000; +use C4::Labels::Profile 1.000000; my $cgi = new CGI; my ( $template, $loggedinuser, $cookie ) = get_template_and_user( @@ -72,16 +73,29 @@ elsif ($op eq 'save') { ); if ($template_id) { # if a label_id was passed in, this is an update to an existing layout $label_template = C4::Labels::Template->retrieve(template_id => $template_id); - if ($cgi->param('profile_id')) { - my $old_profile = C4::Labels::Profile->retrieve(profile_id => $label_template->get_attr('profile_id')); - my $new_profile = C4::Labels::Profile->retrieve(profile_id => $cgi->param('profile_id')); - if ($label_template->get_attr('template_id') != $new_profile->get_attr('template_id')) { - $new_profile->set_attr(template_id => $label_template->get_attr('template_id')); + if ($cgi->param('profile_id') && ($label_template->get_attr('template_id') != $cgi->param('profile_id'))) { + if ($label_template->get_attr('profile_id') > 0) { # no need to get the old one if there was no profile associated + my $old_profile = C4::Labels::Profile->retrieve(profile_id => $label_template->get_attr('profile_id')); $old_profile->set_attr(template_id => 0); - $new_profile->save(); $old_profile->save(); } + my $new_profile = C4::Labels::Profile->retrieve(profile_id => $cgi->param('profile_id')); + $new_profile->set_attr(template_id => $label_template->get_attr('template_id')); + $new_profile->save(); } + +# if ($cgi->param('profile_id')) { +# my $old_profile = ($label_template->get_attr('profile_id') ? C4::Labels::Profile->retrieve(profile_id => $label_template->get_attr('profile_id')) : undef); +# my $new_profile = C4::Labels::Profile->retrieve(profile_id => $cgi->param('profile_id')); +# if ($label_template->get_attr('template_id') != $new_profile->get_attr('template_id')) { +# $new_profile->set_attr(template_id => $label_template->get_attr('template_id')); +# $new_profile->save(); +# if ($old_profile) { +# $old_profile->set_attr(template_id => 0); +# $old_profile->save(); +# } +# } +# } $label_template->set_attr(@params); $label_template->save(); } -- 2.20.1