koha-cvs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Koha-cvs] koha/misc export_marc_biblios.pl build_authorit... [rel_TG]


From: Tumer Garip
Subject: [Koha-cvs] koha/misc export_marc_biblios.pl build_authorit... [rel_TG]
Date: Mon, 02 Apr 2007 00:52:00 +0000

CVSROOT:        /sources/koha
Module name:    koha
Branch:         rel_TG
Changes by:     Tumer Garip <tgarip1957>        07/04/02 00:52:00

Modified files:
        misc           : export_marc_biblios.pl 
Added files:
        misc           : build_authorities.pl bulkauthimport_marc.pl 
                         bulkbiblioimport_marc.pl 
                         bulkitemsimport_marc.pl bulkkohaimport_xml.pl 
                         export_marc_authorities.pl 
        misc/migration_tools: build_marc_items.pl 
                              separate_items_from_biblios.pl 

Log message:
        Utilities to upgrade from rel2_2 DB and create new separated 
biblio+holdings marc db

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/misc/export_marc_biblios.pl?cvsroot=koha&only_with_tag=rel_TG&r1=1.1.2.1&r2=1.1.2.2
http://cvs.savannah.gnu.org/viewcvs/koha/misc/build_authorities.pl?cvsroot=koha&only_with_tag=rel_TG&rev=1.1.2.1
http://cvs.savannah.gnu.org/viewcvs/koha/misc/bulkauthimport_marc.pl?cvsroot=koha&only_with_tag=rel_TG&rev=1.1.2.1
http://cvs.savannah.gnu.org/viewcvs/koha/misc/bulkbiblioimport_marc.pl?cvsroot=koha&only_with_tag=rel_TG&rev=1.1.2.1
http://cvs.savannah.gnu.org/viewcvs/koha/misc/bulkitemsimport_marc.pl?cvsroot=koha&only_with_tag=rel_TG&rev=1.1.2.1
http://cvs.savannah.gnu.org/viewcvs/koha/misc/bulkkohaimport_xml.pl?cvsroot=koha&only_with_tag=rel_TG&rev=1.1.2.1
http://cvs.savannah.gnu.org/viewcvs/koha/misc/export_marc_authorities.pl?cvsroot=koha&only_with_tag=rel_TG&rev=1.1.2.1
http://cvs.savannah.gnu.org/viewcvs/koha/misc/migration_tools/build_marc_items.pl?cvsroot=koha&only_with_tag=rel_TG&rev=1.1.2.1
http://cvs.savannah.gnu.org/viewcvs/koha/misc/migration_tools/separate_items_from_biblios.pl?cvsroot=koha&only_with_tag=rel_TG&rev=1.1.2.1

Patches:
Index: export_marc_biblios.pl
===================================================================
RCS file: /sources/koha/koha/misc/Attic/export_marc_biblios.pl,v
retrieving revision 1.1.2.1
retrieving revision 1.1.2.2
diff -u -b -r1.1.2.1 -r1.1.2.2
--- export_marc_biblios.pl      26 Mar 2007 22:38:10 -0000      1.1.2.1
+++ export_marc_biblios.pl      2 Apr 2007 00:51:59 -0000       1.1.2.2
@@ -1,5 +1,5 @@
 #!/usr/bin/perl
-## This script allows you to export a rel_2_2 bibliographic db in 
+## This script allows you to export a authorities db in 
 #MARC21 format from the command line.
 #
 use strict;

