Koha-community/Koha
13
7
Fork 0
Code Issues Releases Wiki Activity

More uneeded files, Patch from Paul

Browse source
This commit is contained in:
Chris Cormack 2007-08-08 11:01:30 -05:00
parent 7963dd2d53
commit ef0bf37726
9 changed files with 0 additions and 3950 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

285
misc/barcodes.pl
View file

@ -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";

4
misc/koha.conf
View file

@ -1,4 +0,0 @@
database=koha
hostname=localhost
user=Koha
pass=password

140
misc/marc_into_authority.pl
View file

@ -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;

86
misc/marcimport_to_biblioitems.pl
View file

@ -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 <<EOF
small script to import an iso2709 file into Koha with existing biblionumbers in marc record.
parameters :
\th : this version/help screen
\tfile /path/to/file/to/dump : the file to dump
SAMPLE :
\t\$ export KOHA_CONF=/etc/koha.conf
\t\$ perl misc/marcimport_to_biblioitems.pl -file /home/jmf/koha.mrc
EOF
;#'
die;
}
my $starttime = gettimeofday;
my $timeneeded;
my $dbh = C4::Context->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);
}

50
misc/missing090field.pl
View file

@ -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;

88
misc/rebuildthesaurus.pl
View file

@ -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 <<EOF
small script to recreate a authority table into Koha.
parameters :
\th : this version/help screen
\tc : thesaurus category
\tv : verbose mode.
\tt : test mode : parses the file, saying what he would do, but doing nothing.
\ts : the subfields
\d : delete every entry of the selected category before doing work.
SAMPLES :
./rebuildthesaurus.pl -c NP -s "##700#a, ##700#b (##700#c ; ##700#d)" => 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";

948
misc/safe-installer
View file

