Attachment 10706 Details for Bug 8384 – Bug 8384: Some Perl scripts do not compile

[patch] Bug 8384: Some Perl scripts do not compile

Bug-8384-Some-Perl-scripts-do-not-compile.patch (text/plain), 16.09 KB, created by Chris Cormack on 2012-07-09 03:08:01 UTC

(hide)

Description:

Filename:

MIME Type:

Creator: Chris Cormack

Created: 2012-07-09 03:08:01 UTC

Size: 16.09 KB

patch

obsolete

>From a113336ed41ad3a063ffcec32114568fcc54b7d4 Mon Sep 17 00:00:00 2001
>From: Jared Camins-Esakov <jcamins@cpbibliography.com>
>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 <chris@bigballofwax.co.nz>
>---
> .../thirdparty/TalkingTech_itiva_inbound.pl        |    2 +-
> misc/migration_tools/build6xx.pl                   |  246 --------------------
> misc/translator/text-extract2.pl                   |    8 +-
> 3 files changed, 5 insertions(+), 251 deletions(-)
> delete mode 100755 misc/migration_tools/build6xx.pl
>
>diff --git a/misc/cronjobs/thirdparty/TalkingTech_itiva_inbound.pl b/misc/cronjobs/thirdparty/TalkingTech_itiva_inbound.pl
>index e3a7055..814f10a 100755
>--- a/misc/cronjobs/thirdparty/TalkingTech_itiva_inbound.pl
>+++ b/misc/cronjobs/thirdparty/TalkingTech_itiva_inbound.pl
>@@ -64,7 +64,7 @@ die pod2usage() if $help;
> 
> # initialize the input data, either file or query
> if ( defined $infile ) {
>-    my $IN open( $IN, '<', $infile ) || die("Cannot open input file");
>+    open( my $IN, '<', $infile ) || die("Cannot open input file");
>     print "Opening $infile\n" if ( defined $verbose );
> 
>     while (<$IN>) {
>diff --git a/misc/migration_tools/build6xx.pl b/misc/migration_tools/build6xx.pl
>deleted file mode 100755
>index 2c4bf2b..0000000
>--- 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 <<EOF
>-small script to recreate a authority table into Koha.
>-parameters :
>-\tc : thesaurus category. Can be filled with anything, the NC is hardcoded. But mandatory to confirm that you want to rebuild 6xx
>-\d : delete every entry of the selected category before doing work.
>-
>-SAMPLES :
>- ./build6xx.pl -c NC -d 
>-EOF
>-;#
>-die;
>-}
>-
>-my $dbh = C4::Context->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 452fd89..79bf5ad 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') {
>-- 
>1.7.10

Actions: View | Diff | Splinter Review

Attachments on bug 8384: 10705 | 10706