From f6e45171bacaefa6ca83c0796eadf8fab8b67a8b Mon Sep 17 00:00:00 2001 From: Jared Camins-Esakov Date: Sun, 8 Jul 2012 22:28:56 -0400 Subject: [PATCH] Bug 8384: Some Perl scripts do not compile Fix syntax errors preventing the scripts misc/translator/text-extract2.pl and misc/cronjobs/thirdparty/TalkingTech_itiva_inbound.pl from compiling. Remove misc/migration_tools/build6xx.pl entirely since it refers to columns that no longer exist in the Koha database, and has seemingly had broken encoding since Koha switched from CVS to git (or before!). Signed-off-by: Chris Cormack Signed-off-by: Paul Poulain Conflicts: misc/cronjobs/thirdparty/TalkingTech_itiva_inbound.pl Signed-off-by: Chris Cormack Rebased as the TalkingTech code doesn't exist in 3.8.x --- misc/migration_tools/build6xx.pl | 246 ------------------------------- misc/translator/text-extract2.pl | 8 +- 2 files changed, 4 insertions(+), 250 deletions(-) delete mode 100755 misc/migration_tools/build6xx.pl diff --git a/misc/migration_tools/build6xx.pl b/misc/migration_tools/build6xx.pl deleted file mode 100755 index 2c4bf2b0d6..0000000000 --- a/misc/migration_tools/build6xx.pl +++ /dev/null @@ -1,246 +0,0 @@ -#!/usr/bin/perl -# script that rebuild thesaurus from biblio table. - -# delete FROM `marc_subfield_table` WHERE tag = "606" AND subfieldcode = 9; -use strict; -#use warnings; FIXME - Bug 2505 - -# Koha modules used -use MARC::File::USMARC; -use MARC::Record; -use MARC::Batch; -use C4::Context; -use C4::Biblio; -use C4::AuthoritiesMarc; -use Time::HiRes qw(gettimeofday); - -use Getopt::Long; -my ( $input_marc_file, $number) = ('',0); -my ($version, $verbose, $test_parameter, $field,$delete,$category,$subfields); -GetOptions( - 'h' => \$version, - 'd' => \$delete, - 't' => \$test_parameter, - 's:s' => \$subfields, - 'v' => \$verbose, - 'c:s' => \$category, -); - -if ($version || ($category eq '')) { - print <dbh; -my @subf = $subfields =~ /(##\d\d\d##.)/g; -if ($delete) { - print "deleting thesaurus\n"; - my $del1 = $dbh->prepare("delete from auth_subfield_table where authid=?"); - my $del2 = $dbh->prepare("delete from auth_word where authid=?"); - my $sth = $dbh->prepare("select authid from auth_header where authtypecode='NC'"); - $sth->execute; - while (my ($authid) = $sth->fetchrow) { - $del1->execute($authid); - $del2->execute($authid); - } - $dbh->do("delete from auth_header where authtypecode='NC'"); - $dbh->do("delete from marc_subfield_table where tag='606' and subfieldcode='9'"); - $dbh->do("delete from marc_word where tagsubfield='6069'"); -} - -if ($test_parameter) { - print "TESTING MODE ONLY\n DOING NOTHING\n===============\n"; -} -$|=1; # flushes output -my $starttime = gettimeofday; -my $sth = $dbh->prepare("select bibid from marc_biblio"); -$sth->execute; -my $i=1; -my %alreadydone; - -# search biblios to "connect" to an authority with any number of $x (limited to 4 $x in this script) -my $sthBIBLIOS = $dbh->prepare("select distinct m1.bibid,m1.tag,m1.tagorder,m1.subfieldorder from marc_subfield_table as m1 where tag in (606) and subfieldcode='a' and subfieldvalue=?"); -my $sthBIBLIOSx = $dbh->prepare("select distinct m1.bibid,m1.tag,m1.tagorder,m1.subfieldorder from marc_subfield_table as m1 left join marc_subfield_table as m2 on m1.bibid=m2.bibid where m1.tag in (606) and m1.subfieldcode='a' and m2.subfieldcode='x' and m1.subfieldvalue=? and m2.subfieldvalue=?"); -my $sthBIBLIOSxx = $dbh->prepare("select distinct m1.bibid,m1.tag,m1.tagorder,m1.subfieldorder from marc_subfield_table as m1 left join marc_subfield_table as m2 on m1.bibid=m2.bibid left join marc_subfield_table as m3 on m1.bibid=m3.bibid where m1.tag in (606) and m1.subfieldcode='a' and m2.subfieldcode='x' and m3.subfieldcode='x' and m1.subfieldvalue=? and m2.subfieldvalue=? and m3.subfieldvalue=?"); -my $sthBIBLIOSxxx = $dbh->prepare("select distinct m1.bibid,m1.tag,m1.tagorder,m1.subfieldorder from marc_subfield_table as m1 left join marc_subfield_table as m2 on m1.bibid=m2.bibid left join marc_subfield_table as m3 on m1.bibid=m4.bibid left join marc_subfield_table as m4 on m1.bibid=m4.bibid where m1.tag in (606) and m1.subfieldcode='a' and m2.subfieldcode='x' and m3.subfieldcode='x' and m4.subfieldcode='x' and m1.subfieldvalue=? and m2.subfieldvalue=? and m3.subfieldvalue=? and m4.subfieldvalue=?"); -my $sthBIBLIOSxxxx = $dbh->prepare("select distinct m1.bibid,m1.tag,m1.tagorder,m1.subfieldorder from marc_subfield_table as m1 left join marc_subfield_table as m2 on m1.bibid=m2.bibid left join marc_subfield_table as m3 on m1.bibid=m4.bibid left join marc_subfield_table as m4 on m1.bibid=m4.bibid left join marc_subfield_table as m5 on m1.bibid=m5.bibid where m1.tag in (606) and m1.subfieldcode='a' and m2.subfieldcode='x' and m3.subfieldcode='x' and m4.subfieldcode='x' and m5.subfieldcode='x' and m1.subfieldvalue=? and m2.subfieldvalue=? and m3.subfieldvalue=? and m4.subfieldvalue=? and m5.subfieldvalue=?"); - -# loop through each biblio -while (my ($bibid) = $sth->fetchrow) { - my $record = GetMarcBiblio($bibid); - my $timeneeded = gettimeofday - $starttime; - print "$i in $timeneeded s\n" unless ($i % 50); - foreach my $field ($record->field(995)) { - $record->delete_field($field); - } - my $totdone=0; - my $authid; - # search the 606 field(s) - foreach my $field ($record->field("606")) { - foreach my $authentry ($field->subfield("a")) { - # the hashentry variable contains all $x fields and the $a in a single string. Used to differenciate - # $xsomething$aelse and $asomething else - my $hashentry = $authentry; - foreach my $x ($field->subfield('x')) { - $hashentry.=" -- $x"; - } - # remove ��$e... - # all the same for mysql, but NOT for perl hashes ! - # without those lines, t� is not tot and pat� is not patee - $hashentry =~ s/���e/g; - $hashentry =~ s/��a/g; - $hashentry =~ s/�i/g; - $hashentry =~ s/�o/g; - $hashentry =~ s/|/u/g; - # uppercase all, in case of typing error. - $hashentry = uc($hashentry); - $totdone++; - if ($alreadydone{$hashentry}) { - $authid = $alreadydone{$hashentry}; - print "."; - } else { - print "*"; - #create authority. - my $authorityRecord = MARC::Record->new(); - my $newfield = MARC::Field->new(250,'','','a' => "".$authentry); - foreach my $x ($field->subfield('x')) { - $newfield->add_subfields('x' => $x); - } - foreach my $z ($field->subfield('z')) { - $newfield->add_subfields('z' => $z); - } - $authorityRecord->insert_fields_ordered($newfield); - $authid=AUTHaddauthority($dbh,$authorityRecord,'','NC'); - $alreadydone{$hashentry} = $authid; - # we have the authority number, now we update all biblios that use this authority... - my @x = $field->subfield('x'); # depending on the number of $x in the subfield - if ($#x eq -1) { # no $x - $sthBIBLIOS->execute($authentry); - while (my ($bibid,$tag,$tagorder,$subfieldorder) = $sthBIBLIOS->fetchrow) { - # check that the field does not already have a $x (if it has, it will or has been managed by another authority - my $inbiblio = GetMarcBiblio($bibid); - my $isOK = 0; - # loop in each 606 field - foreach my $in606 ($inbiblio->field('606')) { - my $inEntry = $in606->subfield('a'); - # and rebuild the $x -- $x -- $a string (like for $hashentry, few lines before) - foreach my $x ($in606->subfield('x')) { - $inEntry.=" -- $x"; - } - $inEntry =~ s/���e/g; - $inEntry =~ s/��a/g; - $inEntry =~ s/�i/g; - $inEntry =~ s/�o/g; - $inEntry =~ s/|/u/g; - $inEntry = uc($inEntry); - # ok, it's confirmed that we must add the $9 subfield for this biblio, so... - $isOK=1 if $inEntry eq $hashentry; - } - # ... add it ! - C4::Biblio::MARCaddsubfield($dbh,$bibid,$tag,'',$tagorder,9,$subfieldorder,$authid) if $isOK; - } - } - if ($#x eq 0) { # one $x - $sthBIBLIOSx->execute($authentry,$x[0]); - while (my ($bibid,$tag,$tagorder,$subfieldorder) = $sthBIBLIOSx->fetchrow) { - my $inbiblio = GetMarcBiblio($bibid); - my $isOK = 0; - foreach my $in606 ($inbiblio->field('606')) { - my $inEntry = $in606->subfield('a'); - foreach my $x ($in606->subfield('x')) { - $inEntry.=" -- $x"; - } - $inEntry =~ s/���e/g; - $inEntry =~ s/��a/g; - $inEntry =~ s/�i/g; - $inEntry =~ s/�o/g; - $inEntry =~ s/|/u/g; - $inEntry = uc($inEntry); - $isOK=1 if $inEntry eq $hashentry; - } - C4::Biblio::MARCaddsubfield($dbh,$bibid,$tag,'',$tagorder,9,$subfieldorder,$authid) if $isOK; - } - } - if ($#x eq 1) { # two $x - $sthBIBLIOSxx->execute($authentry,$x[0],$x[1]); - while (my ($bibid,$tag,$tagorder,$subfieldorder) = $sthBIBLIOSxx->fetchrow) { - my $inbiblio = GetMarcBiblio($bibid); - my $isOK = 0; - foreach my $in606 ($inbiblio->field('606')) { - my $inEntry = $in606->subfield('a'); - foreach my $x ($in606->subfield('x')) { - $inEntry.=" -- $x"; - } - $inEntry =~ s/���e/g; - $inEntry =~ s/��a/g; - $inEntry =~ s/�i/g; - $inEntry =~ s/�o/g; - $inEntry =~ s/|/u/g; - $inEntry = uc($inEntry); - $isOK=1 if $inEntry eq $hashentry; - } - C4::Biblio::MARCaddsubfield($dbh,$bibid,$tag,'',$tagorder,9,$subfieldorder,$authid) if $isOK; - } - } - if ($#x eq 2) { # 3 $x - $sthBIBLIOSxxx->execute($authentry,$x[0],$x[1],$x[2]); - while (my ($bibid,$tag,$tagorder,$subfieldorder) = $sthBIBLIOSxxx->fetchrow) { - my $inbiblio = GetMarcBiblio($bibid); - my $isOK = 0; - foreach my $in606 ($inbiblio->field('606')) { - my $inEntry = $in606->subfield('a'); - foreach my $x ($in606->subfield('x')) { - $inEntry.=" -- $x"; - } - $inEntry =~ s/���e/g; - $inEntry =~ s/��a/g; - $inEntry =~ s/�i/g; - $inEntry =~ s/�o/g; - $inEntry =~ s/|/u/g; - $inEntry = uc($inEntry); - $isOK=1 if $inEntry eq $hashentry; - } - C4::Biblio::MARCaddsubfield($dbh,$bibid,$tag,'',$tagorder,9,$subfieldorder,$authid) if $isOK; - } - } - if ($#x eq 3) { # 3 $x - $sthBIBLIOSxxxx->execute($authentry,$x[0],$x[1],$x[2],$x[3]); - while (my ($bibid,$tag,$tagorder,$subfieldorder) = $sthBIBLIOSxxxx->fetchrow) { - my $inbiblio = GetMarcBiblio($bibid); - my $isOK = 0; - foreach my $in606 ($inbiblio->field('606')) { - my $inEntry = $in606->subfield('a'); - foreach my $x ($in606->subfield('x')) { - $inEntry.=" -- $x"; - } - $inEntry =~ s/���e/g; - $inEntry =~ s/��a/g; - $inEntry =~ s/�i/g; - $inEntry =~ s/�o/g; - $inEntry =~ s/|/u/g; - $inEntry = uc($inEntry); - $isOK=1 if $inEntry eq $hashentry; - } - C4::Biblio::MARCaddsubfield($dbh,$bibid,$tag,'',$tagorder,9,$subfieldorder,$authid) if $isOK; - } - } - if ($#x >4) { - # too many $x, not handled, warn the developer that tries to migrate - print "warning there is ".$#x.'$x values'; - } - } - } - } - $i++; -} -my $timeneeded = gettimeofday - $starttime; -print "$i entries done in $timeneeded seconds (".($i/$timeneeded)." per second)\n"; diff --git a/misc/translator/text-extract2.pl b/misc/translator/text-extract2.pl index 452fd89666..79bf5ad2b3 100755 --- a/misc/translator/text-extract2.pl +++ b/misc/translator/text-extract2.pl @@ -42,7 +42,7 @@ sub debug_dump ($) { # for testing only my($kind, $t, $attr) = ($s->type, $s->string, $s->attributes); printf "%s [line %d]:\n", $kind->to_string, $s->line_number; printf "%4dH%s\n", length($t), underline($t); - if ($kind == TmplTokenType::TAG && %$attr) { + if ($kind == TmplTokenType::TAG() && %$attr) { printf "Attributes:\n"; for my $a (keys %$attr) { my($key, $val, $val_orig, $order) = @{$attr->{$a}}; @@ -50,7 +50,7 @@ sub debug_dump ($) { # for testing only $val_orig; } } - if ($kind == TmplTokenType::TEXT_PARAMETRIZED) { + if ($kind == TmplTokenType::TEXT_PARAMETRIZED()) { printf "Form (c-format string):\n"; printf "%dH%s\n", length $s->form, underline $s->form; printf "Parameters:\n"; @@ -79,10 +79,10 @@ sub text_extract ($) { my $s = TmplTokenizer::next_token $h; last unless defined $s; my($kind, $t, $attr) = ($s->type, $s->string, $s->attributes); - if ($kind == TmplTokenType::TEXT) { + if ($kind == TmplTokenType::TEXT()) { $t = TmplTokenizer::trim $t; $text{$t} = 1 if $t =~ /\S/s; - } elsif ($kind == TmplTokenType::TAG && %$attr) { + } elsif ($kind == TmplTokenType::TAG() && %$attr) { # value [tag=input], meta my $tag = lc($1) if $t =~ /^<(\S+)/s; for my $a ('alt', 'content', 'title', 'value') { -- 2.39.5