Index: build_authorities.pl
===================================================================
RCS file: build_authorities.pl
diff -N build_authorities.pl
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ build_authorities.pl        2 Apr 2007 00:51:59 -0000       1.1.2.1
@@ -0,0 +1,250 @@
+#!/usr/bin/perl
+# script that rebuild thesaurus from biblio table.
+
+use strict;
+
+# Koha modules used
+use MARC::File::XML;
+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 Encode;
+use Getopt::Long;
+use Data::Dumper;
+my ( $input_marc_file, $number) = ('',0);
+my ($version, $verbose, $delete, $confirm, $howmany);
+GetOptions(
+    'h' => \$version,
+    'd' => \$delete,
+    'v' => \$verbose,
+    'c' => \$confirm,
+# this $howmany parameter & other commented code was here to enable 
incremental building of the authorities, but it does not work well.
+#      'n:s' => \$howmany,
+);
+
+if ($version || (!$confirm)) {
+       print <<EOF
+Script to recreate a authority tables into Koha from biblios
+parameters :
+\th : this version/help screen
+\tc : confirm. this script run without -c shows this help, pls run it with -c 
to execute it
+\tv : verbose mode.
+\td : delete the thesaurus before doing work. This deleting is smart enough to 
delete only the categories to rebuild. However, it is quite slow. Don''t be 
surprised...
+
+BEFORE RUNNING this script, you MUST edit it & adapt the %whattodo hash to fit 
your needs. It contains :
+* as key, the code of the authority to be created. It's the one you've choosen 
(or will choose) in Koha >> parameters >> thesaurus structure >> add). It can 
be whatever you want. NP/CO/NG/TI/NC in CVS refers to UNIMARC french RAMEAU 
category codes.
+* in values a sub-hash with the following values :
+\ttaglist : the list of MARC tags using this authority
+\tkey : the list of MARC subfields used as key for authority. 2 entries in 
biblio having the same key will be considered as the same.
+\tother : the list of MARC subfields not used as key, but to be copied in 
authority.
+\tauthtag : the field in authority that will be reported in biblio. Remember 
that all subfields in tag "authtag" will be reported in the same subfield of 
the biblio (in MARC tags that are in "taglist")
+
+
+Any warning will be stored in the warnings.log file.
+EOF
+;#'
+die;
+}
+
+my $dbh = C4::Context->dbh;
+
+
+my %whattodo = (AUTH =>        {
+                               # the list of MARC tags using this authority
+                               taglist => "100|700",
+                               # the list of MARC subfields used as key for 
authority. 2 entries in biblio having the same key will be considered as the 
same.
+                               key             => "a|d",
+                               # the list of MARC subfields not used as key, 
but to be copied in authority.
+                               other   => "",
+                               # the field in authority that will be reported 
in biblio. Remember that all subfields in tag "authtag" will be reported in the 
same subfield of the biblio (in MARC tags that are in "taglist")
+                               authtag => "100",
+                       },
+               
+               CORP => {taglist        => "110|710",
+                               key             => "a|b",
+                               other   => "",
+                               authtag => "110",
+                       },
+               ESUB => {       taglist => "650|651|655|656|657",
+                               key             => "a|x|v|y|z",
+                               other   => "",
+                               authtag => "150",
+                       },
+               TSUB => {       taglist => "690",
+                               key             => "a|x|v|y|z",
+                               other   => "",
+                               authtag => "150",
+                       },
+       
+               );
+my %authorities;
+
+open WARNING_FILE,">:utf8","warnings.log";
+
+my $field_list;
+my $category_list;
+foreach (keys %whattodo) {
+       $field_list .= $whattodo{$_}->{taglist}.'|';
+       $category_list.= "'".$_."',"
+}
+chop $field_list;
+
+if ($delete) {
+
+       print "deleting AUTHORITIES \n";
+       $dbh->do("delete from auth_header where authtypecode in 
($category_list)");
+#      die;
+}
+my $existing=$dbh->prepare("select authid,authtypecode from  auth_header where 
authtypecode=?");
+my $delsth=$dbh->prepare("delete from auth_header where authid=?");
+my $starttime = gettimeofday;
+my $i=1;
+my $z=1;
+foreach my $DOauthtype (keys %whattodo) {
+$existing->execute($DOauthtype);
+my $modified;
+my $alreadydone;
+my $totalskipped;
+print "reading authorities.. \n";
+while (my ($authid,$authtypecode) = $existing->fetchrow) {
+       my $authrecord = XMLgetauthorityhash($dbh,$authid);
+my $DOauthtag = $whattodo{$DOauthtype}->{authtag};
+my $DOkey = $whattodo{$DOauthtype}->{key};
+
+my $authPrimaryKey;
+                       
+                                       foreach my $sub(split '\|',$DOkey) {
+                                       my 
$term=XML_readline_onerecord($authrecord,"","",$DOauthtag,$sub);
+                                       $term=~s/^\s+|\s+$//g ;
+                                       $term=~ 
s/(\.|\?|\;|\=|\/|\\|\:|\!|,|\-|\"|\(|\)|\[|\]|\{|\}|\/)//g;
+                                       $term=~s/\s\s/\s/g;
+                                       $authPrimaryKey .= join('|',$term)."|" 
if $term;
+                                       }
+                                       
+                               $authPrimaryKey=uc($authPrimaryKey) if 
$authPrimaryKey;
+                               if 
(!$authorities{$DOauthtype}->{$authPrimaryKey} && $authPrimaryKey) {
+                                       
$authorities{$DOauthtype}->{$authPrimaryKey}->{authid} = $authid;
+                                       
$authorities{$DOauthtype}->{$authPrimaryKey}->{record} = $authrecord;
+                                       
$authorities{$DOauthtype}->{$authPrimaryKey}->{modified} = 0;
+                                       $z++;
+                               } 
+                       
+}#while authid
+}#foreach authtype in authorities
+print "received authorities $z \n";
+$|=1; # flushes output
+
+my $sth = $dbh->prepare("select biblionumber from biblio");
+$sth->execute;
+
+
+my $modified;
+my $alreadydone;
+my $totalskipped;
+while (my ($biblionumber) = $sth->fetchrow) {
+       my $record = XMLgetbibliohash($dbh,$biblionumber);
+       $modified=0;
+       $i++;
+       
+       print " $i in ".(gettimeofday-$starttime)." s\n" unless ($i % 100);
+       
+       my $totdone=0;
+               foreach my $DOauthtype (keys %whattodo) {
+                       my $DOtaglist = $whattodo{$DOauthtype}->{taglist};
+                       my $DOkey = $whattodo{$DOauthtype}->{key};
+                       my $DOother = $whattodo{$DOauthtype}->{other};
+                       my $DOauthtag = $whattodo{$DOauthtype}->{authtag};
+                               # try to find the authority in 
+                               # build the "key"
+                               my $authPrimaryKey;
+                               foreach my $sub(split '\|',$DOkey) {
+                                       my 
$term=XML_readline_onerecord($record,"","",$DOauthtag,$sub);
+                                       $term=~s/^\s+|\s+$//g ;
+                                       $term=~ 
s/(\.|\?|\;|\=|\/|\\|\:|\!|,|\-|\"|\(|\)|\[|\]|\{|\}|\/)//g;
+                                       $term=~s/\s\s/\s/g;
+                                       $authPrimaryKey .= join('|',$term)."|" 
if $term;
+                               }##foreach $DOkey
+                               
+                                       $authPrimaryKey=uc($authPrimaryKey) if 
$authPrimaryKey;
+
+                               
+                               # if authority exist, check it can't be 
completed by subfields not previously seen.
+                               # otherwise, create if with whatever available.
+                               if 
($authorities{$DOauthtype}->{$authPrimaryKey} &&  $authPrimaryKey) {
+                                       # check that the existing authority has 
all the datas. Otherwise, add them, but don't modify already parsed biblios.
+                                       # at the end of the script, all 
authorities will be updated. So, the "merge_authority.pl" tool can be used to 
update all biblios.
+                                       foreach my $subfieldtotest (split 
'\|',$DOother) {
+                                                       my 
$existsubauth=XML_readline_onerecord($authorities{$DOauthtype}->{$authPrimaryKey}->{record},"","",$DOauthtag,$subfieldtotest);
+                                                       my 
$existsub=XML_readline_onerecord($record,"","",$DOauthtag,$subfieldtotest);
+                                                       
$existsub=Encode::encode('utf8',$existsub);
+                                                       
$existsubauth=Encode::encode('utf8',$existsubauth);
+                                                       if ($existsubauth ne 
$existsub && $existsub && $existsubauth) {
+                                                               print 
WARNING_FILE "========\nERROR ON $i $subfieldtotest authorities seems to 
differ, can't choose between : \n".$existsubauth." \n====== AND ======\n 
".$existsub."\n=======\n";
+                                                               print "W";
+                                                       }
+                                                       #
+                                                       if (!$existsubauth && 
$existsub) {
+                                                               
XML_writeline($authorities{$DOauthtype}->{$authPrimaryKey}->{record},"",$existsub,"",$DOauthtag,$subfieldtotest);
+                                                               
+                                                               
$authorities{$DOauthtype}->{$authPrimaryKey}->{modified} = 1;
+                                                       }
+                                               
+                                       }#each subfieltotest
+                               } elsif( $authPrimaryKey) {
+                                       my $authrecord = "<record><leader>     
nz||a22     o||4500</leader><controlfield tag='001'></controlfield><datafield 
tag='100' ind1='' ind2='' code='a'></datafield></record>";##dummyrecord
+                                       
$authrecord=XML_xml2hash_onerecord($authrecord);
+                                       my $authfield;
+                                       foreach my $sub (split '\|',$DOkey) {
+                                       my 
$existsub=XML_readline_onerecord($record,"","",$DOauthtag,$sub);
+                                       
$existsub=Encode::encode('utf8',$existsub);                                     
        
+                                       
XML_writeline($authrecord,"",$existsub,"",$DOauthtag,$sub) if $existsub;
+                                       }
+                                       foreach my $sub(split '\|',$DOother) {
+                                       my 
$existsub=XML_readline_onerecord($record,"","",$DOauthtag,$sub);                
                                     
+                                       
$existsub=Encode::encode('utf8',$existsub);
+                                       
XML_writeline($authrecord,"",$existsub,"",$DOauthtag,$sub) if $existsub;
+                               
+                                       }
+                                       my $authid = 
AUTHaddauthority($dbh,$authrecord,'',$DOauthtype);
+                                       print "AUTHORITY $authid  added \n";
+                                       
$authorities{$DOauthtype}->{$authPrimaryKey}->{authid} = $authid;
+                                       
$authorities{$DOauthtype}->{$authPrimaryKey}->{record} = $authrecord;
+                                       
$authorities{$DOauthtype}->{$authPrimaryKey}->{modified} = 0;
+                               
XML_writeline($record,"authid",$authid,"biblios");
+                               $modified++;
+                               }
+                               
+                       
+               }
+       
+#
+# NC
+#
+# OK, done, now store modified biblio if it has been modified
+       if ($modified) {
+               NEWnewbiblio($dbh,$record);
+               print "$modified";
+       } else {
+               # if $totalskipped is not null, we are in a biblio that has no 
authorities entry, but inside an already done part of the job
+                       print "*";
+       }
+}
+
+#
+# now, parse authorities & modify them if they have been modified/completed by 
a subfield not existing on the 1st biblio using this authority.
+#
+foreach my $authtype (keys %whattodo) {
+       foreach my $authentry (keys %{$authorities{$authtype}}) {
+               print "AUTH : $authentry\n" if 
$authorities{$authtype}->{$authentry}->{modified};
+               
+               
AUTHaddauthority($dbh,$authorities{$authtype}->{$authentry}->{record},$authorities{$authtype}->{$authentry}->{authid},$authtype)
 if $authorities{$authtype}->{$authentry}->{modified};
+       }
+}
+#
+my $timeneeded = gettimeofday - $starttime;
+print "$i entries done in $timeneeded seconds (".($i/$timeneeded)." per 
second)\n";
+close WARNING_FILE;
\ No newline at end of file

Index: bulkauthimport_marc.pl
===================================================================
RCS file: bulkauthimport_marc.pl
diff -N bulkauthimport_marc.pl
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ bulkauthimport_marc.pl      2 Apr 2007 00:51:59 -0000       1.1.2.1
@@ -0,0 +1,82 @@
+#!/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::File::XML;
+use MARC::Record;
+use MARC::Batch;
+use C4::Biblio;
+use C4::Context;
+use C4::AuthoritiesMarc;
+use Time::HiRes qw(gettimeofday);
+
+use Getopt::Long;
+my $input_marc_file ="");
+my ($version, $delete, $test_parameter,$auth, $verbose);
+GetOptions(
+    'file:s'    => \$input_marc_file,
+     'h:s'    =>\$version,
+    'd' => \$delete,
+    't' => \$test_parameter,
+    'auth:s' => \$auth,
+    '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/import : the file to import
+\tv : verbose mode. 1 means "some infos", 2 means "MARC dumping"
+\tt : test mode : parses the file, saying what he would do, but doing nothing.
+\tauth : Authority type. If not specified attempts to read it from record
+\d : delete EVERYTHING related to authorities in koha-DB before import   :
+NOTE: If auhority files contains authid's they will be retained and the same 
numbered authorities will be replaced
+
+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 : ./bulkauthimport.pl -file /home/paul/koha.dev/local/npl -v 1
+EOF
+;#'
+die;
+}
+
+my $dbh = C4::Context->dbh;
+
+if ($delete) {
+       print "deleting authorities\n";
+       $dbh->do("truncate table auth_header");
+       
+}
+if ($test_parameter) {
+       print "TESTING MODE ONLY\n    DOING NOTHING\n===============\n";
+}
+
+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++;
+my $xml=MARC::File::XML::record($record);
+my $xmlhash=XML_xml2hash_onerecord($xml);
+        $auth=XML_readline_onerecord($xmlhash,"authtypecode","authorities") 
unless $auth;
+       my $authid=XML_readline_onerecord($xmlhash,"authid","authorities")
+       if (!$auth||$auth eq""){
+       print "Records do not have authoritytype define with -auth parameter";
+       die;
+       }
+       ## now, create authority with AUTHadd call.
+       unless ($test_parameter) {
+               $authid = AUTHaddauthority($dbh,$xmlhash,$authid,$authtypecode);
+               warn "ADDED authority NB $authid in DB\n" if $verbose;
+       }
+}
+my $timeneeded = gettimeofday - $starttime;
+print "$i MARC record done in $timeneeded seconds";

Index: bulkbiblioimport_marc.pl
===================================================================
RCS file: bulkbiblioimport_marc.pl
diff -N bulkbiblioimport_marc.pl
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ bulkbiblioimport_marc.pl    2 Apr 2007 00:51:59 -0000       1.1.2.1
@@ -0,0 +1,76 @@
+#!/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::File::XML;
+use MARC::Record;
+use MARC::Batch;
+use C4::Biblio;
+use C4::Context;
+use Time::HiRes qw(gettimeofday);
+
+use Getopt::Long;
+my ($input_marc_file= "");
+my ($version, $delete, $test_parameter,$frameworkcode, $verbose);
+GetOptions(
+    'file:s'    => \$input_marc_file,
+     'h:s'    =>\$version,
+    'd' => \$delete,
+    't' => \$test_parameter,
+    'frame:s' => \$frameworkcode,
+    '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/import : the file to import
+\tv : verbose mode. 1 means "some infos", 2 means "MARC dumping"
+\tt : test mode : parses the file, saying what he would do, but doing nothing.
+\tframe : Frameworkcode. If not specified attempts to read it from record
+\d : delete EVERYTHING related to biblios in koha-DB before import   :
+NOTE: If  files contains biblionumbers they will be retained and the same 
numbered biblios will be replaced
+
+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 : ./bulkbiblioimport_marc.pl -file 
/home/paul/koha.dev/local/npl/biblios.mrc -v 1
+EOF
+;#'
+die;
+}
+
+my $dbh = C4::Context->dbh;
+
+if ($delete) {
+       print "deleting biblio\n";
+       $dbh->do("truncate table biblio");
+       
+}
+if ($test_parameter) {
+       print "TESTING MODE ONLY\n    DOING NOTHING\n===============\n";
+}
+
+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++;
+my $xml=MARC::File::XML::record($record);
+my $xmlhash=XML_xml2hash_onerecord($xml);
+
+       ## now, create authority with NEWnew call.
+       unless ($test_parameter) {
+               my $biblionumber =NEWnewbiblio($dbh,$xmlhash,$frameworkcode);
+               warn "ADDED biblionumber NB $biblionumber in DB\n" if $verbose;
+       }
+}
+my $timeneeded = gettimeofday - $starttime;
+print "$i MARC record done in $timeneeded seconds";