@ -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(<<EOT, 1);
WARNING WARNING WARNING WARNING
This is an unstable version of Koha, blah blah blah unhappiness
blah blah nuclear war blah blah spouse will leave you blah blah
Are you sure you want to continue?
EOT
if (!$answer)
{
exit 0;
}
# XXX - Make sure we're in the right directory. Look for a few
# required files ("koha.mysql" seems like a good candidate). If they
# don't exist, try 'cd `dirname $0`' and try again.
# See if there's a cache file, and load it if the user'll allow us
if ( -f "installer.cache" )
{
$answer = &y_or_n(<<EOT, 1);
There appears to be a cache file left over from a previous
run of $0. Do you wish to reuse this information?
EOT
&load_cache if $answer;
}
# Figure out a default location for koha.conf. First, try the location
# specified in the previous run, then the value of the $KOHA_CONF
# environment variable (hey, it might be set), and finally
# /etc/koha.conf.
$KOHA_CONF = $CACHE{"koha_conf"} ||
$ENV{"KOHA_CONF"} ||
"/etc/koha.conf";
$CACHE{"koha_conf"} = $KOHA_CONF;
# If there's a /etc/koha.conf, ask whether the user wants installer to
# read it for hints.
if ( -r $KOHA_CONF)
{
$answer = &y_or_n(<<EOT, defined($CACHE{"hints_from_old_koha_conf"}) ? $CACHE{"hints_from_old_koha_conf"} : 1);
You already have a $KOHA_CONF file.
Shall I read it to get hints as to where to install Koha?
EOT
$CACHE{"hints_from_old_koha_conf"} = $answer;
if ($answer)
{
my $old_koha_conf;
$old_koha_conf = &read_koha_conf($CACHE{"koha_conf"});
# Read the existing config file
# Slurp the old config values into %CACHE, with a
# "conf_" prefix.
while (my ($key, $value) = each %{$old_koha_conf})
{
$CACHE{"conf_$key"} = $value;
}
}
# XXX - Ask whether the user wants a backup of the existing
# database.
}
delete $CACHE{"conf_pass"}; # Don't cache any passwords
print "\n* Looking for common programs.\n\n";
# Define the list of external programs we need to find
@PROG_DEF = (
# The bit on the left is the program as we'll refer to it
# internally, usually something like $PROG{"perl"}. On the
# right is the list of names under which it might be
# installed.
[ "stty" => "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 <return>
# 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 <<EOT;
WARNING:
Some programs could not be found.
EOT
} else {
# Ask the user
$answer = &y_or_n("Does this look okay?", 1);
$missing = 1 if !$answer;
}
if ($missing)
{
# Either some program could not be found, or else the user
# didn't like the paths. Either way, go through the list and
# ask.
foreach my $prog_def (@PROG_DEF)
{
my $prog = shift @{$prog_def};
my $fullpath; # Full path to program
$fullpath = &ask(<<EOT, $PROG{$prog});
Please enter the full pathname to $prog:
EOT
$CACHE{"prog_$prog"} = $fullpath;
}
}
# Check for required Perl modules
# XXX - Perhaps should cache $PERL5LIB as well
print "\nChecking for required Perl modules.\n";
$missing = 0;
# DBI
printf "%-20s: ", "DBI...";
if (eval { require DBI; })
{
print "Found\n";
} else {
print "Not found\n";
$missing = 1;
}
# DBD::mysql
printf "%-20s: ", "DBD::mysql...";
if (eval { require DBD::mysql; })
{
print "Found\n";
} else {
print "Not found\n";
$missing = 1;
}
# Date::Manip
printf "%-20s: ", "Date::Manip...";
if (eval { require Date::Manip; })
{
print "Found\n";
} else {
print "Not found\n";
$missing = 1;
}
if ($missing)
{
print <<EOT;
One or more required Perl modules appear to be missing. Please install
them, then run $0 again.
EOT
exit 1;
}
print "\nChecking for optional Perl modules.\n";
$missing = 0;
# Net::Z3950
printf "%-20s: ", "Net::Z3950...";
if (eval { require Net::Z3950; })
{
print "Found\n";
$PERL_MODULES{"Net::Z3950"} = 1;
} else {
print "Not found\n";
$missing = 1;
}
if ($missing)
{
print <<EOT;
One or more optional Perl modules appear to be missing. Koha may still
be installed, but some optional features may not be enabled.
EOT
$answer = &y_or_n(<<EOT, 0);
Do you wish to abort the installation?
EOT
}
print "\n* Configuring database\n";
# Get the database administrator's name
$MYSQL_ADMIN = &ask(<<EOT, $CACHE{"dba_user"});
Please enter the MySQL database administrator's name:
EOT
#'
$CACHE{"dba_user"} = $MYSQL_ADMIN;
# Get the database administrator's password
# This is NOT cached
push @CLEANUP, sub { system $PROG{"stty"}, "echo"; };
# Restore screen echo if we get interrupted
system $PROG{"stty"}, "-echo"; # Turn off screen echo
$MYSQL_PASSWD = &ask(<<EOT, "");
Please enter the MySQL database administrator's password. This will
not be written to any file, and is optional. If you leave this blank,
you will be prompted for it every time it is needed, in the
installation phase.
Database administrator password:
EOT
#'
system $PROG{"stty"}, "echo"; # Turn screen echo back on
print "\n"; # The user's \n, which wasn't displayed
# Get the database name
$DB_NAME = &ask(<<EOT, $CACHE{"db_name"} || $CACHE{"conf_database"});
Please enter the name of the Koha database:
EOT
$CACHE{"db_name"} = $DB_NAME;
# Get database host
$DB_HOST = &ask(<<EOT, $CACHE{"db_host"} || $CACHE{"conf_hostname"});
Please enter the hostname or IP address of the host on which the
database should be installed:
EOT
$CACHE{"db_host"} = $DB_HOST;
# Get the name of the Koha (database) user
$DB_USER = &ask(<<EOT, $CACHE{"db_user"} || $CACHE{"conf_user"});
Please enter the name of the Koha user:
EOT
$CACHE{"db_user"} = $DB_USER;
# Get the Koha database password
# The Koha password is not cached, since the installer cache file is
# world-readable (unless the user has an unusually restrictive umask,
# but we can't assume that).
# XXX - Actually, we might need up to three passwords: one for the
# intranet, one for the OPAC, and one for the database server. Or
# perhaps we need two or three Koha users; the point is to minimize
# the amount of damage that can be wrought if someone breaks in to a
# web or database server.
#
# The OPAC Koha user should be allowed to read anything, and update a
# few limited tables, like session IDs and suchlike, but should on no
# account be permitted to modify the catalogue.
#
# The intranet Koha user should have permission to read everything and
# write all sorts of things, including the catalogue, but should not
# be allowed to drop tables or do anything destructive to the database
# itself.
#
# The maintenance user should be allowed to do everything. Then again,
# perhaps the maintenance user can be installed manually by a clueful
# DBA.
system $PROG{"stty"}, "-echo"; # Turn off screen echo
$DB_PASSWD = &ask(<<EOT, $CACHE{"conf_pass"});
Please enter the Koha user's password:
EOT
#'
system $PROG{"stty"}, "echo"; # Turn screen echo back on
print "\n"; # The user's \n, which wasn't displayed
# XXX - Ask whether to install sample data. Default to no, especially
# if the user requested a backup, earlier.
# XXX - Ask whether to restore the database from a backup. Should take
# a glob pattern, and read each file in turn. Should default to the
# backup we made earlier.
print "\n* Web site configuration.\n";
# XXX - Get information about how to set up the web servers.
# Specifically:
# - Will you be using virtual hosts?
# - OPAC virtual host name?
# - OPAC real host name?
# Need to grant read-only authorization to Koha user
# from the real OPAC host. Perhaps have different
# passwords for intranet and OPAC access.
# - Intranet virtual host name?
# - Intranet real host name?
# Need to grant all access to Koha user from the real
# intranet host. Perhaps have different passwords for
# intranet and OPAC access.
# - Is the database server also running a web server?
# If so, then need to grant OPAC or intranet access to
# the database from "localhost".
# XXX - Try to guess this from $CACHE{conf_*}
# XXX - Ask whether one machine will be both the only OPAC server and
# the only intranet server. If yes, then a) we need to use virtual
# hosts (for now), and b) we probably want to use the same koha.conf
# file for both.
$USE_VHOSTS = &y_or_n(<<EOT, $CACHE{"use_vhosts"} || 1);
Will you be using virtual hosts for either the OPAC or intranet
site?
EOT
$CACHE{"use_vhosts"} = $USE_VHOSTS;
$OPAC_HOST = &ask(<<EOT, $CACHE{"opac_host"});
What is the externally-visible name of the host on which the OPAC web
site will reside?
EOT
$CACHE{"opac_host"} = $OPAC_HOST;
if ($USE_VHOSTS)
{
# XXX - Prompt for list of real hosts
@OPAC_REALHOSTS = ($OPAC_HOST); # XXX - Just temporary
} else {
@OPAC_REALHOSTS = ($OPAC_HOST);
}
$CACHE{"opac_realhosts"} = join(" ", @OPAC_REALHOSTS);
#$INSTALL_OPAC = &y_or_n("Do you wish to install the OPAC web site?", 1);
## XXX - Gather OPAC information
#$INSTALL_INTRANET = &y_or_n("Do you wish to install the intranet web site?",
# 1);
## XXX - Gather intranet information
# XXX - Get apache.conf file
# XXX - Find out where to install
# - OPAC HTML files
# - OPAC cgi-bin files
# - Intranet HTML files
# - Intranet cgi-bin files
# XXX - Try to guess this from $CACHE{conf_*}
# XXX - Get the user and group that should own these files. Try to
# guess this from the "User" and "Group" lines in apache.conf. If the
# user is found but the group isn't, use getgr*() and use the first
# group found there. In any case, ask the user to confirm.
# XXX - Get root URLs:
# - OPAC HTML
# - OPAC cgi-bin
# - Intranet HTML
# - Intranet cgi-bin
# XXX - Try to guess this from $CACHE{conf_*}
&save_cache; # Write the cache file for future use
### XXX - Phase 2: Generate config files
# XXX - Generate sample apache.conf section for OPAC and internal
# virtual hosts.
# Generate the configuration file that will be used by 'make'
&write_conf("Make.conf", undef,
"db_passwd" => $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 <whatever>' 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(<<EOT, 1);
Would you like to create the Koha database now?
EOT
if ($answer)
{
$status = system $PROG{"make"}, "install-db";
if ($status != 0)
{
print <<EOT;
*** Error
The database installation appears to have failed. Please read any
error messages that may have been reported above, correct them, and
try again.
EOT
if (&y_or_n(<<EOT, 1))
Do you wish to abort the installation?
EOT
{
print "Exiting.\n";
&cleanup;
exit 1;
}
}
} else {
print <<EOT;
When you are ready, you can install the database by running
make install-db
EOT
}
&cleanup; # Clean up before exiting
########################################
# Utility functions
# readfile
# Read the contents of a file and return them. This is basically
# /bin/cat.
# In a scalar context, returns a string with the contents of the file.
# In array context, returns an array containing the chomp()ed strings
# comprising the file.
#
# Thus, if you just want to read the chomp()ed first line of a file,
# you can
# ($line) = &readfile("/my/file");
sub readfile
{
my $fname = shift;
my @lines;
open F, "< $fname" or die "Can't open $fname: $!";
@lines = <F>; # 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:
# <variable><space><value>
# 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 (<CACHE>)
{
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 <return>,
# &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
# <return>
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
# <<EOT. Then we add a blank if there isn't any whitespace at
# the end of the question, simply because it looks prettier
# that way.
chomp $question;
$question .= " " unless $question =~ /\s$/;
while (1)
{
# Print the question and the default answer, if any
print $question;
if (defined($default) && $default ne "")
{
print "[$default] ";
}
# Read the answer
$answer = <STDIN>;
die "EOF on STDIN" if !defined($answer);
$answer =~ s/^\s+//gs; # Trim whitespace
$answer =~ s/\s+//gs;
if ($answer eq "")
{
# The user just hit <return>. 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 (<CONF>)
{
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 (<TMPL>)
{
# 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 <<EOT;
*** FAILURE ***
The installer has failed. Please check any error messages that
may have been printed above, correct the problem(s), and try again.
EOT
}
# sig_INT
# SIGINT handler. Clean up and exit if the user cancels with ^C.
sub sig_INT
{
&cleanup();
print STDERR <<EOT;
*** CANCELLED ***
Configuration cancelled.
EOT
exit 1;
}

2304
misc/sampledata-1.2
View file

File diff suppressed because it is too large Load diff

45
misc/tidyaccounts.pl
View file

@ -1,45 +0,0 @@
#!/usr/bin/perl
#
# written 31/5/00 by chris@katipo.co.nz to make a way to fix account mistakes
#
# 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
use strict;
use CGI;
use C4::Accounts;
my $input=new CGI;
#print $input->header();
#print $input->dump;
my $borrowernumber=$input->param('borrowernumber');
my @name=$input->param;
foreach my $key (@name){
if ($key ne 'borrowernumber'){
if (my $temp=$input->param($key)){
fixaccounts($borrowernumber,$key,$temp);
}
}
}
print $input->redirect("boraccount.pl?borrowernumber=$borrowernumber");