Joshua Ferraro
17 years ago
25 changed files with 12509 additions and 11 deletions
File diff suppressed because it is too large
@ -0,0 +1,285 @@ |
|||
#!/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"; |
|||
@ -0,0 +1,362 @@ |
|||
#!/usr/bin/perl -w # please develop with -w |
|||
|
|||
# $Id$ |
|||
|
|||
# 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 diagnostics; |
|||
use strict; # please develop with the strict pragma |
|||
|
|||
system('clear'); |
|||
print qq| |
|||
******************************************* |
|||
* Welcome to the Koha Installation Guide * |
|||
******************************************* |
|||
|
|||
This installer will guide you through the process of installing Koha. |
|||
It is not a completely automated installation, but a guide for further |
|||
information please read the documentation or visit the Koha website at |
|||
http://www.koha.org |
|||
|
|||
To successfully use Koha you need some additional software: |
|||
|
|||
* A webserver (It was built to work with Apache, but there is no reason |
|||
it should not work with any other webserver). |
|||
|
|||
* Mysql (You could intead use postgres, or another sql based database) |
|||
|
|||
* Perl |
|||
|
|||
Are you ready to go through the installation process now? (Y/[N]): |
|||
|; |
|||
|
|||
my $answer = <STDIN>; |
|||
chomp $answer; |
|||
|
|||
if ($answer eq "Y" || $answer eq "y") { |
|||
print "Beginning setup... \n"; |
|||
} else { |
|||
print qq| |
|||
When you are ready to complete the installation just run this installer again. |
|||
|; |
|||
exit; |
|||
}; |
|||
|
|||
print "\n"; |
|||
|
|||
|
|||
# |
|||
# Test for Perl - Do we need to explicity check versions? |
|||
# |
|||
print "\nChecking that perl and the required modules are installed ...\n"; |
|||
unless (eval "require 5.004") { |
|||
die "Sorry, you need at least Perl 5.004\n"; |
|||
} |
|||
|
|||
# |
|||
# Test for Perl Dependancies |
|||
# |
|||
my @missing = (); |
|||
unless (eval require DBI) { push @missing,"DBI" }; |
|||
unless (eval require Date::Manip) { push @missing,"Date::Manip" }; |
|||
unless (eval require DBD::mysql) { push @missing,"DBD::mysql" }; |
|||
|
|||
# |
|||
# Print out a list of any missing modules |
|||
# |
|||
if (@missing > 0) { |
|||
print "\n\n"; |
|||
print "You are missing some Perl modules which are required by Koha.\n"; |
|||
print "Once these modules have been installed, rerun this installery.\n"; |
|||
print "They can be installed by running (as root) the following:\n"; |
|||
foreach my $module (@missing) { |
|||
print " perl -MCPAN -e 'install \"$module\"'\n"; |
|||
exit(1); |
|||
}} else{ |
|||
print "Perl and required modules appear to be installed, continuing...\n"; |
|||
}; |
|||
|
|||
|
|||
print "\n"; |
|||
|
|||
# |
|||
#KOHA conf |
|||
# |
|||
print qq| |
|||
Koha uses a small configuration file that is usually placed in your |
|||
/etc/ files directory (note: if you wish to place the koha.conf in |
|||
another location you will need to manually edit additional files). |
|||
|
|||
We will help you to now create your koha.conf file, once this file |
|||
has been created, please copy it to your destination folder |
|||
(note: this may need to be done by your systems administrator). |
|||
|; |
|||
|
|||
my $dbname; |
|||
my $hostname; |
|||
my $user; |
|||
my $pass; |
|||
my $inc_path; |
|||
|
|||
print "\n"; |
|||
print "\n"; |
|||
print qq| |
|||
Please provide the name of the mysql database that you wish to use |
|||
for koha. This is normally "Koha". |
|||
|; |
|||
|
|||
#Get the database name |
|||
do { |
|||
print "Enter database name:"; |
|||
chomp($dbname = <STDIN>); |
|||
}; |
|||
|
|||
|
|||
print "\n"; |
|||
print "\n"; |
|||
print qq| |
|||
Please provide the hostname for mysql. Unless the database is located |
|||
on another machine this is likely to be "localhost". |
|||
|; |
|||
|
|||
#Get the hostname for the database |
|||
do { |
|||
print "Enter hostname:"; |
|||
chomp($hostname = <STDIN>); |
|||
}; |
|||
|
|||
|
|||
print "\n"; |
|||
print "\n"; |
|||
print qq| |
|||
Please provide the name of the mysql user, who will have full administrative |
|||
rights to the $dbname database, when authenicating from $hostname. |
|||
It is recommended that you do not use your "root" user. |
|||
|; |
|||
|
|||
#Set the username for the database |
|||
do { |
|||
print "Enter username:"; |
|||
chomp($user = <STDIN>); |
|||
}; |
|||
|
|||
|
|||
print "\n"; |
|||
print "\n"; |
|||
print qq| |
|||
Please provide a password for the mysql user $user. |
|||
|; |
|||
|
|||
#Set the password for the database user |
|||
do { |
|||
print "Enter password:"; |
|||
chomp($pass = <STDIN>); |
|||
}; |
|||
|
|||
print "\n"; |
|||
print "\n"; |
|||
print qq| |
|||
Please provide the full path to your Koha Intranet/Librarians installation. |
|||
Usually /usr/local/www/koha/htdocs |
|||
|; |
|||
|
|||
#Get the password for the database user |
|||
do { |
|||
print "Enter installation path:"; |
|||
chomp($inc_path = <STDIN>); |
|||
}; |
|||
|
|||
|
|||
#Create the configuration file |
|||
open(SITES,">koha.conf") or die "Couldn't create file. |
|||
Must have write capability.\n"; |
|||
print SITES <<EOP |
|||
database=$dbname |
|||
hostname=$hostname |
|||
user=$user |
|||
password=$pass |
|||
includes=$inc_path/includes |
|||
EOP |
|||
; |
|||
close(SITES); |
|||
|
|||
print "Successfully created the Koha configuration file.\n"; |
|||
|
|||
print "\n"; |
|||
|
|||
# |
|||
#SETUP Virtual Host Directives |
|||
# |
|||
#OPAC Settings |
|||
# |
|||
my $opac_svr_admin; |
|||
my $opac_docu_root; |
|||
my $opac_svr_name; |
|||
|
|||
print qq| |
|||
You need to setup your Apache configuration file for the |
|||
OPAC virtual host. |
|||
|
|||
Please enter the servername for the OPAC interface. |
|||
Usually opac.your.domain |
|||
|; |
|||
do { |
|||
print "Enter servername address:"; |
|||
chomp($opac_svr_name = <STDIN>); |
|||
}; |
|||
|
|||
|
|||
print qq| |
|||
Please enter the e-mail address for your webserver admin. |
|||
Usually webmaster\@your.domain |
|||
|; |
|||
do { |
|||
print "Enter e-mail address:"; |
|||
chomp($opac_svr_admin = <STDIN>); |
|||
}; |
|||
|
|||
|
|||
print qq| |
|||
Please enter the full path to your OPAC\'s document root. |
|||
usually something like \"/usr/local/www/opac/htdocs\". |
|||
|; |
|||
do { |
|||
print "Enter Document Roots Path:"; |
|||
chomp($opac_docu_root = <STDIN>); |
|||
}; |
|||
|
|||
|
|||
# |
|||
# Update Apache Conf File. |
|||
# |
|||
open(SITES,">>koha-apache.conf") or die "Couldn't write to file. |
|||
Must have write capability.\n"; |
|||
print SITES <<EOP |
|||
|
|||
<VirtualHost $opac_svr_name> |
|||
ServerAdmin $opac_svr_admin |
|||
DocumentRoot $opac_docu_root |
|||
ServerName $opac_svr_name |
|||
ErrorLog logs/opac-error_log |
|||
TransferLog logs/opac-access_log common |
|||
</VirtualHost> |
|||
|
|||
EOP |
|||
; |
|||
close(SITES); |
|||
|
|||
|
|||
# |
|||
#Intranet Settings |
|||
# |
|||
my $intranet_svr_admin; |
|||
my $intranet_svr_name; |
|||
|
|||
print qq| |
|||
You need to setup your Apache configuration file for the |
|||
Intranet/librarian virtual host. |
|||
|
|||
Please enter the servername for your Intranet/Librarian interface. |
|||
Usually koha.your.domain |
|||
|; |
|||
do { |
|||
print "Enter servername address:"; |
|||
chomp($intranet_svr_name = <STDIN>); |
|||
}; |
|||
|
|||
|
|||
print qq| |
|||
Please enter the e-mail address for your webserver admin. |
|||
Usually webmaster\@your.domain |
|||
|; |
|||
do { |
|||
print "Enter e-mail address:"; |
|||
chomp($intranet_svr_admin = <STDIN>); |
|||
}; |
|||
|
|||
|
|||
|
|||
# |
|||
# Update Apache Conf File. |
|||
# |
|||
open(SITES,">>koha-apache.conf") or die "Couldn't write to file. |
|||
Must have write capability.\n"; |
|||
print SITES <<EOP |
|||
|
|||
<VirtualHost $intranet_svr_name> |
|||
ServerAdmin $intranet_svr_admin |
|||
DocumentRoot $inc_path |
|||
ServerName $intranet_svr_name |
|||
ErrorLog logs/opac-error_log |
|||
TransferLog logs/opac-access_log common |
|||
</VirtualHost> |
|||
|
|||
EOP |
|||
; |
|||
close(SITES); |
|||
|
|||
|
|||
print "Successfully created the Apache Virtual Host Configuration file.\n"; |
|||
|
|||
system('clear'); |
|||
print qq| |
|||
******************************************* |
|||
* Koha Installation Guide - Continued * |
|||
******************************************* |
|||
|
|||
In order to finish the installation of Koha, there is still a couple |
|||
of steps that you will need to complete. |
|||
|
|||
* Setup mysql |
|||
1. Create a new mysql database called for example Koha |
|||
From command line: mysqladmin -uroot -ppassword create Koha |
|||
|
|||
2. Set up a koha user and password in mysql |
|||
Log in to mysql: mysql -uroot -ppassword |
|||
|
|||
To create a user called "koha" who has full administrative |
|||
rights to the "Koha" database when authenticating from |
|||
"localhost", enter the following on mysql command line: |
|||
|
|||
grant all privileges on Koha.* to koha\@localhost identified by 'kohapassword'\; |
|||
|
|||
Press ENTER, and if you see no errors then enter \q to quit mysql. |
|||
|
|||
|
|||
3. Use the mysql script to create the tables |
|||
mysql -uusername -ppassword Koha < koha.mysql |
|||
|
|||
4. Update your database tables |
|||
perl updatedatabase -I /pathtoC4 |
|||
|
|||
5. Update your database to use MARC |
|||
perl marc/fill_usmarc.pl -I /pathtoC4 to put MARC21 - english datas in parameter table |
|||
perl marc/updatedb2marc.pl -I /pathtoC4 to update biblios from old-DB to MARC-DB (!!! it may be long : 30 biblios/second) |
|||
|
|||
* Koha.conf |
|||
1. Copy Koha.conf to /etc/ |
|||
If you wish to locate the file in another location please read |
|||
the INSTALL and Hints files. |
|||
|
|||
|
|||
|; |
|||
# |
|||
# It is completed |
|||
# |
|||
print "\nCongratulations ... your Koha installation is complete!\n"; |
|||
print "\nYou will need to restart your webserver before using Koha!\n"; |
|||
@ -0,0 +1,141 @@ |
|||
#!/usr/bin/perl -w # please develop with -w |
|||
|
|||
#use diagnostics; |
|||
|
|||
use Install; |
|||
use Getopt::Long; |
|||
|
|||
use strict; # please develop with the strict pragma |
|||
|
|||
use vars qw( $input ); |
|||
|
|||
Install::setlanguage 'en'; |
|||
|
|||
my $domainname = `hostname`; # Note: must not have any arguments (portability) |
|||
if ($domainname =~ /^[^\s\.]+\.([-a-z0-9\.]+)$/) { |
|||
$domainname = $1; |
|||
} else { |
|||
undef $domainname; |
|||
if (open(INPUT, "</etc/resolv.conf")) { |
|||
while (<INPUT>) { |
|||
$domainname = $1 if /^domain\s+([-a-z0-9\.]+)\s*$/i; |
|||
last if defined $domainname; |
|||
} |
|||
close INPUT; |
|||
} |
|||
elsif (open(INPUT, "</etc/hostname")) { |
|||
$domainname = <INPUT>; |
|||
} |
|||
} |
|||
Install::setdomainname $domainname; |
|||
|
|||
############################################### |
|||
# SET THE etcdir ENVIRONMENT VAR INSTEAD # |
|||
############################################### |
|||
my $etcdir = $ENV{etcdir}||'/etc'; |
|||
system("mkdir -p $etcdir"); |
|||
|
|||
my ($auto_install_file,$auto_install); |
|||
GetOptions( |
|||
'i:s' => \$auto_install_file, |
|||
); |
|||
$auto_install = read_autoinstall_file($auto_install_file) if $auto_install_file; |
|||
|
|||
Install::setetcdir $etcdir; |
|||
|
|||
unless (-d 'intranet-html') { |
|||
print <<EOP; |
|||
You seem to be installing from CVS. Please run the "buildrelease" script |
|||
and install from the resulting release tarball. |
|||
EOP |
|||
exit 1; |
|||
} |
|||
|
|||
my $kohaversion=`cat koha.version`; |
|||
chomp $kohaversion; |
|||
Install::setkohaversion $kohaversion; |
|||
|
|||
|
|||
if ($kohaversion =~ /RC/) { |
|||
releasecandidatewarning(); |
|||
} |
|||
|
|||
checkabortedinstall(); |
|||
|
|||
if (-e "$etcdir/koha.conf") { |
|||
my $installedversion=`grep kohaversion= "$etcdir/koha.conf"`; |
|||
chomp $installedversion; |
|||
$installedversion=~m/kohaversion=(.*)/; |
|||
$installedversion=$1; |
|||
my $installedversionmsg; |
|||
if ($installedversion) { |
|||
$installedversionmsg=getmessage('KohaVersionInstalled', [$installedversion]); |
|||
} else { |
|||
$installedversionmsg=getmessage('KohaUnknownVersionInstalled'); |
|||
} |
|||
|
|||
my $message=getmessage('KohaAlreadyInstalled', [$etcdir, $kohaversion, $installedversionmsg]); |
|||
showmessage($message, 'none'); |
|||
exit; |
|||
} |
|||
|
|||
my $continuingmsg=getmessage('continuing'); |
|||
|
|||
my $message=getmessage('WelcomeToKohaInstaller'); |
|||
my $answer=showmessage($message, 'yn'); |
|||
|
|||
if ($answer eq "Y" || $answer eq "y") { |
|||
print $continuingmsg; |
|||
} else { |
|||
print qq| |
|||
This installer currently does not support a completely automated |
|||
setup. |
|||
|
|||
Please be sure to read the documentation, or visit the Koha website |
|||
at http://www.koha.org for more information. |
|||
|; |
|||
exit; |
|||
}; |
|||
|
|||
# Check for missing Perl Modules |
|||
checkperlmodules($auto_install); |
|||
|
|||
# Ask for installation directories |
|||
getapacheinfo($auto_install); |
|||
|
|||
getinstallationdirectories($auto_install); |
|||
|
|||
getdatabaseinfo($auto_install); |
|||
|
|||
getapachevhostinfo($auto_install); |
|||
|
|||
updateapacheconf($auto_install); |
|||
|
|||
# basicauthentication(); |
|||
|
|||
installfiles(1,$auto_install); |
|||
|
|||
backupmycnf(); |
|||
|
|||
databasesetup($auto_install); |
|||
|
|||
updatedatabase($auto_install); |
|||
|
|||
populatedatabase($auto_install); |
|||
|
|||
restoremycnf(); |
|||
|
|||
finalizeconfigfile(); |
|||
|
|||
restartapache($auto_install); |
|||
|
|||
showmessage(getmessage('AuthenticationWarning', [$etcdir]), 'PressEnter') unless ($auto_install->{NoPressEnter}); |
|||
|
|||
showmessage(getmessage('Completed', [ Install::getservername(), Install::getintranetport(), Install::getservername(), Install::getopacport()]), 'PressEnter'); |
|||
|
|||
if (-f "kohareporter") { |
|||
my $reply=showmessage('Would you like to complete a survey about your library?', 'yn', 'y'); |
|||
if ($reply=~/y/i) { |
|||
system("perl kohareporter"); |
|||
} |
|||
} |
|||
@ -0,0 +1,4 @@ |
|||
database=koha |
|||
hostname=localhost |
|||
user=Koha |
|||
pass=password |
|||
File diff suppressed because it is too large
File diff suppressed because it is too large
@ -0,0 +1,140 @@ |
|||
#!/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; |
|||
@ -0,0 +1,86 @@ |
|||
#!/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); |
|||
} |
|||
@ -0,0 +1,50 @@ |
|||
#!/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; |
|||
@ -0,0 +1,88 @@ |
|||
#!/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"; |
|||
@ -0,0 +1,948 @@ |
|||
#!/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; |
|||
} |
|||
|
|||
File diff suppressed because it is too large
@ -0,0 +1,45 @@ |
|||
#!/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"); |
|||
Loading…
Reference in new issue