Index: bulkitemsimport_marc.pl
===================================================================
RCS file: bulkitemsimport_marc.pl
diff -N bulkitemsimport_marc.pl
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ bulkitemsimport_marc.pl     2 Apr 2007 00:51:59 -0000       1.1.2.1
@@ -0,0 +1,78 @@
+#!/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::File::XML;
+use MARC::Record;
+use MARC::Batch;
+use C4::Biblio;
+use C4::Context;
+use Time::HiRes qw(gettimeofday);
+
+use Getopt::Long;
+my $input_marc_file = '';
+my ($version, $delete, $test_parameter, $verbose);
+GetOptions(
+    'file:s'    => \$input_marc_file,
+     'h:s'    =>\$version,
+    'd' => \$delete,
+    't' => \$test_parameter,
+    '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/import : the file to import
+\tv : verbose mode. 1 means "some infos", 2 means "MARC dumping"
+\tt : test mode : parses the file, saying what he would do, but doing nothing.
+\d : delete EVERYTHING related to authorities in koha-DB before import   :
+NOTE: If items files do not contain biblionumbers they will not be imported
+
+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 : ./bulkitemsimport_marc.pl -file 
/home/paul/koha.dev/local/npl/biblios.mrc -v 1
+EOF
+;#'
+die;
+}
+
+my $dbh = C4::Context->dbh;
+
+if ($delete) {
+       print "deleting items\n";
+       $dbh->do("truncate table items");
+       
+}
+if ($test_parameter) {
+       print "TESTING MODE ONLY\n    DOING NOTHING\n===============\n";
+}
+
+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++;
+my $xml=MARC::File::XML::record($record);
+my $xmlhash=XML_xml2hash_onerecord($xml);
+my $biblionumber=XML_readline_onerecord($xmlhash,"biblionumber","holdings");
+   if (!$biblionumber){
+     print "NO biblionumber in record cannot continue";
+     die;
+   }
+       ## now, create authority with NEWnew call.
+       unless ($test_parameter) {
+               my $itemnumber = NEWnewitem($dbh,$xmlhash,$biblionumber);
+               warn "ADDED itemnumber NB $itemnumber in DB\n" if $verbose;
+       }
+}
+my $timeneeded = gettimeofday - $starttime;
+print "$i MARC record done in $timeneeded seconds";

