--- /dev/null
+#!/usr/bin/perl
+# small script that dumps an iso2709 file.
+
+
+use strict;
+BEGIN {
+ # find Koha's Perl modules
+ # test carefully before changing this
+ use FindBin;
+ eval { require "$FindBin::Bin/kohalib.pl" };
+}
+
+# Koha modules used
+use C4::Context;
+use MARC::File::USMARC;
+use MARC::Record;
+use MARC::Batch;
+
+use Getopt::Long;
+my ( $input_marc_file,$number,$nowarning,$frameworkcode) = ('',0);
+my $version;
+GetOptions(
+ 'file:s' => \$input_marc_file,
+ 'n:s' => \$number,
+ 'v' => \$version,
+ 'w' => \$nowarning,
+ 'c' => \$frameworkcode,
+);
+
+$frameworkcode="" unless $frameworkcode;
+
+if ($version || ($input_marc_file eq '')) {
+ print <<EOF
+This script compares an iso2709 file and Koha's MARC frameworks
+It will show the marc fields/subfields used in Koha, and that
+are not in the iso2709 file and which fields/subfields that are
+used in the iso2709 file and not in Koha.
+
+parameters :
+\tv : this version/help screen
+\tfile /path/to/file/to/dump : the file to dump
+\tw : warning and strict off. If your dump fails, try -w option. It it works, then, the file is iso2709, but a buggy one !
+\tc : the frameworkcode. If omitted, set to ""
+
+SAMPLE : ./compare_iso_and_marc_parameters.pl -file /home/paul/koha.dev/local/npl -n 1
+
+EOF
+;
+die;
+}#/
+
+my $batch = MARC::Batch->new( 'USMARC', $input_marc_file );
+$batch->warnings_off() unless $nowarning;
+$batch->strict_off() unless $nowarning;
+my $dbh=C4::Context->dbh;
+my $sth = $dbh->prepare("select tagfield,tagsubfield,tab from marc_subfield_structure where frameworkcode=?");
+$sth->execute($frameworkcode);
+
+my %hash_unused;
+my %hash_used;
+while (my ($tagfield,$tagsubfield,$tab) = $sth->fetchrow) {
+ $hash_unused{"$tagfield$tagsubfield"} = 1 if ($tab eq -1);
+ $hash_used{"$tagfield$tagsubfield"} = 1 if ($tab ne -1);
+}
+my $i=0;
+while ( my $record = $batch->next() ) {
+ $i++;
+ foreach my $MARCfield ($record->fields()) {
+ next if $MARCfield->tag()<=010;
+ if ($MARCfield) {
+ foreach my $fields ($MARCfield->subfields()) {
+ if ($fields) {
+ if ($hash_unused{$MARCfield->tag().@$fields[0]}>=1) {
+ $hash_unused{$MARCfield->tag().@$fields[0]}++;
+ }
+ if ($hash_used{$MARCfield->tag().@$fields[0]}>=1) {
+ $hash_used{$MARCfield->tag().@$fields[0]}++;
+ }
+ }
+ # foreach my $field (@$fields) {
+ # warn "==>".$MARCfield->tag().@$fields[0];
+ # }
+ }
+ }
+ }
+}
+print "Undeclared tag/subfields that exists in the file\n";
+print "================================================\n";
+foreach my $key (sort keys %hash_unused) {
+ print "$key => ".($hash_unused{$key}-1)."\n" unless ($hash_unused{$key}==1);
+}
+
+print "Declared tag/subfields unused in the iso2709 file\n";
+print "=================================================\n";
+foreach my $key (sort keys %hash_used) {
+ print "$key => ".($hash_used{$key}-1)."\n" if ($hash_used{$key}==1);
+}
+
+# foreach my $x (sort keys %resB) {
+# print "$x => ".$resB{$x}."\n";
+# }
+print "\n==================\n$i record parsed\n";
--- /dev/null
+#!/usr/bin/perl
+# small script that rebuilds the non-MARC DB
+
+use strict;
+BEGIN {
+ # find Koha's Perl modules
+ # test carefully before changing this
+ use FindBin;
+ eval { require "$FindBin::Bin/kohalib.pl" };
+}
+
+# Koha modules used
+# use MARC::File::USMARC;
+use MARC::Record;
+use MARC::Batch;
+use C4::Context;
+use C4::Biblio;
+use Time::HiRes qw(gettimeofday);
+
+use Getopt::Long;
+my ( $input_marc_file, $number) = ('',0);
+my ($version, $confirm,$test_parameter);
+GetOptions(
+ 'c' => \$confirm,
+ 'h' => \$version,
+ 't' => \$test_parameter,
+);
+
+if ($version || (!$confirm)) {
+ print <<EOF
+This script cleans unused subfields in the MARC DB.
+If you alter the MARC parameters and remove a subfield (ie : move it to ignore (10) tab), existing subfields are NOT removed.
+It's not a bug, it prevents deleting useful values in case of erroneous move.
+This script definetly remove unused subfields in the MARC DB.
+syntax :
+\t./cleanmarcdb.pl -h (or without arguments => shows this screen)
+\t./cleanmarcdb.pl -c (c like confirm => cleans the marc DB (may be long)
+\t-t => test only, change nothing in DB
+EOF
+;#'
+die;
+}
+
+my $dbh = C4::Context->dbh;
+my $i=0;
+my $starttime = gettimeofday;
+my $cleansubfield = $dbh->prepare("delete from marc_subfield_table where tag=? and subfieldcode=?");
+my $cleanword = $dbh->prepare("delete from marc_word where tag=? and subfieldid=?");
+
+# get tags structure
+my $tags = GetMarcStructure(1);
+foreach my $tag (sort keys(%{$tags})) {
+ foreach my $subfield (sort keys(%{$tags->{$tag}})) {
+ next if $subfield eq "lib";
+ next if $subfield eq "mandatory";
+ next if $subfield eq "tab";
+ # DO NOT drop biblionumber, biblioitemnumber and itemnumber.
+ # they are stored internally, and are mapped to tab -1. This script must keep them or it will completly break Koha DB !!!
+ next if ($tags->{$tag}->{$subfield}->{kohafield} eq "biblio.biblionumber");
+ next if ($tags->{$tag}->{$subfield}->{kohafield} eq "biblioitems.biblioitemnumber");
+ next if ($tags->{$tag}->{$subfield}->{kohafield} eq "items.itemnumber");
+ # now, test => if field is ignored (in tab -1 or '') => drop everything in the MARC table !
+ if ($tags->{$tag}->{$subfield}->{tab} eq -1 || $tags->{$tag}->{$subfield}->{tab} eq '') {
+ print "dropping $tag \$ $subfield\n";
+ $cleansubfield->execute($tag,$subfield) unless $test_parameter;
+ $cleanword->execute($tag,$subfield) unless $test_parameter;
+ print "TEST " if $test_parameter;
+ print "done\n";
+ }
+ }
+}
+my $timeneeded = gettimeofday - $starttime;
+print "done in $timeneeded seconds\n";
--- /dev/null
+#!/usr/bin/perl
+# load records that already have biblionumber set into a koha system
+# Written by TG on 10/04/2006
+use strict;
+BEGIN {
+ # find Koha's Perl modules
+ # test carefully before changing this
+ use FindBin;
+ eval { require "$FindBin::Bin/kohalib.pl" };
+}
+
+# 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
+If your ISO2709 file already has biblionumbers, you can use this script
+to import the MARC into your database.
+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 $batch = MARC::Batch->new( 'USMARC', $input_marc_file );
+$batch->warnings_off();
+$batch->strict_off();
+my ($tagfield,$biblionumtagsubfield) = &GetMarcFromKohaField("biblio.biblionumber","");
+
+my $i=0;
+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;
+# IS THIS SUPPOSED TO BE __END__ ?? If not, then what is it? --JBA
+
+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);
+}
--- /dev/null
+#!/usr/bin/perl
+# small script that rebuilds the non-MARC DB
+
+use strict;
+BEGIN {
+ # find Koha's Perl modules
+ # test carefully before changing this
+ use FindBin;
+ eval { require "$FindBin::Bin/kohalib.pl" };
+}
+
+# Koha modules used
+# use MARC::File::USMARC;
+use MARC::Record;
+use MARC::Batch;
+use C4::Context;
+use C4::Biblio;
+use Time::HiRes qw(gettimeofday);
+
+use Getopt::Long;
+my ( $input_marc_file, $number) = ('',0);
+my ($version, $confirm,$test_parameter);
+GetOptions(
+ 'c' => \$confirm,
+ 'h' => \$version,
+ 't' => \$test_parameter,
+);
+
+if ($version || (!$confirm)) {
+ print <<EOF
+This script rebuilds the non-MARC DB from the MARC values.
+You can/must use it when you change your mapping.
+For example : you decide to map biblio.title to 200$a (it was previously mapped to 610$a) : run this script or you will have strange
+results in OPAC !
+syntax :
+\t./rebuildnonmarc.pl -h (or without arguments => shows this screen)
+\t./rebuildnonmarc.pl -c (c like confirm => rebuild non marc DB (may be long)
+\t-t => test only, change nothing in DB
+EOF
+;
+die;
+}
+
+my $dbh = C4::Context->dbh;
+my $i=0;
+my $starttime = time();
+
+$|=1; # flushes output
+my $starttime = gettimeofday;
+
+#1st of all, find item MARC tag.
+my ($tagfield,$tagsubfield) = &GetMarcFromKohaField("items.itemnumber",'');
+# $dbh->do("lock tables biblio write, biblioitems write, items write, marc_biblio write, marc_subfield_table write, marc_blob_subfield write, marc_word write, marc_subfield_structure write, stopwords write");
+my $sth = $dbh->prepare("SELECT biblionumber FROM biblio");
+$sth->execute;
+# my ($biblionumbermax) = $sth->fetchrow;
+# warn "$biblionumbermax <<==";
+while (my ($biblionumber)= $sth->fetchrow) {
+ #now, parse the record, extract the item fields, and store them in somewhere else.
+ my $record = GetMarcBiblio($biblionumber);
+ my @fields = $record->field($tagfield);
+ my @items;
+ my $nbitems=0;
+ print ".";
+ my $timeneeded = gettimeofday - $starttime;
+ print "$i in $timeneeded s\n" unless ($i % 50);
+ $i++;
+ foreach my $field (@fields) {
+ my $item = MARC::Record->new();
+ $item->append_fields($field);
+ push @items,$item;
+ $record->delete_field($field);
+ $nbitems++;
+ }
+# print "$biblionumber\n";
+ my $frameworkcode = GetFrameworkCode($biblionumber);
+ localNEWmodbiblio($dbh,$record,$biblionumber,$frameworkcode) unless $test_parameter;
+}
+# $dbh->do("unlock tables");
+my $timeneeded = time() - $starttime;
+print "$i MARC record done in $timeneeded seconds\n";
+
+# modified NEWmodbiblio to jump the MARC part of the biblio modif
+# highly faster
+sub localNEWmodbiblio {
+ my ($dbh,$record,$biblionumber,$frameworkcode) =@_;
+ $frameworkcode="" unless $frameworkcode;
+ my $oldbiblio = TransformMarcToKoha($dbh,$record,$frameworkcode);
+ C4::Biblio::_koha_modify_biblio( $dbh, $oldbiblio );
+ C4::Biblio::_koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
+ return 1;
+}
--- /dev/null
+#!/usr/bin/perl
+# This script finds and fixes missing biblionumber/biblioitemnumber fields in Koha
+# Written by TG on 01/10/2005
+# Revised by Joshua Ferraro on 03/31/2006
+use strict;
+BEGIN {
+ # find Koha's Perl modules
+ # test carefully before changing this
+ use FindBin;
+ eval { require "$FindBin::Bin/kohalib.pl" };
+}
+
+# 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;
--- /dev/null
+#!/usr/bin/perl
+
+# 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
+
+
+
+=head1 batchupdateISBNs.pl
+
+ This script batch updates ISBN fields
+
+=cut
+
+use strict;
+BEGIN {
+ # find Koha's Perl modules
+ # test carefully before changing this
+ use FindBin;
+ eval { require "$FindBin::Bin/kohalib.pl" };
+}
+use C4::Context;
+use MARC::File::XML;
+use MARC::Record;
+use Getopt::Long;
+
+my ( $no_marcxml, $no_isbn, $help) = (0,0,0);
+
+GetOptions(
+ 'noisbn' => \$no_isbn,
+ 'noxml' => \$no_marcxml,
+ 'h' => \$help,
+ 'help' => \$help,
+);
+
+
+$| = 1;
+my $dbh = C4::Context->dbh;
+
+if($help){
+ print qq(
+ Option :
+ \t-h show this help
+ \t-noisbn don't remove '-' in biblioitems.isbn
+ \t-noxml don't remove '-' in biblioitems.marcxml in field 010a
+ \n\n
+ );
+ exit;
+}
+
+my $cpt_isbn = 0;
+if(not $no_isbn){
+
+ my $query_isbn = "
+ SELECT biblioitemnumber,isbn FROM biblioitems WHERE isbn IS NOT NULL
+ ";
+
+ my $update_isbn = "
+ UPDATE biblioitems SET isbn=? WHERE biblioitemnumber = ?
+ ";
+
+ my $sth = $dbh->prepare($query_isbn);
+ $sth->execute;
+
+ while (my $data = $sth->fetchrow_arrayref){
+ my $biblioitemnumber = $data->[0];
+ print "\rremoving '-' on isbn for biblioitemnumber $biblioitemnumber";
+
+ # suppression des tirets de l'isbn
+ my $isbn = $data->[1];
+ if($isbn){
+ $isbn =~ s/-//g;
+
+ #update
+ my $sth = $dbh->prepare($update_isbn);
+ $sth->execute($isbn,$biblioitemnumber);
+ }
+ $cpt_isbn++;
+ }
+ print "$cpt_isbn updated";
+}
+
+if(not $no_marcxml){
+
+ my $query_marcxml = "
+ SELECT biblioitemnumber,marcxml FROM biblioitems WHERE isbn IS NOT NULL
+ ";
+
+
+ my $update_marcxml = "
+ UPDATE biblioitems SET marcxml=? WHERE biblioitemnumber = ?
+ ";
+
+ my $sth = $dbh->prepare($query_marcxml);
+ $sth->execute;
+
+ while (my $data = $sth->fetchrow_arrayref){
+
+ my $biblioitemnumber = $data->[0];
+ print "\rremoving '-' on marcxml for biblioitemnumber $biblioitemnumber";
+
+ # suppression des tirets de l'isbn dans la notice
+ my $marcxml = $data->[1];
+
+ eval{
+ my $record = MARC::Record->new_from_xml($marcxml,'UTF-8','UNIMARC');
+ my @field = $record->field('010');
+ my $flag = 0;
+ foreach my $field (@field){
+ my $subfield = $field->subfield('a');
+ if($subfield){
+ my $isbn = $subfield;
+ $isbn =~ s/-//g;
+ $field->update('a' => $isbn);
+ $flag = 1;
+ }
+ }
+ if($flag){
+ $marcxml = $record->as_xml;
+ # Update
+ my $sth = $dbh->prepare($update_marcxml);
+ $sth->execute($marcxml,$biblioitemnumber);
+ }
+ };
+ if($@){
+ print "\n /!\\ pb getting $biblioitemnumber : $@";
+ }
+ }
+}
#!/usr/bin/perl
-
+# This is an example script for how to benchmark various
+# parts of your Koha system. It's useful for measuring the
+# impact of mod_perl on performance.
use strict;
BEGIN {
# find Koha's Perl modules
use HTTPD::Bench::ApacheBench;
use C4::Context;
-# 1st, find some maximal values
+# 1st, find some max values
my $dbh=C4::Context->dbh();
my $sth = $dbh->prepare("select max(borrowernumber) from borrowers");
$sth->execute;
$sth->execute;
my ($itemnumber_max) = $sth->fetchrow;
-my $baseurl= "http://i17.bureau.paulpoulain.com/cgi-bin/koha";
+my $baseurl= C4::Context->preference("staffClientBaseURL")."/cgi-bin/koha/";
my $max_tries = 200;
my $concurrency = 5;
my $b = HTTPD::Bench::ApacheBench->new;
$b->concurrency( $concurrency );
#
-# mainpage : (very) low mySQL dependancy
+# mainpage : (very) low RDBMS dependency
#
my $b0 = HTTPD::Bench::ApacheBench->new;
$b0->concurrency( $concurrency );
print "Koha benchmark\n";
print "--------------\n";
print "benchmarking with $max_tries occurences of each operation\n";
-print "mainpage (no mySQL) ";
+print "mainpage (low RDBMS dependency) ";
for (my $i=1;$i<=$max_tries;$i++) {
push @mainpage,"$baseurl/mainpage.pl";
}
+++ /dev/null
-#!/usr/bin/perl
-# small script that import an iso2709 file into koha 2.0
-
-use strict;
-BEGIN {
- # find Koha's Perl modules
- # test carefully before changing this
- use FindBin;
- eval { require "$FindBin::Bin/kohalib.pl" };
-}
-
-# Koha modules used
-use MARC::File::USMARC;
-use MARC::Record;
-use MARC::Batch;
-use C4::Context;
-use C4::AuthoritiesMarc;
-use Time::HiRes qw(gettimeofday);
-
-use Getopt::Long;
-my ( $input_marc_file, $number) = ('',0);
-my ($version, $delete, $test_parameter,$char_encoding, $verbose);
-GetOptions(
- 'file:s' => \$input_marc_file,
- 'n' => \$number,
- 'h' => \$version,
- 'd' => \$delete,
- 't' => \$test_parameter,
- 'c:s' => \$char_encoding,
- 'v:s' => \$verbose,
-);
-
-if ($version || ($input_marc_file eq '')) {
- print <<EOF
-small script to import an iso2709 file into Koha.
-parameters :
-\th : this version/help screen
-\tfile /path/to/file/to/dump : the file to dump
-\tv : verbose mode. 1 means "some infos", 2 means "MARC dumping"
-\tn : the number of the record to import. If missing, all the file is imported
-\tt : test mode : parses the file, saying what he would do, but doing nothing.
-\tc : the char encoding. At the moment, only MARC21 and UNIMARC supported. MARC21 by default.
-\td : delete EVERYTHING related to biblio in koha-DB before import :tables :
-\t\tbiblio, \t\tbiblioitems, \t\tsubjects,\titems
-\tmarc_biblio,
-\t\tmarc_subfield_table, \tmarc_word, \t\tmarc_blob_subfield
-IMPORTANT : don't use this script before you've entered and checked twice (or more) your MARC parameters tables.
-If you fail this, the import won't work correctly and you will get invalid datas.
-
-SAMPLE : ./bulkmarcimport.pl -file /home/paul/koha.dev/local/npl -n 1
-EOF
-;#'
-die;
-}
-
-my $dbh = C4::Context->dbh;
-
-if ($delete) {
- print "deleting authorities\n";
- $dbh->do("delete from auth_header");
-}
-if ($test_parameter) {
- print "TESTING MODE ONLY\n DOING NOTHING\n===============\n";
-}
-
-$char_encoding = 'MARC21' unless ($char_encoding);
-print "CHAR : $char_encoding\n" if $verbose;
-my $starttime = gettimeofday;
-my $batch = MARC::Batch->new( 'USMARC', $input_marc_file );
-$batch->warnings_off();
-$batch->strict_off();
-my $i=0;
-while ( my $record = $batch->next() ) {
- $i++;
- #now, parse the record, extract the item fields, and store them in somewhere else.
-
- ## create an empty record object to populate
- my $newRecord = MARC::Record->new();
- $newRecord->leader($record->leader);
- # go through each field in the existing record
- foreach my $oldField ( $record->fields() ) {
- # just reproduce tags < 010 in our new record
- if ( $oldField->tag() < 10 ) {
- $newRecord->append_fields( $oldField );
- next();
- }
- # store our new subfield data in this list
- my @newSubfields = ();
-
- # go through each subfield code/data pair
- foreach my $pair ( $oldField->subfields() ) {
- $pair->[1] =~ s/\<//g;
- $pair->[1] =~ s/\>//g;
- push( @newSubfields, $pair->[0], char_decode($pair->[1],$char_encoding) );
- }
-
- # add the new field to our new record
- my $newField = MARC::Field->new(
- $oldField->tag(),
- $oldField->indicator(1),
- $oldField->indicator(2),
- @newSubfields
- );
- $newRecord->append_fields( $newField );
- }
- warn "$i ==>".$newRecord->as_formatted() if $verbose eq 2;
- my $authtypecode=substr($newRecord->leader(),9,1);
- $authtypecode="NP" if ($authtypecode eq 'a'); # personnes
- $authtypecode="CO" if ($authtypecode eq 'b'); # collectivit�
- $authtypecode="NG" if ($authtypecode eq 'c'); # g�graphique
- $authtypecode="NM" if ($authtypecode eq 'd'); # marque
- $authtypecode="NF" if ($authtypecode eq 'e'); # famille
- $authtypecode="TI" if ($authtypecode eq 'f'); # Titre uniforme
- $authtypecode="TI" if ($authtypecode eq 'h'); # auteur/titre
- $authtypecode="MM" if ($authtypecode eq 'j'); # mot mati�e
- warn "XX => $authtypecode";
- # now, create biblio and items with NEWnewXX call.
- unless ($test_parameter) {
- my ($authid) = AddAuthority($newRecord,0,$authtypecode);
- warn "ADDED authority NB $authid in DB\n" if $verbose;
- }
-}
-# $dbh->do("unlock tables");
-my $timeneeded = gettimeofday - $starttime;
-print "$i MARC record done in $timeneeded seconds";
+++ /dev/null
-#!/usr/bin/perl
-
-# 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
-
-
-
-=head1 bulkupdate.pl
-
- This script allows you to update your database/records after a bulkmarckimport integration.
-
-=cut
-
-use strict;
-BEGIN {
- # find Koha's Perl modules
- # test carefully before changing this
- use FindBin;
- eval { require "$FindBin::Bin/kohalib.pl" };
-}
-use C4::Context;
-use MARC::File::XML;
-use MARC::Record;
-use Getopt::Long;
-
-my ( $no_marcxml, $no_isbn, $help) = (0,0,0);
-
-GetOptions(
- 'noisbn' => \$no_isbn,
- 'noxml' => \$no_marcxml,
- 'h' => \$help,
- 'help' => \$help,
-);
-
-
-$| = 1;
-my $dbh = C4::Context->dbh;
-
-if($help){
- print qq(
- Option :
- \t-h show this help
- \t-noisbn don't remove '-' in biblioitems.isbn
- \t-noxml don't remove '-' in biblioitems.marcxml in field 010a
- \n\n
- );
- exit;
-}
-
-my $cpt_isbn = 0;
-if(not $no_isbn){
-
- my $query_isbn = "
- SELECT biblioitemnumber,isbn FROM biblioitems WHERE isbn IS NOT NULL
- ";
-
- my $update_isbn = "
- UPDATE biblioitems SET isbn=? WHERE biblioitemnumber = ?
- ";
-
- my $sth = $dbh->prepare($query_isbn);
- $sth->execute;
-
- while (my $data = $sth->fetchrow_arrayref){
- my $biblioitemnumber = $data->[0];
- print "\rremoving '-' on isbn for biblioitemnumber $biblioitemnumber";
-
- # suppression des tirets de l'isbn
- my $isbn = $data->[1];
- if($isbn){
- $isbn =~ s/-//g;
-
- #update
- my $sth = $dbh->prepare($update_isbn);
- $sth->execute($isbn,$biblioitemnumber);
- }
- $cpt_isbn++;
- }
- print "$cpt_isbn updated";
-}
-
-if(not $no_marcxml){
-
- my $query_marcxml = "
- SELECT biblioitemnumber,marcxml FROM biblioitems WHERE isbn IS NOT NULL
- ";
-
-
- my $update_marcxml = "
- UPDATE biblioitems SET marcxml=? WHERE biblioitemnumber = ?
- ";
-
- my $sth = $dbh->prepare($query_marcxml);
- $sth->execute;
-
- while (my $data = $sth->fetchrow_arrayref){
-
- my $biblioitemnumber = $data->[0];
- print "\rremoving '-' on marcxml for biblioitemnumber $biblioitemnumber";
-
- # suppression des tirets de l'isbn dans la notice
- my $marcxml = $data->[1];
-
- eval{
- my $record = MARC::Record->new_from_xml($marcxml,'UTF-8','UNIMARC');
- my @field = $record->field('010');
- my $flag = 0;
- foreach my $field (@field){
- my $subfield = $field->subfield('a');
- if($subfield){
- my $isbn = $subfield;
- $isbn =~ s/-//g;
- $field->update('a' => $isbn);
- $flag = 1;
- }
- }
- if($flag){
- $marcxml = $record->as_xml;
- # Update
- my $sth = $dbh->prepare($update_marcxml);
- $sth->execute($marcxml,$biblioitemnumber);
- }
- };
- if($@){
- print "\n /!\\ pb getting $biblioitemnumber : $@";
- }
- }
-}
+++ /dev/null
-#!/usr/bin/perl
-# small script that rebuilds the non-MARC DB
-
-use strict;
-BEGIN {
- # find Koha's Perl modules
- # test carefully before changing this
- use FindBin;
- eval { require "$FindBin::Bin/kohalib.pl" };
-}
-
-# Koha modules used
-# use MARC::File::USMARC;
-use MARC::Record;
-use MARC::Batch;
-use C4::Context;
-use C4::Biblio;
-use Time::HiRes qw(gettimeofday);
-
-use Getopt::Long;
-my ( $input_marc_file, $number) = ('',0);
-my ($version, $confirm,$test_parameter);
-GetOptions(
- 'c' => \$confirm,
- 'h' => \$version,
- 't' => \$test_parameter,
-);
-
-if ($version || (!$confirm)) {
- print <<EOF
-This script cleans unused subfields in the MARC DB.
-If you alter the MARC parameters and remove a subfield (ie : move it to ignore (10) tab), existing subfields are NOT removed.
-It's not a bug, it prevents deleting useful values in case of erroneous move.
-This script definetly remove unused subfields in the MARC DB.
-syntax :
-\t./cleanmarcdb.pl -h (or without arguments => shows this screen)
-\t./cleanmarcdb.pl -c (c like confirm => cleans the marc DB (may be long)
-\t-t => test only, change nothing in DB
-EOF
-;#'
-die;
-}
-
-my $dbh = C4::Context->dbh;
-my $i=0;
-my $starttime = gettimeofday;
-my $cleansubfield = $dbh->prepare("delete from marc_subfield_table where tag=? and subfieldcode=?");
-my $cleanword = $dbh->prepare("delete from marc_word where tag=? and subfieldid=?");
-
-# get tags structure
-my $tags = GetMarcStructure(1);
-foreach my $tag (sort keys(%{$tags})) {
- foreach my $subfield (sort keys(%{$tags->{$tag}})) {
- next if $subfield eq "lib";
- next if $subfield eq "mandatory";
- next if $subfield eq "tab";
- # DO NOT drop biblionumber, biblioitemnumber and itemnumber.
- # they are stored internally, and are mapped to tab -1. This script must keep them or it will completly break Koha DB !!!
- next if ($tags->{$tag}->{$subfield}->{kohafield} eq "biblio.biblionumber");
- next if ($tags->{$tag}->{$subfield}->{kohafield} eq "biblioitems.biblioitemnumber");
- next if ($tags->{$tag}->{$subfield}->{kohafield} eq "items.itemnumber");
- # now, test => if field is ignored (in tab -1 or '') => drop everything in the MARC table !
- if ($tags->{$tag}->{$subfield}->{tab} eq -1 || $tags->{$tag}->{$subfield}->{tab} eq '') {
- print "dropping $tag \$ $subfield\n";
- $cleansubfield->execute($tag,$subfield) unless $test_parameter;
- $cleanword->execute($tag,$subfield) unless $test_parameter;
- print "TEST " if $test_parameter;
- print "done\n";
- }
- }
-}
-my $timeneeded = gettimeofday - $starttime;
-print "done in $timeneeded seconds\n";
+++ /dev/null
-#!/usr/bin/perl
-# small script that dumps an iso2709 file.
-
-
-use strict;
-BEGIN {
- # find Koha's Perl modules
- # test carefully before changing this
- use FindBin;
- eval { require "$FindBin::Bin/kohalib.pl" };
-}
-
-# Koha modules used
-use C4::Context;
-use MARC::File::USMARC;
-use MARC::Record;
-use MARC::Batch;
-
-use Getopt::Long;
-my ( $input_marc_file,$number,$nowarning,$frameworkcode) = ('',0);
-my $version;
-GetOptions(
- 'file:s' => \$input_marc_file,
- 'n:s' => \$number,
- 'v' => \$version,
- 'w' => \$nowarning,
- 'c' => \$frameworkcode,
-);
-
-$frameworkcode="" unless $frameworkcode;
-
-if ($version || ($input_marc_file eq '')) {
- print <<EOF
-This script compare an iso2709 file and the MARC parameters
-It will show the marc fields/subfields used in Koha, and that are not anywhere in the iso2709 file and which fields/subfields that are used in the iso2709 file and not in Koha.
-to solve this, just modify Koha parameters (change TAB)
-parameters :
-\tv : this version/help screen
-\tfile /path/to/file/to/dump : the file to dump
-\tw : warning and strict off. If your dump fail, try -w option. It it works, then, the file is iso2709, but a buggy one !
-\tc : the frameworkcode. If omitted, set to ""
-SAMPLE : ./compare_iso_and_marc_parameters.pl -file /home/paul/koha.dev/local/npl -n 1
-EOF
-;
-die;
-}#/
-
-my $batch = MARC::Batch->new( 'USMARC', $input_marc_file );
-$batch->warnings_off() unless $nowarning;
-$batch->strict_off() unless $nowarning;
-my $dbh=C4::Context->dbh;
-my $sth = $dbh->prepare("select tagfield,tagsubfield,tab from marc_subfield_structure where frameworkcode=?");
-$sth->execute($frameworkcode);
-
-my %hash_unused;
-my %hash_used;
-while (my ($tagfield,$tagsubfield,$tab) = $sth->fetchrow) {
- $hash_unused{"$tagfield$tagsubfield"} = 1 if ($tab eq -1);
- $hash_used{"$tagfield$tagsubfield"} = 1 if ($tab ne -1);
-}
-my $i=0;
-while ( my $record = $batch->next() ) {
- $i++;
- foreach my $MARCfield ($record->fields()) {
- next if $MARCfield->tag()<=010;
- if ($MARCfield) {
- foreach my $fields ($MARCfield->subfields()) {
- if ($fields) {
- if ($hash_unused{$MARCfield->tag().@$fields[0]}>=1) {
- $hash_unused{$MARCfield->tag().@$fields[0]}++;
- }
- if ($hash_used{$MARCfield->tag().@$fields[0]}>=1) {
- $hash_used{$MARCfield->tag().@$fields[0]}++;
- }
- }
- # foreach my $field (@$fields) {
- # warn "==>".$MARCfield->tag().@$fields[0];
- # }
- }
- }
- }
-}
-print "Undeclared tag/subfields that exists in the file\n";
-print "================================================\n";
-foreach my $key (sort keys %hash_unused) {
- print "$key => ".($hash_unused{$key}-1)."\n" unless ($hash_unused{$key}==1);
-}
-
-print "Declared tag/subfields unused in the iso2709 file\n";
-print "=================================================\n";
-foreach my $key (sort keys %hash_used) {
- print "$key => ".($hash_used{$key}-1)."\n" if ($hash_used{$key}==1);
-}
-
-# foreach my $x (sort keys %resB) {
-# print "$x => ".$resB{$x}."\n";
-# }
-print "\n==================\n$i record parsed\n";
+++ /dev/null
-#!/usr/bin/perl
-# small script that dumps an iso2709 file.
-
-
-use strict;
-BEGIN {
- # find Koha's Perl modules
- # test carefully before changing this
- use FindBin;
- eval { require "$FindBin::Bin/kohalib.pl" };
-}
-
-# Koha modules used
-use MARC::File::USMARC;
-use MARC::Record;
-use MARC::Batch;
-
-use Getopt::Long;
-my ( $input_marc_file,$number,$nowarning) = ('',0);
-my $version;
-GetOptions(
- 'file:s' => \$input_marc_file,
- 'n:s' => \$number,
- 'v' => \$version,
- 'w' => \$nowarning,
-);
-
-warn "NUM : $number\n";
-if ($version || ($input_marc_file eq '')) {
- print <<EOF
-small script to dump an iso2709 file.
-parameters :
-\tv : this version/help screen
-\tfile /path/to/file/to/dump : the file to dump
-\tn : the number of the record to dump. If missing, all the file is dumped
-\tw : warning and strict off. If your dump fail, try -w option. It it works, then, the file is iso2709, but a buggy one !
-SAMPLE : ./dumpmarc.pl -file /home/paul/koha.dev/local/npl -n 1
-EOF
-;
-die;
-}
-
-my $batch = MARC::Batch->new( 'USMARC', $input_marc_file );
-$batch->warnings_off() unless $nowarning;
-$batch->strict_off() unless $nowarning;
-my $i=1;
-while ( my $record = $batch->next() ) {
- print "\nNUMBER $i =>\n".$record->as_formatted() if ($i eq $number || $number eq 0);
- $i++;
-}
-print "\n==================\n$i record parsed\n";
eval { require "$FindBin::Bin/kohalib.pl" };
}
require Exporter;
-
-use C4::Auth;
+use C4::Context;
use C4::Output; # contains gettemplate
use C4::Biblio;
-use CGI;
use C4::Auth;
my $outfile = $ARGV[0];
open(OUT,">$outfile") or die $!;
-my $query = new CGI;
-my $dbh=DBI->connect("DBI:mysql:database=koha2;host=localhost;port=3306","kohaserver","kohaserver") or die $DBI::errmsg;
-#$dbh->do("set character_set_client='latin5'");
-#$dbh->do("set character_set_connection='utf8'");
-#$dbh->do("set character_set_results='latin5'");
-#my $dbh=C4::Context->dbh;
- my $sth;
-
- $sth=$dbh->prepare("select marc from auth_header order by authid");
- $sth->execute();
-
- while (my ($marc) = $sth->fetchrow) {
-
- print OUT $marc;
- }
+my $dbh=C4::Context->dbh;
+#$dbh->do("set character_set_client='latin5'");
+$dbh->do("set character_set_connection='utf8'");
+#$dbh->do("set character_set_results='latin5'");
+my $sth=$dbh->prepare("select marc from auth_header order by authid");
+$sth->execute();
+while (my ($marc) = $sth->fetchrow) {
+ print OUT $marc;
+ }
close(OUT);
+++ /dev/null
-#!/usr/bin/perl
-# script that correct the marcxml from in biblioitems
-# Written by TG on 10/04/2006
-use strict;
-BEGIN {
- # find Koha's Perl modules
- # test carefully before changing this
- use FindBin;
- eval { require "$FindBin::Bin/kohalib.pl" };
-}
-
-# 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 $batch = MARC::Batch->new( 'USMARC', $input_marc_file );
-$batch->warnings_off();
-$batch->strict_off();
-my ($tagfield,$biblionumtagsubfield) = &GetMarcFromKohaField("biblio.biblionumber","");
-
-my $i=0;
-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;
-# IS THIS SUPPOSED TO BE __END__ ?? If not, then what is it? --JBA
-
-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);
-}
+++ /dev/null
-#!/usr/bin/perl
-# script that rebuild thesaurus from biblio table.
-
-use strict;
-BEGIN {
- # find Koha's Perl modules
- # test carefully before changing this
- use FindBin;
- eval { require "$FindBin::Bin/kohalib.pl" };
-}
-
-# Koha modules used
-use MARC::File::USMARC;
-use MARC::Record;
-use MARC::Batch;
-use C4::Context;
-use C4::Biblio;
-use C4::AuthoritiesMarc;
-use Time::HiRes qw(gettimeofday);
-
-use Getopt::Long;
-my ($version, $verbose, $mergefrom,$mergeto,$noconfirm);
-GetOptions(
- 'h' => \$version,
- 'f:s' => \$mergefrom,
- 't:s' => \$mergeto,
- 'v' => \$verbose,
- 'n' => \$noconfirm,
-);
-
-if ($version || ($mergefrom eq '')) {
- print <<EOF
-Script to merge an authority into another
-parameters :
-\th : this version/help screen
-\tv : verbose mode (show many things on screen)
-\tf : the authority number to merge (the one that can be deleted after the merge).
-\tt : the authority number where to merge
-\tn : don't ask for confirmation (useful for batch mergings, should not be used on command line)
-
-All biblios with the authority in -t will be modified to be "connected" to authority -f
-SAMPLE :
-./merge_authority.pl -f 2457 -t 531
-
-Before doing anything, the script will show both authorities and ask for confirmation. Of course, you can merge only 2 authorities of the same kind.
-EOF
-;#
-die;
-}#/'
-
-my $dbh = C4::Context->dbh;
-# my @subf = $subfields =~ /(##\d\d\d##.)/g;
-
-$|=1; # flushes output
-my $authfrom = AUTHgetauthority($mergefrom);
-my $authto = AUTHgetauthority($mergeto);
-
-my $authtypecodefrom = AUTHfind_authtypecode($mergefrom);
-my $authtypecodeto = AUTHfind_authtypecode($mergeto);
-
-unless ($noconfirm) {
- print "************\n";
- print "You will merge authority : $mergefrom ($authtypecodefrom)\n".$authfrom->as_formatted;
- print "\n*************\n";
- print "Into authority : $mergeto ($authtypecodeto)\n".$authto->as_formatted;
- print "\n\nDo you confirm (enter YES)?";
- my $confirm = <STDIN>;
- chop $confirm;
- unless (uc($confirm) eq 'YES' and $authtypecodefrom eq $authtypecodeto) {
- print "IMPOSSIBLE : authorities are not of the same type ($authtypecodefrom vs $authtypecodeto) !!!\n" if $authtypecodefrom ne $authtypecodeto;
- print "Merge cancelled\n";
- exit;
- }
-}
-my $starttime = gettimeofday;
-print "Merging\n" unless $noconfirm;
-
-# search the tag to report
-my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?");
-$sth->execute($authtypecodefrom);
-my ($auth_tag_to_report) = $sth->fetchrow;
-# my $record_to_report = $authto->field($auth_tag_to_report);
-print "Reporting authority tag $auth_tag_to_report :\n" if $verbose;
-my @record_to = $authto->field($auth_tag_to_report)->subfields();
-my @record_from = $authfrom->field($auth_tag_to_report)->subfields();
-
-# search all biblio tags using this authority.
-$sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?");
-$sth->execute($authtypecodefrom);
-my $tags_using_authtype;
-while (my ($tagfield) = $sth->fetchrow) {
- $tags_using_authtype.= "'".$tagfield."',";
-}
-chop $tags_using_authtype;
-# now, find every biblio using this authority
-my $query = "select bibid,tag,tag_indicator,tagorder,subfieldcode,subfieldorder from marc_subfield_table where tag in ($tags_using_authtype) and subfieldcode='9' and subfieldvalue='$mergefrom'";
-$sth = $dbh->prepare($query);
-$sth->execute;
-my $nbdone;
-# and delete entries before recreating them
-while (my ($bibid,$tag,$tag_indicator,$tagorder,$subfieldcode,$subfieldorder) = $sth->fetchrow) {
- my $biblio = GetMarcBiblio($bibid);
- print "BEFORE : ".$biblio->as_formatted."\n" if $verbose;
- # now, we know what uses the authority & where.
- # delete all subfields that are in the same tag/tagorder and that are in the authority (& that are not in tab ignore in the biblio)
- # then recreate them with the new authority.
- foreach my $subfield (@record_from) {
- &MARCdelsubfield($bibid,$tag,$tagorder,$subfield->[0]);
- }
- &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,'9');
- foreach my $subfield (@record_to) {
- &MARCaddsubfield($bibid,$tag,$tag_indicator,$tagorder,$subfield->[0],$subfieldorder,$subfield->[1]);
- }
- &MARCaddsubfield($bibid,$tag,$tag_indicator,$tagorder,'9',$subfieldorder,$mergeto);
- $biblio = GetMarcBiblio($bibid);
- print "AFTER : ".$biblio->as_formatted."\n" if $verbose;
- $nbdone++;
-# &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,$subfieldcode,$subfieldorder);
-
-}
-my $timeneeded = gettimeofday - $starttime;
-print "$nbdone authorities done in $timeneeded seconds" unless $noconfirm;
--- /dev/null
+#!/usr/bin/perl
+# small script that import an iso2709 file into koha 2.0
+
+use strict;
+BEGIN {
+ # find Koha's Perl modules
+ # test carefully before changing this
+ use FindBin;
+ eval { require "$FindBin::Bin/kohalib.pl" };
+}
+
+# Koha modules used
+use MARC::File::USMARC;
+use MARC::Record;
+use MARC::Batch;
+use C4::Context;
+use C4::AuthoritiesMarc;
+use Time::HiRes qw(gettimeofday);
+
+use Getopt::Long;
+my ( $input_marc_file, $number) = ('',0);
+my ($version, $delete, $test_parameter,$char_encoding, $verbose);
+GetOptions(
+ 'file:s' => \$input_marc_file,
+ 'n' => \$number,
+ 'h' => \$version,
+ 'd' => \$delete,
+ 't' => \$test_parameter,
+ 'c:s' => \$char_encoding,
+ 'v:s' => \$verbose,
+);
+
+if ($version || ($input_marc_file eq '')) {
+ print <<EOF
+small script to import an iso2709 file into Koha.
+parameters :
+\th : this version/help screen
+\tfile /path/to/file/to/dump : the file to dump
+\tv : verbose mode. 1 means "some infos", 2 means "MARC dumping"
+\tn : the number of the record to import. If missing, all the file is imported
+\tt : test mode : parses the file, saying what he would do, but doing nothing.
+\tc : the char encoding. At the moment, only MARC21 and UNIMARC supported. MARC21 by default.
+\td : delete EVERYTHING related to biblio in koha-DB before import :tables :
+\t\tbiblio, \t\tbiblioitems, \t\tsubjects,\titems
+\tmarc_biblio,
+\t\tmarc_subfield_table, \tmarc_word, \t\tmarc_blob_subfield
+IMPORTANT : don't use this script before you've entered and checked twice (or more) your MARC parameters tables.
+If you fail this, the import won't work correctly and you will get invalid datas.
+
+SAMPLE : ./bulkmarcimport.pl -file /home/paul/koha.dev/local/npl -n 1
+EOF
+;#'
+die;
+}
+
+my $dbh = C4::Context->dbh;
+
+if ($delete) {
+ print "deleting authorities\n";
+ $dbh->do("delete from auth_header");
+}
+if ($test_parameter) {
+ print "TESTING MODE ONLY\n DOING NOTHING\n===============\n";
+}
+
+$char_encoding = 'MARC21' unless ($char_encoding);
+print "CHAR : $char_encoding\n" if $verbose;
+my $starttime = gettimeofday;
+my $batch = MARC::Batch->new( 'USMARC', $input_marc_file );
+$batch->warnings_off();
+$batch->strict_off();
+my $i=0;
+while ( my $record = $batch->next() ) {
+ $i++;
+ #now, parse the record, extract the item fields, and store them in somewhere else.
+
+ ## create an empty record object to populate
+ my $newRecord = MARC::Record->new();
+ $newRecord->leader($record->leader);
+ # go through each field in the existing record
+ foreach my $oldField ( $record->fields() ) {
+ # just reproduce tags < 010 in our new record
+ if ( $oldField->tag() < 10 ) {
+ $newRecord->append_fields( $oldField );
+ next();
+ }
+ # store our new subfield data in this list
+ my @newSubfields = ();
+
+ # go through each subfield code/data pair
+ foreach my $pair ( $oldField->subfields() ) {
+ $pair->[1] =~ s/\<//g;
+ $pair->[1] =~ s/\>//g;
+ push( @newSubfields, $pair->[0], char_decode($pair->[1],$char_encoding) );
+ }
+
+ # add the new field to our new record
+ my $newField = MARC::Field->new(
+ $oldField->tag(),
+ $oldField->indicator(1),
+ $oldField->indicator(2),
+ @newSubfields
+ );
+ $newRecord->append_fields( $newField );
+ }
+ warn "$i ==>".$newRecord->as_formatted() if $verbose eq 2;
+ my $authtypecode=substr($newRecord->leader(),9,1);
+ $authtypecode="NP" if ($authtypecode eq 'a'); # personnes
+ $authtypecode="CO" if ($authtypecode eq 'b'); # collectivit�
+ $authtypecode="NG" if ($authtypecode eq 'c'); # g�graphique
+ $authtypecode="NM" if ($authtypecode eq 'd'); # marque
+ $authtypecode="NF" if ($authtypecode eq 'e'); # famille
+ $authtypecode="TI" if ($authtypecode eq 'f'); # Titre uniforme
+ $authtypecode="TI" if ($authtypecode eq 'h'); # auteur/titre
+ $authtypecode="MM" if ($authtypecode eq 'j'); # mot mati�e
+ warn "XX => $authtypecode";
+ # now, create biblio and items with NEWnewXX call.
+ unless ($test_parameter) {
+ my ($authid) = AddAuthority($newRecord,0,$authtypecode);
+ warn "ADDED authority NB $authid in DB\n" if $verbose;
+ }
+}
+# $dbh->do("unlock tables");
+my $timeneeded = gettimeofday - $starttime;
+print "$i MARC record done in $timeneeded seconds";
+++ /dev/null
-#!/usr/bin/perl
-
-use C4::Context;
-use Getopt::Long;
-use C4::Biblio;
-
-#
-# script that checks zebradir structure & create directories & mandatory files if needed
-#
-#
-
-$|=1; # flushes output
-
-print "Zebra directory =>".C4::Context->zebraconfig('biblioserver')->{directory}."\n";
-print "Koha directory =>".C4::Context->config('intranetdir')."\n";
-
-my $zebradir = C4::Context->zebraconfig('biblioserver')->{directory};
-my $kohadir = C4::Context->config('intranetdir');
-my $directory;
-my $skip_export;
-my $keep_export;
-GetOptions(
- 'd:s' => \$directory,
- 's' => \$skip_export,
- 'k' => \$keep_export,
- );
-
-$directory = "export" unless $directory;
-
-my $created_dir_or_file = 0;
-print "====================\n";
-print "checking directories & files\n";
-print "====================\n";
-unless (-d "$zebradir") {
- system("mkdir -p $zebradir");
- print "created $zebradir\n";
- $created_dir_or_file++;
-}
-unless (-d "$zebradir/lock") {
- mkdir "$zebradir/lock";
- print "created $zebradir/lock\n";
- $created_dir_or_file++;
-}
-unless (-d "$zebradir/register") {
- mkdir "$zebradir/register";
- print "created $zebradir/register\n";
- $created_dir_or_file++;
-}
-unless (-d "$zebradir/shadow") {
- mkdir "$zebradir/shadow";
- print "created $zebradir/shadow\n";
- $created_dir_or_file++;
-}
-unless (-d "$zebradir/tab") {
- mkdir "$zebradir/tab";
- print "created $zebradir/tab\n";
- $created_dir_or_file++;
-}
-
-unless (-d "$zebradir/etc") {
- mkdir "$zebradir/etc";
- print "created $zebradir/etc\n";
- $created_dir_or_file++;
-}
-
-unless (-f "$zebradir/tab/record.abs") {
- system("cp -f $kohadir/zebraplugin/zebradb/biblios/tab/record_for_unimarc.abs $zebradir/tab/record.abs");
- print "copied record.abs\n";
- $created_dir_or_file++;
-}
-unless (-f "$zebradir/tab/sort-string-utf.chr") {
- system("cp -f $kohadir/zebraplugin/zebradb/biblios/tab/sort-string-utf.chr $zebradir/tab/sort-string-utf.chr");
- print "copied sort-string-utf.chr\n";
- $created_dir_or_file++;
-}
-unless (-f "$zebradir/tab/word-phrase-utf.chr") {
- system("cp -f $kohadir/zebraplugin/zebradb/biblios/tab/word-phrase-utf.chr $zebradir/tab/word-phrase-utf.chr");
- print "copied word-phase-utf.chr\n";
- $created_dir_or_file++;
-}
-unless (-f "$zebradir/tab/bib1.att") {
- system("cp -f $kohadir/zebraplugin/zebradb/biblios/tab/bib1.att $zebradir/tab/bib1.att");
- print "copied bib1.att\n";
- $created_dir_or_file++;
-}
-
-unless (-f "$zebradir/etc/zebra-biblios.cfg") {
- system("cp -f $kohadir/zebraplugin/etc/zebra-biblios.cfg $zebradir/etc/zebra-biblios.cfg");
- print "copied zebra-biblios.cfg\n";
- $created_dir_or_file++;
-}
-unless (-f "$zebradir/etc/ccl.properties") {
- system("cp -f $kohadir/zebraplugin/etc/ccl.properties $zebradir/etc/ccl.properties");
- print "copied ccl.properties\n";
- $created_dir_or_file++;
-}
-unless (-f "$zebradir/etc/pqf.properties") {
- system("cp -f $kohadir/zebraplugin/etc/pqf.properties $zebradir/etc/pqf.properties");
- print "copied pqf.properties\n";
- $created_dir_or_file++;
-}
-
-if ($created_dir_or_file) {
- print "created : $created_dir_or_file directories & files\n";
-} else {
- print "file & directories OK\n";
-}
-
-if ($skip_export) {
- print "====================\n";
- print "SKIPPING biblio export\n";
- print "====================\n";
-} else {
- print "====================\n";
- print "exporting biblios\n";
- print "====================\n";
- mkdir "$directory" unless (-d $directory);
- open(OUT,">:utf8","$directory/export") or die $!;
- my $dbh=C4::Context->dbh;
- my $sth;
- $sth=$dbh->prepare("select biblionumber from biblioitems order by biblionumber");
- $sth->execute();
- my $i=0;
- while (my ($biblionumber) = $sth->fetchrow) {
- my $record = MARCgetbiblio($dbh,$biblionumber);
- print ".";
- print "\r$i" unless ($i++ %100);
- print OUT $record->as_usmarc();
- }
- close(OUT);
-}
-
-print "====================\n";
-print "REINDEXING zebra\n";
-print "====================\n";
-system("zebraidx -g iso2709 -c $zebradir/etc/zebra-biblios.cfg -d biblios update $directory");
-system("zebraidx -g iso2709 -c $zebradir/etc/zebra-biblios.cfg -d biblios commit");
-
-print "====================\n";
-print "CLEANING\n";
-print "====================\n";
-if ($k) {
- print "NOTHING cleaned : the $directory has been kept. You can re-run this script with the -s parameter if you just want to rebuild zebra after changing the record.abs or another zebra config file\n";
-} else {
- system("rm -rf $zebradir");
- print "directory $zebradir deleted\n";
-}
-}
\ No newline at end of file
+++ /dev/null
-#!/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::AuthoritiesMarc;
-use Time::HiRes qw(gettimeofday);
-
-use Getopt::Long;
-my ( $input_marc_file, $number) = ('',0);
-my ($version,$confirm);
-GetOptions(
- 'h' => \$version,
- 'c' => \$confirm,
-);
-
-if ($version || ($confirm eq '')) {
- print <<EOF
-Script that compare the datas in the DB and the setting of MARC structure
-It show all fields/subfields that are in the MARC DB but NOT in any tab (= fields used but not visible) Usually, this means you made an error in your MARC editor. Sometimes, this is something normal.
-
-Enter $0 -c to run this script (the -c being here only to "confirm"
-EOF
-;#
-exit;
-}#/
-
-my $dbh = C4::Context->dbh;
-print "Checking\n";
-my $sth = $dbh->prepare("SELECT count(*), tag, subfieldcode, frameworkcode FROM marc_subfield_table, marc_biblio WHERE marc_biblio.bibid = marc_subfield_table.bibid group by frameworkcode,tag,subfieldcode");
-$sth->execute;
-my $sth2 = $dbh->prepare("select tab,liblibrarian,kohafield from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?");
-while (my ($total,$tag,$subfield,$frameworkcode) = $sth->fetchrow) {
- $sth2->execute($tag,$subfield,$frameworkcode);
- my ($tab,$liblibrarian,$kohafield) = $sth2->fetchrow;
- if ($tab eq -1 && $kohafield ne "biblio.biblionumber" && $kohafield ne "biblioitems.biblioitemnumber" && $kohafield ne "items.itemnumber") {
- print "Tab ignore for framework $frameworkcode, $tag\$$subfield - $liblibrarian (used $total times)\n";
- }
-}
-
-print "Done\n";
+++ /dev/null
-#!/usr/bin/perl
-
-use XML::SAX::ParserFactory;
-$parser = XML::SAX::ParserFactory->parser();
-print $parser;
--- /dev/null
+#!/usr/bin/perl
+# script that rebuild thesaurus from biblio table.
+
+use strict;
+BEGIN {
+ # find Koha's Perl modules
+ # test carefully before changing this
+ use FindBin;
+ eval { require "$FindBin::Bin/kohalib.pl" };
+}
+
+# Koha modules used
+use MARC::File::USMARC;
+use MARC::Record;
+use MARC::Batch;
+use C4::Context;
+use C4::Biblio;
+use C4::AuthoritiesMarc;
+use Time::HiRes qw(gettimeofday);
+
+use Getopt::Long;
+my ($version, $verbose, $mergefrom,$mergeto,$noconfirm);
+GetOptions(
+ 'h' => \$version,
+ 'f:s' => \$mergefrom,
+ 't:s' => \$mergeto,
+ 'v' => \$verbose,
+ 'n' => \$noconfirm,
+);
+
+if ($version || ($mergefrom eq '')) {
+ print <<EOF
+Script to merge an authority into another
+parameters :
+\th : this version/help screen
+\tv : verbose mode (show many things on screen)
+\tf : the authority number to merge (the one that can be deleted after the merge).
+\tt : the authority number where to merge
+\tn : don't ask for confirmation (useful for batch mergings, should not be used on command line)
+
+All biblios with the authority in -t will be modified to be "connected" to authority -f
+SAMPLE :
+./merge_authority.pl -f 2457 -t 531
+
+Before doing anything, the script will show both authorities and ask for confirmation. Of course, you can merge only 2 authorities of the same kind.
+EOF
+;#
+die;
+}#/'
+
+my $dbh = C4::Context->dbh;
+# my @subf = $subfields =~ /(##\d\d\d##.)/g;
+
+$|=1; # flushes output
+my $authfrom = AUTHgetauthority($mergefrom);
+my $authto = AUTHgetauthority($mergeto);
+
+my $authtypecodefrom = AUTHfind_authtypecode($mergefrom);
+my $authtypecodeto = AUTHfind_authtypecode($mergeto);
+
+unless ($noconfirm) {
+ print "************\n";
+ print "You will merge authority : $mergefrom ($authtypecodefrom)\n".$authfrom->as_formatted;
+ print "\n*************\n";
+ print "Into authority : $mergeto ($authtypecodeto)\n".$authto->as_formatted;
+ print "\n\nDo you confirm (enter YES)?";
+ my $confirm = <STDIN>;
+ chop $confirm;
+ unless (uc($confirm) eq 'YES' and $authtypecodefrom eq $authtypecodeto) {
+ print "IMPOSSIBLE : authorities are not of the same type ($authtypecodefrom vs $authtypecodeto) !!!\n" if $authtypecodefrom ne $authtypecodeto;
+ print "Merge cancelled\n";
+ exit;
+ }
+}
+my $starttime = gettimeofday;
+print "Merging\n" unless $noconfirm;
+
+# search the tag to report
+my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?");
+$sth->execute($authtypecodefrom);
+my ($auth_tag_to_report) = $sth->fetchrow;
+# my $record_to_report = $authto->field($auth_tag_to_report);
+print "Reporting authority tag $auth_tag_to_report :\n" if $verbose;
+my @record_to = $authto->field($auth_tag_to_report)->subfields();
+my @record_from = $authfrom->field($auth_tag_to_report)->subfields();
+
+# search all biblio tags using this authority.
+$sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?");
+$sth->execute($authtypecodefrom);
+my $tags_using_authtype;
+while (my ($tagfield) = $sth->fetchrow) {
+ $tags_using_authtype.= "'".$tagfield."',";
+}
+chop $tags_using_authtype;
+# now, find every biblio using this authority
+my $query = "select bibid,tag,tag_indicator,tagorder,subfieldcode,subfieldorder from marc_subfield_table where tag in ($tags_using_authtype) and subfieldcode='9' and subfieldvalue='$mergefrom'";
+$sth = $dbh->prepare($query);
+$sth->execute;
+my $nbdone;
+# and delete entries before recreating them
+while (my ($bibid,$tag,$tag_indicator,$tagorder,$subfieldcode,$subfieldorder) = $sth->fetchrow) {
+ my $biblio = GetMarcBiblio($bibid);
+ print "BEFORE : ".$biblio->as_formatted."\n" if $verbose;
+ # now, we know what uses the authority & where.
+ # delete all subfields that are in the same tag/tagorder and that are in the authority (& that are not in tab ignore in the biblio)
+ # then recreate them with the new authority.
+ foreach my $subfield (@record_from) {
+ &MARCdelsubfield($bibid,$tag,$tagorder,$subfield->[0]);
+ }
+ &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,'9');
+ foreach my $subfield (@record_to) {
+ &MARCaddsubfield($bibid,$tag,$tag_indicator,$tagorder,$subfield->[0],$subfieldorder,$subfield->[1]);
+ }
+ &MARCaddsubfield($bibid,$tag,$tag_indicator,$tagorder,'9',$subfieldorder,$mergeto);
+ $biblio = GetMarcBiblio($bibid);
+ print "AFTER : ".$biblio->as_formatted."\n" if $verbose;
+ $nbdone++;
+# &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,$subfieldcode,$subfieldorder);
+
+}
+my $timeneeded = gettimeofday - $starttime;
+print "$nbdone authorities done in $timeneeded seconds" unless $noconfirm;
+++ /dev/null
-#!/usr/bin/perl
-# small script that import an iso2709 file into koha 2.0
-
-use strict;
-
-# Koha modules used
-use MARC::File::USMARC;
-use MARC::Record;
-use MARC::Batch;
-use C4::Context;
-use C4::Biblio;
-use Time::HiRes qw(gettimeofday);
-
-use Getopt::Long;
-my ( $input_marc_file, $number) = ('',0);
-my ($confirm);
-GetOptions(
- 'c' => \$confirm,
-);
-
-unless ($confirm) {
- print <<EOF
-
-script to write files for zebra DB reindexing. Once it's done, run zebraidx update biblios
-
-run the script with -c to confirm the reindexing.
-
-EOF
-;#'
-die;
-}
-
-$|=1; # flushes output
-
-my $dbh = C4::Context->dbh;
-my $cgidir = C4::Context->intranetdir."/";
-
-my $starttime = gettimeofday;
-my $sth = $dbh->prepare("select biblionumber from biblio");
-$sth->execute;
-my $i=0;
-while ((my $biblionumber) = $sth->fetchrow) {
- my $record = GetMarcBiblio($biblionumber);
- my $filename = $cgidir."/tmp/BIBLIO".$biblionumber.".iso2709";
- open F,">:utf8", $filename;
- eval {print F $record->as_usmarc(); };
- warn "ERROR: writing biblio $biblionumber failed" if $@;
- close F;
- $i++;
- print "\r$i" unless ($i % 100);
-}
-my $timeneeded = gettimeofday - $starttime;
-print "\n$i MARC record done in $timeneeded seconds\n";
+++ /dev/null
-#!/usr/bin/perl
-use strict;
-use ZOOM;
-
-my $query="Introduction";
-warn "QUERY : $query";
-my $Zconn;
-eval {
- $Zconn = new ZOOM::Connection('localhost:2100/Koha');
-};
-$Zconn->option(cqlfile => "/home/paul/koha.dev/head/zebra/pqf.properties");
-my $q = new ZOOM::Query::CQL2RPN( $query, $Zconn);
-# warn "Q : $q";
-my $rs= $Zconn->search($q);
-my $n = $rs->size()-1;
-print "found ".($n+1)." results";
-for my $i (0..$n) {
- my $rec = $rs->record($i);
- print $rec->render();
-}
-# warn "ERROR : ".$Zconn->errcode();
+++ /dev/null
-#!/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;
-BEGIN {
- # find Koha's Perl modules
- # test carefully before changing this
- use FindBin;
- eval { require "$FindBin::Bin/kohalib.pl" };
-}
-
-# 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;
--- /dev/null
+#!/usr/bin/perl
+
+use ExtUtils::Installed;
+my $instmod = ExtUtils::Installed->new();
+foreach my $module ($instmod->modules()) {
+my $version = $instmod->version($module) || "???";
+ print "$module -- $version\n";
+}
--- /dev/null
+#!/usr/bin/perl -w
+# Remove a perl module
+use ExtUtils::Packlist;
+use ExtUtils::Installed;
+
+$ARGV[0] or die "Usage: $0 Module::Name\n";
+
+my $mod = $ARGV[0];
+
+my $inst = ExtUtils::Installed->new();
+
+foreach my $item (sort($inst->files($mod))) {
+ print "removing $item\n";
+ unlink $item;
+}
+
+my $packfile = $inst->packlist($mod)->packlist_file();
+print "removing $packfile\n";
+unlink $packfile;
+++ /dev/null
-#!/usr/bin/perl
-#-----------------------------------
-# Script Name: rebuild_marc_newframework.pl
-# Script Version: 0.1.0
-# Date: 20/04/2006
-##If you change your framework for marc mapping use this script to recreate marc records in your db
-## Then drop the old framework and install the new one.New frameworks are being introduced with Koha3.0
-##Re-export all your marc and recreate Zebra db.
-##Writen by Tumer Garip tgarip@neu.edu.tr
-
-
-
-use strict;
-BEGIN {
- # find Koha's Perl modules
- # test carefully before changing this
- use FindBin;
- eval { require "$FindBin::Bin/kohalib.pl" };
-}
-
-use C4::Context;
-use C4::Biblio;
-use MARC::Record;
-use MARC::File::USMARC;
-use MARC::File::XML;
-
-my $dbh=C4::Context->dbh;
-use Time::HiRes qw(gettimeofday);
-
-##Write the corresponding new mappings below. this one maps old 090$c$d to new 09o$c$d and 952 holdings of NEU to 95k values
-##Adjust this mapping list to your own needs
-my %mapping_list = (
- '090cd' =>'09ocd',
- '952abcdefpruvxyz'=>'95kkbcfazpw9d4ye',
- );
-
-my $starttime = gettimeofday;
-my $sth=$dbh->prepare("SELECT biblionumber,marc FROM biblioitems ");
-$sth->execute;
-
-my $update=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=?");
-
-my $b=0;
-my $timeneeded;
-while (my ($biblionumber, $marc) = $sth->fetchrow) {
-
-my $record=MARC::File::USMARC::decode($marc);
-
-foreach my $key (keys %mapping_list){
-my $tag=substr($key,0,3);
-my $newtag=substr($mapping_list{$key},0,3);
-my @subf;
-my @newsub;
- for (my $i=3; $i<length($key); $i++){
- push @subf,substr($key,$i,1);
- push @newsub,substr($mapping_list{$key},$i,1);
- }##
-
-foreach my $field ($record->field($tag)){
-my $notnew=1;
-my $addedfield;
- for (my $r=0; $r<@subf; $r++){
- if ($field->subfield($subf[$r]) && $notnew){
- $addedfield=MARC::Field->new($newtag,$field->indicator(1),$field->indicator(2),$newsub[$r]=>$field->subfield($subf[$r]));
- $notnew=0;
- }elsif ($field->subfield($subf[$r])){
- $addedfield->update($newsub[$r]=>$field->subfield($subf[$r]));
- }## a subfield exists
- }## all subfields added
-$record->delete_field($field);
-$record->add_fields($addedfield);
-}##foreach field found
-##Now update-db
-$update->execute($record->as_usmarc,$record->as_xml_record,$biblionumber);
-
-}##foreach $key
- $timeneeded = gettimeofday - $starttime unless ($b % 10000);
- print "$b in $timeneeded s\n" unless ($b % 10000);
- print "." unless ($b % 500);
- $b++;
-}##while biblionumber
-
-##Dont forget to export all new marc records and build your zebra db
-
-
-# $timeneeded = gettimeofday - $starttime unless ($i % 30000);
-# print "$i in $timeneeded s\n" unless ($i % 30000);
-# print "." unless ($i % 500);
-# $i++;
-
-
-$dbh->disconnect();
+++ /dev/null
-#!/usr/bin/perl
-# small script that rebuilds the non-MARC DB
-
-use strict;
-BEGIN {
- # find Koha's Perl modules
- # test carefully before changing this
- use FindBin;
- eval { require "$FindBin::Bin/kohalib.pl" };
-}
-
-# Koha modules used
-# use MARC::File::USMARC;
-use MARC::Record;
-use MARC::Batch;
-use C4::Context;
-use C4::Biblio;
-use Time::HiRes qw(gettimeofday);
-
-use Getopt::Long;
-my ( $input_marc_file, $number) = ('',0);
-my ($version, $confirm,$test_parameter);
-GetOptions(
- 'c' => \$confirm,
- 'h' => \$version,
- 't' => \$test_parameter,
-);
-
-if ($version || (!$confirm)) {
- print <<EOF
-This script rebuilds the non-MARC DB from the MARC values.
-You can/must use it when you change your mapping.
-For example : you decide to map biblio.title to 200$a (it was previously mapped to 610$a) : run this script or you will have strange
-results in OPAC !
-syntax :
-\t./rebuildnonmarc.pl -h (or without arguments => shows this screen)
-\t./rebuildnonmarc.pl -c (c like confirm => rebuild non marc DB (may be long)
-\t-t => test only, change nothing in DB
-EOF
-;
-die;
-}
-
-my $dbh = C4::Context->dbh;
-my $i=0;
-my $starttime = time();
-
-$|=1; # flushes output
-my $starttime = gettimeofday;
-
-#1st of all, find item MARC tag.
-my ($tagfield,$tagsubfield) = &GetMarcFromKohaField("items.itemnumber",'');
-# $dbh->do("lock tables biblio write, biblioitems write, items write, marc_biblio write, marc_subfield_table write, marc_blob_subfield write, marc_word write, marc_subfield_structure write, stopwords write");
-my $sth = $dbh->prepare("SELECT biblionumber FROM biblio");
-$sth->execute;
-# my ($biblionumbermax) = $sth->fetchrow;
-# warn "$biblionumbermax <<==";
-while (my ($biblionumber)= $sth->fetchrow) {
- #now, parse the record, extract the item fields, and store them in somewhere else.
- my $record = GetMarcBiblio($biblionumber);
- my @fields = $record->field($tagfield);
- my @items;
- my $nbitems=0;
- print ".";
- my $timeneeded = gettimeofday - $starttime;
- print "$i in $timeneeded s\n" unless ($i % 50);
- $i++;
- foreach my $field (@fields) {
- my $item = MARC::Record->new();
- $item->append_fields($field);
- push @items,$item;
- $record->delete_field($field);
- $nbitems++;
- }
-# print "$biblionumber\n";
- my $frameworkcode = GetFrameworkCode($biblionumber);
- localNEWmodbiblio($dbh,$record,$biblionumber,$frameworkcode) unless $test_parameter;
-}
-# $dbh->do("unlock tables");
-my $timeneeded = time() - $starttime;
-print "$i MARC record done in $timeneeded seconds\n";
-
-# modified NEWmodbiblio to jump the MARC part of the biblio modif
-# highly faster
-sub localNEWmodbiblio {
- my ($dbh,$record,$biblionumber,$frameworkcode) =@_;
- $frameworkcode="" unless $frameworkcode;
- my $oldbiblio = TransformMarcToKoha($dbh,$record,$frameworkcode);
- C4::Biblio::_koha_modify_biblio( $dbh, $oldbiblio );
- C4::Biblio::_koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
- return 1;
-}
--- /dev/null
+#!/usr/bin/perl
+# check the current SAX Parser
+use XML::SAX::ParserFactory;
+$parser = XML::SAX::ParserFactory->parser();
+print "$parser\n";
+
--- /dev/null
+#!/usr/bin/perl
+use XML::SAX;
+my $parser = XML::SAX::ParserFactory->parser(
+Handler => MySAXHandler->new
+);
+binmode STDOUT, ":utf8";
+print "\x{65}\x{301}\n";
+use Encode; $parser->parse_string(encode_utf8("<xml>\x{65}\x{301}</xml>"));
+$parser->parse_string("<xml>\xEF\xBB\xBF\x{65}\x{301}</xml>");
+
+package MySAXHandler;
+
+use base qw(XML::SAX::Base);
+sub start_document {
+ my ($self, $doc) = @_;
+ # process document start event
+}
+
+sub start_element {
+ my ($self, $el) = @_;
+ # process element start event
+}
+++ /dev/null
-#!/usr/bin/perl -w
-
-use strict;
-BEGIN {
- # find Koha's Perl modules
- # test carefully before changing this
- use FindBin;
- eval { require "$FindBin::Bin/kohalib.pl" };
-}
-use C4::Context;
-use Getopt::Long;
-
-my %opt = ();
-GetOptions(
- \%opt,
- qw/head_dir=s rel_2_2_dir=s help/
-) or die "\nHouston, we got a problem\n";
-
-if (exists $opt{help}) {
- print <<FIN;
-Sync the Koha plugin with the appropriate files from HEAD. Assumes
-that you've set up your Koha install to use CVS symlinked to the
-normal locations.
-
-Usage: sync_koha_plugin.pl --head_dir=<cvs head directory>
- --rel_2_2_dir=<cvs rel_2_2 directory>
- [--help]
-
---head_dir: is the directory where your Koha HEAD cvs is checked out.
-
---rel_2_2_dir: is the directory where your Koha rel_2_2 cvs is checked
-out and symlinked to your Koha install directories.
-
---help: show this help
-
-FIN
-
- exit(0);
-}
-# Configurable Variables
-foreach my $option (qw/head_dir rel_2_2_dir/) {
- if (not exists $opt{$option}) {
- die 'option "', $option, '" is mandatory', "\n";
- }
-
- if (not -d $opt{$option}) {
- die '"', $opt{$option}, '" must be an existing directory', "\n";
- }
-
- if (not $opt{$option} =~ m{^/}) {
- die '--', $option, ' must be an absolute path', "\n";
- }
-}
-
-## Modules
-system(
- 'cp',
- $opt{head_dir}.'/C4/Biblio.pm',
- $opt{rel_2_2_dir}.'/C4/'
-);
-system(
- 'cp',
- $opt{head_dir}.'/C4/Context.pm',
- $opt{rel_2_2_dir}.'/C4/'
-);
-system(
- 'cp',
- $opt{head_dir}.'/C4/SearchMarc.pm',
- $opt{rel_2_2_dir}.'/C4/'
-);
-system(
- 'cp',
- $opt{head_dir}.'/C4/Log.pm',
- $opt{rel_2_2_dir}.'/C4/'
-);
-
-system(
- 'cp',
- $opt{head_dir}.'/C4/Review.pm',
- $opt{rel_2_2_dir}.'/C4/'
-);
-system(
- 'cp',
- $opt{head_dir}.'/misc/plugin/Search.pm',
- $opt{rel_2_2_dir}.'/C4/'
-);
-
-## Intranet
-system(
- 'cp',
- $opt{head_dir}.'/cataloguing/addbiblio.pl',
- $opt{rel_2_2_dir}.'/acqui.simple/addbiblio.pl'
-);
-system(
- 'cp',
- $opt{head_dir}.'/cataloguing/additem.pl',
- $opt{rel_2_2_dir}.'/acqui.simple/'
-);
-system(
- 'cp',
- $opt{head_dir}.'/catalogue/detail.pl',
- $opt{rel_2_2_dir}.'/'
-);
-system(
- 'cp',
- $opt{head_dir}.'/catalogue/MARCdetail.pl',
- $opt{rel_2_2_dir}.'/'
-);
-system(
- 'cp',
- $opt{head_dir}.'/catalogue/ISBDdetail.pl',
- $opt{rel_2_2_dir}.'/'
-);
-
-# OPAC
-system(
- 'cp',
- $opt{head_dir}.'/opac/opac-detail.pl',
- $opt{rel_2_2_dir}.'/opac/'
-);
-system(
- 'cp',
- $opt{head_dir}.'/opac/opac-MARCdetail.pl',
- $opt{rel_2_2_dir}.'/opac/'
-);
-system(
- 'cp',
- $opt{head_dir}.'/opac/opac-ISBDdetail.pl',
- $opt{rel_2_2_dir}.'/opac/'
-);
-
-## Add the symlink necessary due to changes in the dir structure
-system(
- 'ln',
- '-s',
- $opt{rel_2_2_dir}.'/koha-tmpl/intranet-tmpl/npl/en/acqui.simple',
- $opt{rel_2_2_dir}.'/koha-tmpl/intranet-tmpl/npl/en/cataloguing'
-);
-
-## Add the 'record.abs' symlink
-system(
- 'ln',
- '-s',
- $opt{head_dir}.'/misc/zebra/usmarc/collection.abs',
- $opt{head_dir}.'/misc/zebra/usmarc/record.abs'
-);
-
-## Create symlink from intranet/zebra to head zebra directory
-system(
- 'ln',
- '-s',
- $opt{head_dir}.'/misc/zebra/usmarc',
- C4::Context->config("intranetdir").'/zebra'
-);
-
-print "Finished\n\nRemember, you still need to:
-
-1. Edit moredetail.tmpl and detail.tmpl to allow for deletions
-
-2. add <option value=''>Relevance</option> to the search
- pages to sort by relevance by default
-
-\n";
-
+++ /dev/null
-#!/usr/bin/perl
-# script that correct the marcxml from in biblioitems
-# Written by TG on 10/04/2006
-use strict;
-BEGIN {
- # find Koha's Perl modules
- # test carefully before changing this
- use FindBin;
- eval { require "$FindBin::Bin/kohalib.pl" };
-}
-
-# Koha modules used
-
-use C4::Context;
-use C4::Biblio;
-use MARC::Record;
-use MARC::File::USMARC;
-use MARC::File::XML;
-use Time::HiRes qw(gettimeofday);
-
-my $starttime = gettimeofday;
-my $timeneeded;
-my $dbh = C4::Context->dbh;
-my $sth=$dbh->prepare("select biblionumber,marc from biblioitems ");
- $sth->execute();
- $dbh->do("LOCK TABLES biblioitems WRITE");
-my $i=0;
-my $sth2 = $dbh->prepare("UPDATE biblioitems set marcxml=? where biblionumber=?" );
-
-
-while (my ($biblionumber,$marc)=$sth->fetchrow ){
-
- my $record = MARC::File::USMARC::decode($marc);
-my $xml=$record->as_xml_record();
-$sth2->execute($xml,$biblionumber);
-
- print "." unless ($i % 100);
-$timeneeded = gettimeofday - $starttime unless ($i % 5000);
- print "$i records in $timeneeded s\n" unless ($i % 5000);
- $i++;
-}
-$dbh->do("UNLOCK TABLES ");
-$timeneeded = gettimeofday - $starttime ;
- print "$i records in $timeneeded s\n" ;
-
-END;
projects / koha.git / commitdiff