From ef0bf377262f7fd143d85a2caf085cd90c0dcb76 Mon Sep 17 00:00:00 2001 From: Chris Cormack Date: Wed, 8 Aug 2007 11:01:30 -0500 Subject: [PATCH] More uneeded files, Patch from Paul --- misc/barcodes.pl | 285 ---- misc/koha.conf | 4 - misc/marc_into_authority.pl | 140 -- misc/marcimport_to_biblioitems.pl | 86 -- misc/missing090field.pl | 50 - misc/rebuildthesaurus.pl | 88 -- misc/safe-installer | 948 ------------ misc/sampledata-1.2 | 2304 ----------------------------- misc/tidyaccounts.pl | 45 - 9 files changed, 3950 deletions(-) delete mode 100644 misc/barcodes.pl delete mode 100644 misc/koha.conf delete mode 100644 misc/marc_into_authority.pl delete mode 100644 misc/marcimport_to_biblioitems.pl delete mode 100755 misc/missing090field.pl delete mode 100644 misc/rebuildthesaurus.pl delete mode 100644 misc/safe-installer delete mode 100644 misc/sampledata-1.2 delete mode 100755 misc/tidyaccounts.pl diff --git a/misc/barcodes.pl b/misc/barcodes.pl deleted file mode 100644 index 950608c264..0000000000 --- a/misc/barcodes.pl +++ /dev/null @@ -1,285 +0,0 @@ -#!/usr/bin/perl - - - -#################### -# Variable Section # -#################### - -# Copyright 2000-2002 Katipo Communications -# -# This file is part of Koha. -# -# Koha is free software; you can redistribute it and/or modify it under the -# terms of the GNU General Public License as published by the Free Software -# Foundation; either version 2 of the License, or (at your option) any later -# version. -# -# Koha is distributed in the hope that it will be useful, but WITHOUT ANY -# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR -# A PARTICULAR PURPOSE. See the GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License along with -# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, -# Suite 330, Boston, MA 02111-1307 USA - -my $pretext='T '; -my $startnumber=1000; -my $pages=2; -my $libraryname='Copper Mountain Elementary'; - -# Shifts are given in millimeters. Positive numbers move up and to the right. -# These variables shift the whole page to account for printer differences. -my $shiftx=0; -my $shifty=0; - -#################### - - - -my $leftmargin=5; -my $rightmargin=3; -my $topmargin=18; -my $botmargin=10; - - -my $rightside=215; -my $topside=280; - - -my $barcodewidth=length("$pretext$startnumber")+2; - -my $bcwidthfactor=8-$barcodewidth/2; -print STDERR "$barcodewidth $bcwidthfactor\n"; - -my $width=$rightside-($leftmargin+$rightmargin); -my $height=$topside-$topmargin-$botmargin; - -print << "EOF"; -%!PS-Adobe-2.0 -%%Title: barcode.ps -%%Creator: Willem van Schaik -%%CreationDate: aug 1992 -%%Pages: 1 -%%DocumentFonts: Helvetica Code39 -%%BoundingBox: 0 0 595 842 -%%EndComments - -/newfont 10 dict def -newfont begin -/FontType 3 def -/FontMatrix [0.01 0 0 0.01 0 0] def -/FontBBox [0 0 100 100] def - -/Encoding 256 array def -0 1 255 {Encoding exch /.notdef put} for -Encoding 32 /barSpace put -Encoding 36 /barDollar put -Encoding 37 /barPercent put -Encoding 42 /barAsterisk put -Encoding 43 /barPlus put -Encoding 45 /barHyphen put -Encoding 46 /barPeriod put -Encoding 47 /barSlash put -Encoding 48 /bar0 put -Encoding 49 /bar1 put -Encoding 50 /bar2 put -Encoding 51 /bar3 put -Encoding 52 /bar4 put -Encoding 53 /bar5 put -Encoding 54 /bar6 put -Encoding 55 /bar7 put -Encoding 56 /bar8 put -Encoding 57 /bar9 put -Encoding 65 /barA put -Encoding 66 /barB put -Encoding 67 /barC put -Encoding 68 /barD put -Encoding 69 /barE put -Encoding 70 /barF put -Encoding 71 /barG put -Encoding 72 /barH put -Encoding 73 /barI put -Encoding 74 /barJ put -Encoding 75 /barK put -Encoding 76 /barL put -Encoding 77 /barM put -Encoding 78 /barN put -Encoding 79 /barO put -Encoding 80 /barP put -Encoding 81 /barQ put -Encoding 82 /barR put -Encoding 83 /barS put -Encoding 84 /barT put -Encoding 85 /barU put -Encoding 86 /barV put -Encoding 87 /barW put -Encoding 88 /barX put -Encoding 89 /barY put -Encoding 90 /barZ put - -/CharProcs 45 dict def -CharProcs begin -/.notdef {} def -/barSpace {0 7 17 17 7 7 7 17 7 7 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barDollar {0 7 17 7 17 7 17 7 7 7 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barPercent {0 7 7 7 17 7 17 7 17 7 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barAsterisk {0 7 17 7 7 17 7 17 7 7 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barPlus {0 7 17 7 7 7 17 7 17 7 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barHyphen {0 7 17 7 7 7 7 17 7 17 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barPeriod {0 17 17 7 7 7 7 17 7 7 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barSlash {0 7 17 7 17 7 7 7 17 7 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/bar0 {0 7 7 7 17 17 7 17 7 7 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/bar1 {0 17 7 7 17 7 7 7 7 17 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/bar2 {0 7 7 17 17 7 7 7 7 17 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/bar3 {0 17 7 17 17 7 7 7 7 7 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/bar4 {0 7 7 7 17 17 7 7 7 17 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/bar5 {0 17 7 7 17 17 7 7 7 7 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/bar6 {0 7 7 17 17 17 7 7 7 7 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/bar7 {0 7 7 7 17 7 7 17 7 17 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/bar8 {0 17 7 7 17 7 7 17 7 7 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/bar9 {0 7 7 17 17 7 7 17 7 7 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barA {0 17 7 7 7 7 17 7 7 17 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barB {0 7 7 17 7 7 17 7 7 17 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barC {0 17 7 17 7 7 17 7 7 7 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barD {0 7 7 7 7 17 17 7 7 17 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barE {0 17 7 7 7 17 17 7 7 7 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barF {0 7 7 17 7 17 17 7 7 7 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barG {0 7 7 7 7 7 17 17 7 17 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barH {0 17 7 7 7 7 17 17 7 7 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barI {0 7 7 17 7 7 17 17 7 7 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barJ {0 7 7 7 7 17 17 17 7 7 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barK {0 17 7 7 7 7 7 7 17 17 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barL {0 7 7 17 7 7 7 7 17 17 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barM {0 17 7 17 7 7 7 7 17 7 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barN {0 7 7 7 7 17 7 7 17 17 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barO {0 17 7 7 7 17 7 7 17 7 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barP {0 7 7 17 7 17 7 7 17 7 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barQ {0 7 7 7 7 7 7 17 17 17 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barR {0 17 7 7 7 7 7 17 17 7 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barS {0 7 7 17 7 7 7 17 17 7 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barT {0 7 7 7 7 17 7 17 17 7 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barU {0 17 17 7 7 7 7 7 7 17 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barV {0 7 17 17 7 7 7 7 7 17 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barW {0 17 17 17 7 7 7 7 7 7 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barX {0 7 17 7 7 17 7 7 7 17 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barY {0 17 17 7 7 17 7 7 7 7 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -/barZ {0 7 17 17 7 17 7 7 7 7 newpath 93 0 moveto 5 {dup 0 100 rlineto -neg 0 rlineto 0 -100 rlineto closepath add neg 0 rmoveto} repeat fill} def -end - -/BuildChar -{ 100 0 0 0 93 100 setcachedevice - exch - begin - Encoding exch get - CharProcs exch get - end - exec -} def -end - -/Code39 newfont definefont pop - -%%EndProlog - -EOF - -my $number=$startnumber; -while ($page<$pages) { - my $data=''; - for ($i=$leftmargin; $i<$rightside-$rightmargin; $i+=$width/4) { - for ($j=$botmargin; $j<$topside-$topmargin-$botmargin; $j+=$height/20) { - my $x=$i+$width/8; - my $y=$j+$height/40; - my $schooly=$y+5.8; - my $labely=$y-2.2; - my $lox=$x-2; - my $hix=$x+2; - my $loy=$y-2; - my $hiy=$y+2; - $data.=<<"EOF"; -$x $y moveto -/Code39 findfont [$bcwidthfactor 0 0 5 0 0] makefont setfont -(*$pretext$number*) dup stringwidth pop 2 div neg 0 rmoveto show -/Helvetica findfont 1.7 scalefont setfont -$x $schooly moveto -($schoolname) dup stringwidth pop 2 div neg 0 rmoveto show -/Helvetica findfont 2.3 scalefont setfont -$x $labely moveto -($pretext$number) dup stringwidth pop 2 div neg 0 rmoveto show - - -EOF - $number++; - } - } - - - $page++; - print << "EOF"; -%%Page: $page $page -%%PagerFonts: - -$shiftx $shifty translate -72 25.4 div dup scale - -/Code39 findfont [4 0 0 5 0 0] makefont setfont -/Times-Roman findfont -1 scalefont -setfont -$data - - - - - -showpage - - -EOF -} -print "%%Trailer\n"; diff --git a/misc/koha.conf b/misc/koha.conf deleted file mode 100644 index 0ea6a20724..0000000000 --- a/misc/koha.conf +++ /dev/null @@ -1,4 +0,0 @@ -database=koha -hostname=localhost -user=Koha -pass=password diff --git a/misc/marc_into_authority.pl b/misc/marc_into_authority.pl deleted file mode 100644 index d9b038fce2..0000000000 --- a/misc/marc_into_authority.pl +++ /dev/null @@ -1,140 +0,0 @@ -#!/usr/bin/perl -# script that populates the authorities table with marc -# Written by TG on 10/04/2006 -use strict; - -# Koha modules used - -use C4::Context; -use MARC::Record; -use MARC::File::USMARC; -use MARC::File::XML; -use C4::AuthoritiesMarc; -use Time::HiRes qw(gettimeofday); -my $timeneeded; -my $starttime = gettimeofday; - - -my $dbh = C4::Context->dbh; -my $sthcols=$dbh->prepare("show columns from auth_header"); -$sthcols->execute(); -my %columns; -while (( my $cols)=$sthcols->fetchrow){ -$columns{$cols}=1; -} - -##Update the database if missing fields; - $dbh->do("LOCK TABLES auth_header WRITE, auth_subfield_structure WRITE , auth_subfield_table READ"); -unless ($columns{'linkid'}){ -my $sth=$dbh->prepare("ALTER TABLE auth_header ADD COLUMN `linkid` BIGINT(20) UNSIGNED NOT NULL DEFAULT 0 "); -$sth->execute(); -} -unless ($columns{'marc'}){ -my $sth=$dbh->prepare("ALTER TABLE auth_header ADD COLUMN `marc` BLOB NOT NULL DEFAULT 0 "); -$sth->execute(); -} -###Chechk auth_subfield_structure as well. User may have forgotten to update database -my $sthcols=$dbh->prepare("show columns from auth_subfield_structure"); -$sthcols->execute(); -my %columns; -while (( my $cols)=$sthcols->fetchrow){ -$columns{$cols}=1; -} -##Update the database if missing fields; -unless ($columns{'link'}){ -my $sth=$dbh->prepare("ALTER TABLE auth_subfield_structure ADD COLUMN `link` TINYINT(1) UNSIGNED NOT NULL DEFAULT 0 "); -$sth->execute(); -} -unless ($columns{'isurl'}){ -my $sth=$dbh->prepare("ALTER TABLE auth_subfield_structure ADD COLUMN `isurl` TINYINT(1) UNSIGNED NOT NULL DEFAULT 0 "); -$sth->execute(); -} -unless ($columns{'hidden'}){ -my $sth=$dbh->prepare("ALTER TABLE auth_subfield_structure ADD COLUMN `hidden` TINYINT(3) UNSIGNED NOT NULL ZEROFILL DEFAULT 000 "); -$sth->execute(); -} -unless ($columns{'kohafield'}){ -my $sth=$dbh->prepare("ALTER TABLE auth_subfield_structure ADD COLUMN `kohafield` VARCHAR(45) NOT NULL "); -$sth->execute(); -} -$dbh->do("UNLOCK TABLES "); -my $sth=$dbh->prepare("select authid,authtypecode from auth_header "); - $sth->execute(); - -my $i=0; -my $sth2 = $dbh->prepare("UPDATE auth_header set marc=? where authid=?" ); - - -while (my ($authid,$authtypecode)=$sth->fetchrow ){ - my $record = AUTHgetauthorityold($dbh,$authid); -##Add authid and authtypecode to record. Old records did not have these fields -my ($authidfield,$authidsubfield)=AUTHfind_marc_from_kohafield("auth_header.authid",$authtypecode); -my ($authidfield,$authtypesubfield)=AUTHfind_marc_from_kohafield("auth_header.authtypecode",$authtypecode); -##Both authid and authtypecode is expected to be in the same field. Modify if other requirements arise - $record->add_fields($authidfield,'','',$authidsubfield=>$authid,$authtypesubfield=>$authtypecode); -$sth2->execute($record->as_usmarc,$authid); -$timeneeded = gettimeofday - $starttime unless ($i % 1000); - print "$i in $timeneeded s\n" unless ($i % 1000); - print "." unless ($i % 500); - $i++; -} - - -sub AUTHgetauthorityold { -# Returns MARC::Record of the biblio passed in parameter. - my ($dbh,$authid)=@_; - my $record = MARC::Record->new(); -#---- TODO : the leader is missing - $record->leader(' '); - my $sth3=$dbh->prepare("select authid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue - from auth_subfield_table - where authid=? order by tag,tagorder,subfieldorder - "); - $sth3->execute($authid); - my $prevtagorder=1; - my $prevtag='XXX'; - my $previndicator; - my $field; # for >=10 tags - my $prevvalue; # for <10 tags - while (my $row=$sth3->fetchrow_hashref) { - if ($row->{tagorder} ne $prevtagorder || $row->{tag} ne $prevtag) { - $previndicator.=" "; - if ($prevtag <10) { - $record->add_fields((sprintf "%03s",$prevtag),$prevvalue) unless $prevtag eq "XXX"; # ignore the 1st loop - } else { - $record->add_fields($field) unless $prevtag eq "XXX"; - } - undef $field; - $prevtagorder=$row->{tagorder}; - $prevtag = $row->{tag}; - $previndicator=$row->{tag_indicator}; - if ($row->{tag}<10) { - $prevvalue = $row->{subfieldvalue}; - } else { - $field = MARC::Field->new((sprintf "%03s",$prevtag), substr($row->{tag_indicator}.' ',0,1), substr($row->{tag_indicator}.' ',1,1), $row->{'subfieldcode'}, $row->{'subfieldvalue'} ); - } - } else { - if ($row->{tag} <10) { - $record->add_fields((sprintf "%03s",$row->{tag}), $row->{'subfieldvalue'}); - } else { - $field->add_subfields($row->{'subfieldcode'}, $row->{'subfieldvalue'} ); - } - $prevtag= $row->{tag}; - $previndicator=$row->{tag_indicator}; - } - } - # the last has not been included inside the loop... do it now ! - if ($prevtag ne "XXX") { # check that we have found something. Otherwise, prevtag is still XXX and we - # must return an empty record, not make MARC::Record fail because we try to - # create a record with XXX as field :-( - if ($prevtag <10) { - $record->add_fields($prevtag,$prevvalue); - } else { - # my $field = MARC::Field->new( $prevtag, "", "", %subfieldlist); - $record->add_fields($field); - } - } - return $record; -} - -END; \ No newline at end of file diff --git a/misc/marcimport_to_biblioitems.pl b/misc/marcimport_to_biblioitems.pl deleted file mode 100644 index cc80d5e902..0000000000 --- a/misc/marcimport_to_biblioitems.pl +++ /dev/null @@ -1,86 +0,0 @@ -#!/usr/bin/perl -# script that correct the marcxml from in biblioitems -# Written by TG on 10/04/2006 -use strict; - -# Koha modules used - -use C4::Context; -use C4::Biblio; -use MARC::Record; -use MARC::File::USMARC; -use MARC::File::XML; -use MARC::Batch; -use Time::HiRes qw(gettimeofday); -use Getopt::Long; -my $input_marc_file = ''; -my ($version); -GetOptions( - 'file:s' => \$input_marc_file, - 'h' => \$version, -); - -if ($version || ($input_marc_file eq '')) { - print <dbh; - -my $sth2=$dbh->prepare("update biblioitems set marc=? where biblionumber=?"); -my $i=0; - -my $batch = MARC::Batch->new( 'USMARC', $input_marc_file ); -$batch->warnings_off(); -$batch->strict_off(); -my $i=0; -my ($tagfield,$biblionumtagsubfield) = &GetMarcFromKohaField("biblio.biblionumber",""); - -while ( my $record = $batch->next() ) { -my $biblionumber=$record->field($tagfield)->subfield($biblionumtagsubfield); -$i++; -$sth2->execute($record->as_usmarc,$biblionumber) if $biblionumber; -print "$biblionumber \n"; -} - -$timeneeded = gettimeofday - $starttime ; - print "$i records in $timeneeded s\n" ; - -END; -sub search{ -my ($query)=@_; -my $nquery="\ \@attr 1=1007 ".$query; -my $oAuth=C4::Context->Zconn("biblioserver"); -if ($oAuth eq "error"){ -warn "Error/CONNECTING \n"; - return("error",undef); -} -my $oAResult; -my $Anewq= new ZOOM::Query::PQF($nquery); -eval { -$oAResult= $oAuth->search_pqf($nquery) ; -}; -if($@){ -warn " /Cannot search:", $@->code()," /MSG:",$@->message(),"\n"; - return("error",undef); -} -my $authrecord; -my $nbresults="0"; - $nbresults=$oAResult->size(); -if ($nbresults eq "1" ){ -my $rec=$oAResult->record(0); -my $marcdata=$rec->raw(); - $authrecord = MARC::File::USMARC::decode($marcdata); -} -return ($authrecord,$nbresults); -} \ No newline at end of file diff --git a/misc/missing090field.pl b/misc/missing090field.pl deleted file mode 100755 index e0552e3e0b..0000000000 --- a/misc/missing090field.pl +++ /dev/null @@ -1,50 +0,0 @@ -#!/usr/bin/perl -# This script finds and fixes missing 090 fields in Koha for MARC21 -# Written by TG on 01/10/2005 -# Revised by Joshua Ferraro on 03/31/2006 -use strict; - -# Koha modules used - -use C4::Context; -use C4::Biblio; -use MARC::Record; -use MARC::File::USMARC; - - -my $dbh = C4::Context->dbh; - -my $sth=$dbh->prepare("select m.biblionumber,b.biblioitemnumber from marc_biblio m left join biblioitems b on b.biblionumber=m.biblionumber "); - $sth->execute(); - -while (my ($biblionumber,$biblioitemnumber)=$sth->fetchrow ){ - my $record = GetMarcBiblio($biblionumber); - - MARCmodbiblionumber($biblionumber,$biblioitemnumber,$record); - -} - -sub MARCmodbiblionumber{ -my ($biblionumber,$biblioitemnumber,$record)=@_; - -my ($tagfield,$biblionumtagsubfield) = &GetMarcFromKohaField("biblio.biblionumber",""); -my ($tagfield2,$biblioitemtagsubfield) = &GetMarcFromKohaField("biblio.biblioitemnumber",""); - -my $update=0; - my @tags = $record->field($tagfield); - -if (!@tags){ - -my $newrec = MARC::Field->new( $tagfield,'','', $biblionumtagsubfield => $biblionumber,$biblioitemtagsubfield=>$biblioitemnumber); - $record->append_fields($newrec); - $update=1; - } - - -if ($update){ -&ModBiblioMarc($record,'',$biblionumber); - print "$biblionumber \n"; - } - -} -END; diff --git a/misc/rebuildthesaurus.pl b/misc/rebuildthesaurus.pl deleted file mode 100644 index f2c7805433..0000000000 --- a/misc/rebuildthesaurus.pl +++ /dev/null @@ -1,88 +0,0 @@ -#!/usr/bin/perl -# script that rebuild thesaurus from biblio table. - -use strict; - -# Koha modules used -use MARC::File::USMARC; -use MARC::Record; -use MARC::Batch; -use C4::Context; -use C4::Biblio; -use C4::Authorities; -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 < will build authority file NP with value constructed with 700 field \$a, \$b, \$c & \$d subfields In UNIMARC this rebuild author authority file. - ./rebuildthesaurus.pl -c EDITORS -s "##210#c -- ##225#a" => will build authority for editor and collection. The EDITORS authority category is used with plugins for 210 & 225 in UNIMARC. -EOF -;# -die; -} - -my $dbh = C4::Context->dbh; -my @subf = $subfields =~ /(##\d\d\d##.)/g; -if ($delete) { - print "deleting thesaurus\n"; - my $sth = $dbh->prepare("delete from bibliothesaurus where category=?"); - $sth->execute($category); -} -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; -while (my ($bibid) = $sth->fetchrow) { - my $record = GetMarcBiblio($bibid); - print "."; - my $timeneeded = gettimeofday - $starttime; - print "$i in $timeneeded s\n" unless ($i % 50); - -# warn $record->as_formatted; - my $resultstring = $subfields; - foreach my $fieldwanted ($record->fields) { - next if $fieldwanted->tag()<=10; - foreach my $pair ( $fieldwanted->subfields() ) { - my $fieldvalue = $fieldwanted->tag(); -# warn "$fieldvalue ==> #$fieldvalue#$pair->[0]/$pair->[1]"; - $resultstring =~ s/##$fieldvalue##$pair->[0]/$pair->[1]/g; - } - } - # deals empty subfields - foreach my $empty (@subf) { - $resultstring =~ s/$empty//g; - } - if ($resultstring ne $subfields && $resultstring) { - &newauthority($dbh,$category,$resultstring); - } - $i++; -} -my $timeneeded = gettimeofday - $starttime; -print "$i entries done in $timeneeded seconds (".($i/$timeneeded)." per second)\n"; diff --git a/misc/safe-installer b/misc/safe-installer deleted file mode 100644 index 322640f95f..0000000000 --- a/misc/safe-installer +++ /dev/null @@ -1,948 +0,0 @@ -#!/usr/bin/perl -w - -# $Id$ - -# Copyright 2002 Katipo Communications -# -# This file is part of Koha. -# -# Koha is free software; you can redistribute it and/or modify it under the -# terms of the GNU General Public License as published by the Free Software -# Foundation; either version 2 of the License, or (at your option) any later -# version. -# -# Koha is distributed in the hope that it will be useful, but WITHOUT ANY -# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR -# A PARTICULAR PURPOSE. See the GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License along with -# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, -# Suite 330, Boston, MA 02111-1307 USA - -use strict; - -use vars qw( $answer $missing $status ); -use vars '@CLEANUP'; # A stack of references-to-code. When this script - # exits, whether normally or abnormally, each - # bit of cleanup code is run to clean up. See - # also &cleanup, below. -use vars '%CACHE'; # Cached values from the previous run, used to - # supply defaults when the user runs the installer - # a second time. -use vars '%PROG'; # This hash maps internal names for programs to - # their full pathnames, e.g. - # $PROG{"perl"} eq "/usr/local/bin/perl" -use vars '@PROG_DEF'; # This contains declarations saying which external - # programs the installer needs to find. -use vars qw($KOHA_CONF); - # Location of koha.conf file -use vars qw(%PERL_MODULES); - # Installed perl modules. Actually, these are - # only the optional modules, since the - # installer dies if it can't find one or more - # required modules. -use vars qw($DB_NAME $DB_HOST $DB_USER $DB_PASSWD); - # Database name, host, user, and password for - # accessing the Koha database. -use vars qw($MYSQL_ADMIN $MYSQL_PASSWD); - # MySQL administrator name and password. Used - # to create the database and give the Koha - # user privileges on the Koha database. -use vars qw($USE_VHOSTS); - # True iff we'll be using virtual hosts -use vars qw($OPAC_HOST @OPAC_REALHOSTS $INTRA_HOST @INTRA_REALHOSTS); - # Web hosts: $OPAC_HOST and $INTRA_HOST are - # the (virtual) hosts on which the OPAC and - # intranet reside. - # @OPAC_REALHOSTS and @INTRA_REALHOSTS list - # the real hosts on which the $OPAC_HOST and - # $INTRA_HOST (virtual) hosts reside. They are - # arrays because the user might spread the - # load among several real hosts. - -$SIG{'__DIE__'} = \&sig_DIE; # Clean up after we die -$SIG{'INT'} = \&sig_INT; # Clean up if ^C given - -$| = 1; # Flush output immediately, in case the - # user is piping this script or something. - -# XXX - Log everything that happens - -### Phase 1: Gather information - -# Warn the installer about potential nastiness, and give ver a chance -# to abort now. -$answer = &y_or_n(< "stty" ], - [ "chown" => "chown" ], - [ "chmod" => "chmod" ], - [ "perl" => "perl", "perl5" ], - [ "install" => "ginstall", "install" ], - [ "make" => "gmake", "make" ], - [ "mysql" => "mysql" ], - [ "mysqladmin" => "mysqladmin" ], - [ "mysqldump" => "mysqldump" ], -); - -# First, we try to find the programs automatically on the user's -# $PATH. Later, we'll give ver a chance to override any and all of -# these paths, but presumably the automatic search will be correct -# 90+% of the time, so this reduces erosion on the user's -# key. -foreach my $prog_def (@PROG_DEF) -{ - my $prog = shift @{$prog_def}; - my $fullpath; # Full path to program - - next if !defined($prog); - - printf "%-20s: ", $prog; - $fullpath = $CACHE{"prog_$prog"} || &find_program(@{$prog_def}); - if (!defined($fullpath)) - { - # Can't find this program - $missing = 1; - print "** Not found\n"; - next; - } - - $CACHE{"prog_$prog"} = - $PROG{$prog} = $fullpath; - print $fullpath, "\n"; -} - -if ($missing) -{ - # One or more programs were not found. We've already printed - # an error message about this above. - print < $DB_PASSWD - ); - -# Generate koha.conf -# XXX - Ask whether to use the same koha.conf file for the intranet -# and OPAC sites. -&write_conf("koha.conf.new", "koha.conf.in", - "db_passwd" => $DB_PASSWD - ); - -### XXX - Phase 3: Install files - -# XXX - Warn the user that the installation will reveal the DBA and -# Koha user's passwords (briefly) in the output of 'ps'. That for -# greater security, he should do things manually. -# XXX - Also perhaps set $ENV{MYSQL_PWD} - -# XXX - Actually, this should just use 'make ' to do stuff. - -# XXX - In each case, give user a chance to edit the file first. - -# XXX - Make sure to convert #! line before installing any scripts - -# XXX - When overwriting files, make sure to keep a backup - -# XXX - Installing/upgrading database: -# - Get MySQL admin username and password -# - Get database hostname -# - See if the database exists already. If not, create it. -# - See if koha user has rights on the database. If not, add them. - -# XXX - 'make install-db', if requested - -$answer = &y_or_n(<; # Slurp in the whole file - close F; - - if (defined(wantarray) && wantarray) - { - # Array context. Return a list of lines - for (@lines) - { - chomp; - } - return @lines; - } - - # Void or scalar context. Return the concatenation of the - # lines. - return join("", @lines); -} - -# load_cache -# Read the cache file, and store cached values in %CACHE. -# The format of the cache file is: -# -# Note: there is only one space between the variable and its value. -# This allows us to have values with whitespace in them. -# -# Blank lines are ignored. Any line that begins with "#" is a comment. -# The value may contain escape sequences of the form "\xAB", where -# "AB" is a pair of hex digits representing the ASCII value of the -# real character. -sub load_cache -{ - open CACHE, "< installer.cache" or do { - warn "Can't open cache file :$!"; - return; - }; - while () - { - my $var; - my $value; - - chomp; - next if /^\#/; # Ignore comments - next if /^\s*$/; # Ignore blank lines - - if (!/^(\w+)\s(.*)/) - { - warn "Bad line in cache file, line $.:\n$_\n"; - } - $var = $1; - $value = $2; - - # Unescape special characters - $value =~ s/\\x([0-9a-f]{2})/chr(hex($1))/ge; - - $CACHE{$var} = $value; - } - close CACHE; -} - -# _sanitize -# Utility function used by &save_cache: escapes suspicious-looking -# characters in a string, and returns the cleaned-up string. -sub _sanitize -{ - my $string = shift; - - $string =~ s{[^-\+\w\d \t.;/\{\}\@]}{sprintf("\\x%02x", ord($&))}ge; - return $string; -} - -# save_cache -# Save cacheable values to the cache file -sub save_cache -{ - my $var; # Variable name - my $value; # Variable value - - open CACHE, "> installer.cache" or do { - warn "Can't write to cache file: $!"; - return; - }; - # Write the keys. - while (($var, $value) = each %CACHE) - { - print CACHE "$var\t", &_sanitize($value), "\n"; - } - close CACHE; -} - -# find_program -# Find a program in $ENV{PATH}. Each argument is a variant name of the -# program to look for. That is, -# &find_program("bison", "yacc"); -# will first look for "bison", and if that's not found, will look for -# "yacc". -# Returns the full pathname if found, or undef otherwise. If the -# program appears in multiple path directories, returns the first one. -sub find_program -{ - my @path = split /:/, $ENV{"PATH"}; - - # The $prog loop is on the outside: if the caller calls - # &find_program("bison", "yacc"), that means that the caller - # would prefer to find "bison", but will settle for "yacc". - # Hence, we want to look for "bison" first. - foreach my $prog (@_) - { - foreach my $dir (@path) - { - # Make sure that what we've found is not only - # executable, but also a plain file - # (directories are also executable, you know). - if ( -f "$dir/$prog" && -x "$dir/$prog") - { - return "$dir/$prog"; - } - } - } - return undef; # Didn't find it -} - -# ask -# Ask the user a question, and return the result. -# If $default is undef, &ask will keep asking the question until it -# gets a nonempty answer. -# If $default is the empty string and the user just hits , -# &ask will return the empty string. -# The remaining arguments, if any, are the list of acceptable answers. -# &ask will keep asking the question until it gets one of the -# acceptable answers. If the list is empty, any answer will do. -# NOTE: the list of acceptable answers is not displayed to the user. -# You need to make them part of the question. -sub ask -{ - my $question = shift; # The question to ask - my $default = shift; # The return value if the user just hits - # - my @answers = @_; # The list of acceptable responses - my $answer; # The user's answer - - # Prettify whitespace at the end of the question. First, we - # remove the trailing newline that will have been left by - # <; - die "EOF on STDIN" if !defined($answer); - $answer =~ s/^\s+//gs; # Trim whitespace - $answer =~ s/\s+//gs; - - if ($answer eq "") - { - # The user just hit . See if that's okay - if (!defined($default)) - { - print "Sorry, you must give an answer.\n\n"; - redo; - } - - # There's a default. Use it. - $answer = $default; - last; - } else { - # The user gave an answer. See if it's okay. - - # If the caller didn't specify a list of - # acceptable answers, then all answers are - # okay. - last if $#answers < 0; - - # Make sure the answer is on the list - for (@answers) - { - last if $answer eq $_; - } - - print "Sorry, I don't understand that answer.\n\n"; - } - } - return $answer; -} - -# y_or_n -# Asks a yes-or-no question. If the user answers yes, returns true, -# otherwise returns false. -# The second argument, $default, is a boolean value. If not given, it -# defaults to true. -sub y_or_n -{ - my $question = shift; # The question to ask - my $default = shift; # Default answer - my $def_prompt; # The "(Y/n)" thingy at the end. - my $answer; - - $default = 1 unless defined($default); # True by default - - chomp $question; - $question .= " " unless $question =~ /\s$/s; - if ($default) - { - $question .= "(Y/n)"; - } else { - $question .= "(y/N)"; - } - - # Keep asking the question until we get an answer - while (1) - { - $answer = &ask($question, ""); - - return $default if $answer eq ""; - - if ($answer =~ /^y(es)?$/i) - { - return 1; - } elsif ($answer =~ /^no?$/) { - return 0; - } - - print "Please answer yes or no.\n\n"; - } -} - -# read_koha_conf -# Reads the specified Koha config file. Returns a reference-to-hash -# whose keys are the configuration variables, and whose values are the -# configuration values (duh). -# Returns undef in case of error. -# -# Stolen from C4/Context.pm, but I'd like this script to be standalone. -sub read_koha_conf -{ - my $fname = shift; # Config file to read - my $retval = {}; # Return value: ref-to-hash holding the - # configuration - - open (CONF, $fname) or return undef; - - while () - { - my $var; # Variable name - my $value; # Variable value - - chomp; - s/#.*//; # Strip comments - next if /^\s*$/; # Ignore blank lines - - # Look for a line of the form - # var = value - if (!/^\s*(\w+)\s*=\s*(.*?)\s*$/) - { - # FIXME - Complain about bogus line - next; - } - - # Found a variable assignment - # FIXME - Ought to complain is this line sets a - # variable that was already set. - $var = $1; - $value = $2; - $retval->{$var} = $value; - } - close CONF; - - return $retval; -} - -# write_conf -# Very similar to what autoconf does with Makefile.in --> Makefile. So -# similar, in fact, that it should be trivial to make this work with -# autoconf. -# -# &write_conf takes a file name and an optional template file, and -# generates the file by replacing all sequences of the form "@var@" in -# the template with $CACHE{var}. -# -# If the template file name is omitted, it defaults to the output -# file, with ".in" appended. -sub write_conf -{ - my $fname = shift; # Output file name - my $template = shift; # Template file name - my %extras = @_; # Additional key=>value pairs - - push @CLEANUP, sub { unlink $fname }; - # If we're interrupted while writing the - # output file, don't leave a partial one lying - # around - # Generate template file name - $template = $fname . ".in" unless defined $template; - - # Generate the output file - open TMPL, "< $template" or die "Can't open $template: $!"; - open OUT, "> $fname" or die "Can't write to $fname: $!"; - chmod 0600, $fname; # Restrictive permissions - while () - { - # Replace strings of the form "@var@" with the - # variable's value. Look first in %extras, then in - # %CACHE. Use the first one that's defined. If none of - # them are, use the empty string. - # We can't use - # $extras{$1} || $CACHE{$1} - # because "0" is a perfectly good substitution value, - # but would evaluate as false. And we need the empty - # string because if neither one is defined, the "perl - # -w" option would complain about us using an - # undefined value. - s{\@(\w+)\@} - { - if (defined($extras{$1})) - { - $extras{$1}; - } elsif (defined($CACHE{$1})) - { - $CACHE{$1}; - } else { - ""; - } - }ge; - print OUT; - } - close OUT; - close TMPL; - - pop @CLEANUP; -} - -# cleanup -# Clean up after the script when it dies. Pops each bit of cleanup -# code from @CLEANUP in turn and executes it. This way, the cleanup -# functions are called in the reverse of the order in which they were -# added. -sub cleanup -{ - my $code; - - while ($code = pop @CLEANUP) - { - eval &$code; - } -} - -# sig_DIE -# This is the $SIG{__DIE__} handler. It gets called when the script -# exits abnormally. It calls &cleanup to remove any temporary files -# and whatnot that may have been created. -sub sig_DIE -{ - my $msg = shift; # die() message. Not currently used - - return if !defined($^S); # Don't die before parsing is done - return if $^S; # Don't clean up if dying inside - # an eval - - &cleanup(); - - print STDERR "\n", $msg; - die <