Index: bulkkohaimport_xml.pl
===================================================================
RCS file: bulkkohaimport_xml.pl
diff -N bulkkohaimport_xml.pl
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ bulkkohaimport_xml.pl       2 Apr 2007 00:51:59 -0000       1.1.2.1
@@ -0,0 +1,89 @@
+#!/usr/bin/perl
+# small script that import an iso2709 file into koha 2.0
+
+use strict;
+
+# Koha modules used
+
+use C4::Biblio;
+use C4::Context;
+use Time::HiRes qw(gettimeofday);
+
+use Getopt::Long;
+my $input_marc_file= "";
+my ($version, $delete, $test_parameter,$frameworkcode, $verbose);
+GetOptions(
+    'file:s'    => \$input_marc_file,
+     'h:s'    =>\$version,
+    'd:s' => \$delete,
+    't' => \$test_parameter,
+    'frame:s' => \$frameworkcode,
+    '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/import : the file to import
+\tv : verbose mode. 1 means "some infos", 2 means "MARC dumping"
+\tt : test mode : parses the file, saying what he would do, but doing nothing.
+\tframe : Frameworkcode. If not specified attempts to read it from record
+\d : delete EVERYTHING related to biblios in koha-DB before import   :
+NOTE: If  files contains biblionumbers they will be retained and the same 
numbered biblios will be replaced
+
+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 : ./bulkbiblioimport_marc.pl -file 
/home/paul/koha.dev/local/npl/biblios.mrc -v 1
+EOF
+;#'
+die;
+}
+
+my $dbh = C4::Context->dbh;
+
+if ($delete) {
+       print "deleting biblio\n";
+       $dbh->do("truncate table biblio");
+       print "deleting items\n";
+       $dbh->do("truncate table items");
+       
+}
+if ($test_parameter) {
+       print "TESTING MODE ONLY\n    DOING NOTHING\n===============\n";
+}
+
+my $starttime = gettimeofday;
+open INPUT, "<:utf8","$input_marc_file" || print "no infile $input_marc_file";
+my $i=0;
+my $xml;
+ while ( <INPUT> ) {
+if (m/\<kohacollection\>/ || m/\<\/kohacollection\>/){next;}
+
+ $xml.=$_;
+       if (m/\<\/koharecord\>/){
+       $xml=createrecord($xml);
+       }#koharecord
+}#while
+close(INPUT);
+my $timeneeded = gettimeofday - $starttime;
+print "$i KOHA records done in $timeneeded seconds";
+
+sub createrecord{
+my $xmlin=shift;
+my $xmlhash=XML_xml2hash($xmlin);
+       my ($biblio,@items)=XML_separate($xmlhash);
+       ## now, create biblios with NEWnew call.
+       unless ($test_parameter) {
+       $i++;
+               my $biblionumber = NEWnewbiblio($dbh,$biblio,$frameworkcode);
+               print "ADDED biblionumber NB $biblionumber in DB\n" if $verbose;
+               foreach my $item (@items){
+               my $itemnumber = NEWnewitem($dbh,$item,$biblionumber);
+               print "ADDED itemnumber NB $itemnumber in DB\n" if $verbose;
+               }
+       }##test
+       return "";
+}
\ No newline at end of file

Index: export_marc_authorities.pl
===================================================================
RCS file: export_marc_authorities.pl
diff -N export_marc_authorities.pl
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ export_marc_authorities.pl  2 Apr 2007 00:51:59 -0000       1.1.2.1
@@ -0,0 +1,34 @@
+#!/usr/bin/perl
+## This script allows you to export a authorities db in 
+#MARC21 format from the command line.
+#
+use strict;
+
+use C4::Auth;
+use MARC::Record;
+use MARC::File::USMARC;
+use MARC::File::XML;
+use Getopt::Long;
+my  $out_marc_file;
+
+GetOptions(
+    'file:s'    => \$out_marc_file,
+   
+);
+my $record;
+open(OUT,">:utf8", $out_marc_file) or die $!;
+
+       
+my $dbh=C4::Context->dbh;
+       my $sth;
+               $sth=$dbh->prepare("select marcxml from auth_header  order by 
authid ");
+               $sth->execute();
+       
+       while (my ($xml) = $sth->fetchrow) {
+       eval{
+        $record=MARC::Record->new_from_xml( $xml,"UTF-8");
+       };
+       if ($@){next;}
+               print OUT $record->as_usmarc;
+       }
+close(OUT);

Index: migration_tools/build_marc_items.pl
===================================================================
RCS file: migration_tools/build_marc_items.pl
diff -N migration_tools/build_marc_items.pl
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ migration_tools/build_marc_items.pl 2 Apr 2007 00:51:59 -0000       1.1.2.1
@@ -0,0 +1,112 @@
+#!/usr/bin/perl 
+#-----------------------------------
+# Script Name: build_marc_items.pl
+# Script Version: 4.1.0
+# Date:  01/04/2007
+##I Utility function to export items from a rel2_2 as separete marc records
+##Writen by Tumer Garip address@hidden
+
+
+
+use strict;
+
+use C4::Context;
+use C4::Biblio;
+use MARC::Record;
+use MARC::File::USMARC;
+use MARC::Field;
+my $dbh=C4::Context->dbh;
+use Time::HiRes qw(gettimeofday);
+use Getopt::Long;
+my $outitems;
+GetOptions(
+     'outitems:s' => \$outitems,
+);
+if (!$outitems ) {
+       print <<EOF
+parameters :
+\toutitems : file to create for items marc from a rel2_2 DB
+
+IMPORTANT : this script has a mapping structure to map items to marc. 
+It assumes the default mapping this version installs.
+ Change as necessary to match what you will be defining or defined if you like.
+
+SAMPLE : ./build_marc_items.pl  -outitems holdings.mrc
+EOF
+;#'
+die;
+}
+##Adjust this mapping list to your own needs### IMPORTANT
+my %mapping_list = (   
+        itemnumber           =>'001',     biblionumber     => '004',
+            multivolumepart      => '952i',
+            barcode          => '952p',
+            booksellerid         =>'952e',     dateaccessioned  => '008',
+            homebranch           => '952a',     holdingbranch    => '952b',
+            price                => '952u',     replacementprice => '952v',
+            replacementpricedate =>'952w' , datelastseen     => '005',
+            multivolume          => '952j',     stack            =>'952f',
+            itemlost             => '9521',     wthdrawn         =>'9520',
+            paidfor              => '952r',     itemnotes        => '952z',
+            itemcallnumber       =>'952o',      notforloan       => '952y',
+            location             =>'952g',     Cutterextra      =>'952m',
+       );
+
+open(OUTITEMS,">:utf8","$outitems") ;
+my $starttime = gettimeofday;
+my $sth=$dbh->prepare("SELECT * FROM items  order by itemnumber");
+$sth->execute;
+
+
+my $b=0;
+my $timeneeded;
+while (my $data = $sth->fetchrow_hashref) {     
+my $record=MARC::Record->new();
+my %prevtag;
+my $addedfield;
+foreach my $key (keys %mapping_list){
+  if($data->{$key}){
+my $newtag=substr($mapping_list{$key},0,3);
+my $newsub=substr($mapping_list{$key},3,1);
+       if ($key eq 'datelastseen'){
+       my $datelastseen=$data->{$key};
+       $datelastseen=~s /\-//g;
+       $datelastseen.="000000.0"; ###MARC field 005 requires this
+       $data->{$key}=$datelastseen;
+       }elsif($key eq 'dateaccessioned'){
+       my $dateaccessioned=$data->{$key};
+               $dateaccessioned=~s /\-//g;
+               $dateaccessioned=substr($dateaccessioned,2,6);
+               $dateaccessioned.="s        xxu||||| |||| 00| 0 xxx d";
+       $data->{$key}=$dateaccessioned;## MARC 008 requires this
+       }
+          
+               if ($newsub && !$prevtag{$newtag}){
+               
$addedfield=MARC::Field->new($newtag,"","",$newsub=>$data->{$key});
+               $record->insert_fields_ordered($addedfield) ;
+               }elsif (!$newsub && !$prevtag{$newtag}){
+               $addedfield=MARC::Field->new($newtag,$data->{$key});
+               $record->insert_fields_ordered($addedfield) ;
+               }elsif($prevtag{$newtag}){
+               $record->field($newtag)->update($newsub=>$data->{$key});
+               }## a subfield exists
+       
+       $prevtag{$newtag}=1;
+    }
+
+
+       
+}##foreach $key
+$b++;
+## Now print out
+$record->leader('     nx||a22     1i|4500');
+print OUTITEMS $record->as_usmarc;     
+}##while 
+
+close(OUTITEMS);
+       
+       $timeneeded = gettimeofday - $starttime ;
+       print "$b items in $timeneeded s\n" ;
+
+
+$dbh->disconnect();

Index: migration_tools/separate_items_from_biblios.pl
===================================================================
RCS file: migration_tools/separate_items_from_biblios.pl
diff -N migration_tools/separate_items_from_biblios.pl
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ migration_tools/separate_items_from_biblios.pl      2 Apr 2007 00:51:59 
-0000       1.1.2.1
@@ -0,0 +1,63 @@
+#!/usr/bin/perl
+# script that separate old KOHA rel2 marc records into biblios and holdings 
records
+#  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::Batch;
+use Time::HiRes qw(gettimeofday);
+use Getopt::Long;
+my ($outbiblios,$input_marc_file);
+GetOptions(
+    'file:s'    => \$input_marc_file,
+     'outbiblio:s' => \$outbiblios,
+     
+);
+if ($outbiblios || ($input_marc_file eq '')) {
+       print <<EOF
+parameters :
+
+\tfile /path/to/file/to/marc : the marc file to parse
+\toutbiblio : file to create for biblio only marcs
+
+NOTE: this script assumes items to be at tag 952 change as necessary to match 
yours
+
+SAMPLE : ./separate_items_from_biblios.pl -file exportedmarc.mrc -outbiblio 
biblios.mrc
+EOF
+;#'
+die;
+}
+
+#####CHANGE THESE AS APPROPRIATE TO EXISTING RECORDS
+my $itemtag="952";
+
+#############
+
+open(OUTBIBLIO,">$outbiblio") ;
+my $starttime = gettimeofday;
+my $timeneeded;
+
+my $i=0;
+my $batch = MARC::Batch->new( 'USMARC', $input_marc_file );
+$batch->warnings_off();
+$batch->strict_off();
+my $i=0;
+
+while ( my $record = $batch->next() ) {
+my @itemfields=$record->field('$itemtag);
+       foreach my $itemfield(@itemfields){
+       $record->delete_field($itemfield);
+       }
+$i++;
+print OUTBIBLIO $record;
+}
+close OUTBIBLIO;
+$timeneeded = gettimeofday - $starttime ;
+       warn "$i records in $timeneeded s\n" ;
+
+END;




reply via email to

[Prev in Thread] Current Thread [Next in Thread]