koha-cvs
[Top][All Lists]
Advanced

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

[Koha-cvs] koha/misc/migration_tools 22_to_30/biblio_frame...


From: paul poulain
Subject: [Koha-cvs] koha/misc/migration_tools 22_to_30/biblio_frame...
Date: Fri, 09 Mar 2007 15:44:44 +0000

CVSROOT:        /sources/koha
Module name:    koha
Changes by:     paul poulain <tipaul>   07/03/09 15:44:38

Added files:
        misc/migration_tools/22_to_30: biblio_framework.sql 
                                       convert_to_utf8.pl 
                                       export_Authorities.pl 
                                       export_Authorities_xml.pl 
                                       missing090field.pl 
                                       move_marc_to_authheader.pl 
                                       move_marc_to_biblioitems.pl 
                                       phrase_log.sql rebuild_leader.pl 
                                       rebuild_unimarc_100.pl 
        misc/migration_tools: check_dirs.pl 

Log message:
        rel_3_0 moved to HEAD (introducing new files)

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/misc/migration_tools/22_to_30/biblio_framework.sql?cvsroot=koha&rev=1.2
http://cvs.savannah.gnu.org/viewcvs/koha/misc/migration_tools/22_to_30/convert_to_utf8.pl?cvsroot=koha&rev=1.2
http://cvs.savannah.gnu.org/viewcvs/koha/misc/migration_tools/22_to_30/export_Authorities.pl?cvsroot=koha&rev=1.2
http://cvs.savannah.gnu.org/viewcvs/koha/misc/migration_tools/22_to_30/export_Authorities_xml.pl?cvsroot=koha&rev=1.2
http://cvs.savannah.gnu.org/viewcvs/koha/misc/migration_tools/22_to_30/missing090field.pl?cvsroot=koha&rev=1.2
http://cvs.savannah.gnu.org/viewcvs/koha/misc/migration_tools/22_to_30/move_marc_to_authheader.pl?cvsroot=koha&rev=1.2
http://cvs.savannah.gnu.org/viewcvs/koha/misc/migration_tools/22_to_30/move_marc_to_biblioitems.pl?cvsroot=koha&rev=1.2
http://cvs.savannah.gnu.org/viewcvs/koha/misc/migration_tools/22_to_30/phrase_log.sql?cvsroot=koha&rev=1.2
http://cvs.savannah.gnu.org/viewcvs/koha/misc/migration_tools/22_to_30/rebuild_leader.pl?cvsroot=koha&rev=1.1
http://cvs.savannah.gnu.org/viewcvs/koha/misc/migration_tools/22_to_30/rebuild_unimarc_100.pl?cvsroot=koha&rev=1.1
http://cvs.savannah.gnu.org/viewcvs/koha/misc/migration_tools/check_dirs.pl?cvsroot=koha&rev=1.1

Patches:
Index: 22_to_30/biblio_framework.sql
===================================================================
RCS file: 22_to_30/biblio_framework.sql
diff -N 22_to_30/biblio_framework.sql
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ 22_to_30/biblio_framework.sql       9 Mar 2007 15:44:38 -0000       1.2
@@ -0,0 +1,6 @@
+alter table biblio add frameworkcode char(4);
+update biblio,marc_biblio set biblio.frameworkcode=marc_biblio.frameworkcode 
where marc_biblio.biblionumber=biblio.biblionumber;
+alter table biblioitems add marcxml text;
+alter table biblioitems add lcsort varchar(25);
+alter table items add onloan date;
+alter table items add Cutterextra varchar(45);

Index: 22_to_30/convert_to_utf8.pl
===================================================================
RCS file: 22_to_30/convert_to_utf8.pl
diff -N 22_to_30/convert_to_utf8.pl
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ 22_to_30/convert_to_utf8.pl 9 Mar 2007 15:44:38 -0000       1.2
@@ -0,0 +1,23 @@
+#!/usr/bin/perl
+
+# small script to convert mysql tables to utf-8
+
+use C4::Context;
+use strict;
+
+my $dbh=C4::Context->dbh();
+
+my $database=C4::Context->config("database");
+my $query="Show tables";
+my $sth=$dbh->prepare($query);
+$sth->execute();
+while (my @table=$sth->fetchrow_array()){
+    print "Altering table $table[0]\n";
+    my $alter_query="ALTER TABLE $table[0] convert to CHARACTER SET UTF8 
collate utf8_general_ci";
+    my $sth2=$dbh->prepare($alter_query);
+    $sth2->execute();
+    $sth2->finish();
+
+}
+$sth->finish();
+$dbh->disconnect();

Index: 22_to_30/export_Authorities.pl
===================================================================
RCS file: 22_to_30/export_Authorities.pl
diff -N 22_to_30/export_Authorities.pl
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ 22_to_30/export_Authorities.pl      9 Mar 2007 15:44:38 -0000       1.2
@@ -0,0 +1,57 @@
+#!/usr/bin/perl
+use C4::Context;
+#use MARC::File::XML(BinaryEncoding=>"utf8");
+#use MARC::File::USMARC;
+use MARC::Record;
+use C4::AuthoritiesMarc;
+use POSIX;
+#MARC::File::XML::default_record_format("UNIMARCAUTH");
+my $dbh = C4::Context->dbh;
+my $rq= $dbh->prepare(qq|
+  SELECT authid,authtypecode
+  FROM auth_header
+  |);
+my $filename= shift @ARGV;
+$rq->execute;
+#ATTENTION : Mettre la base en utf8 auparavant.
+#BEWARE : Set database into utf8 before.
+#open FILEOUTPUT,">:utf8", "$filename" or die "unable to open $filename";
+while (my ($authid,$authtypecode)=$rq->fetchrow){
+  my $record=AUTHgetauthority($dbh,$authid);
+  if (! utf8::is_utf8($record)) {
+         utf8::decode($record);
+  }
+  
+  if (C4::Context->preference('marcflavour') eq "UNIMARC"){
+       $record->leader('     nac  22     1u 4500');
+    my $string=$1 if $time=~m/([0-9\-]+)/;
+    $string=~s/\-//g;
+     $string = sprintf("%-*s",26, $string);
+     substr($string,9,6,"frey50");
+     unless ($record->subfield('100',"a")){
+       
$record->insert_fields_ordered(MARC::Field->new('100',"","","a"=>$string));
+     }
+     if ($record->field('152')){
+       if ($record->subfield('152','b')){
+       } else {
+            $record->field('152')->add_subfields("b"=>$authtypecode);
+       }
+     } else {
+            
$record->insert_fields_ordered(MARC::Field->new('152',"","","b"=>$authtypecode));
+     }
+     unless ($record->field('001')){
+       $record->insert_fields_ordered(MARC::Field->new('001',$authid));
+     }
+     
+     AUTHmodauthority($dbh,$authid,$record,1);
+   } else {
+    $record->encoding( 'UTF-8' );
+  }
+#  warn $record->as_usmarc;
+     # warn $record->as_formatted;
+     #   warn $record->as_usmarc;
+
+  print $record->as_usmarc();
+
+}
+close ;

Index: 22_to_30/export_Authorities_xml.pl
===================================================================
RCS file: 22_to_30/export_Authorities_xml.pl
diff -N 22_to_30/export_Authorities_xml.pl
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ 22_to_30/export_Authorities_xml.pl  9 Mar 2007 15:44:38 -0000       1.2
@@ -0,0 +1,42 @@
+#!/usr/bin/perl
+use C4::Context;
+use MARC::File::XML(BinaryEncoding=>"utf8");
+use MARC::Record;
+use C4::AuthoritiesMarc;
+use POSIX;
+MARC::File::XML::default_record_format("UNIMARCAUTH");
+my $dbh = C4::Context->dbh;
+my $rq= $dbh->prepare(qq|
+  SELECT authid
+  FROM auth_header
+  |);
+my $filename= shift @ARGV;
+$rq->execute;
+#ATTENTION : Mettre la base en utf8 auparavant.
+#BEWARE : Set database into utf8 before.
+while (my ($authid)=$rq->fetchrow){
+open FILEOUTPUT,">:utf8", "./$filename/$authid.xml" or die "unable to open 
$filename";
+  my $record=AUTHgetauthority($dbh,$authid);
+  if (! utf8::is_utf8($record)) {
+    utf8::decode($record);
+  }
+                       
+#  if (C4::Context->preference('marcflavour') eq "UNIMARC"){
+       $record->leader('     nac  22     1u 4500');
+    my $string=$1 if $time=~m/([0-9\-]+)/;
+    $string=~s/\-//g;
+     $string = sprintf("%-*s",26, $string);
+     substr($string,9,6,"frey50");
+     unless ($record->subfield(100,"a")){
+       
$record->insert_fields_ordered(MARC::Field->new(100,"","","a"=>$string));
+     }
+     unless ($record->subfield('001')){
+       $record->insert_fields_ordered(MARC::Field->new('001',$authid));
+     }
+     # } else {
+#    $record->encoding( 'UTF-8' );
+#  }
+  print FILEOUTPUT $record->as_xml();
+close FILEOUPUT;
+
+}

Index: 22_to_30/missing090field.pl
===================================================================
RCS file: 22_to_30/missing090field.pl
diff -N 22_to_30/missing090field.pl
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ 22_to_30/missing090field.pl 9 Mar 2007 15:44:38 -0000       1.2
@@ -0,0 +1,50 @@
+#!/usr/bin/perl
+# This script finds and fixes missing 090 fields in Koha for MARC21
+#  Written by TG on 01/10/2005
+#  Revised by Joshua Ferraro on 03/31/2006
+use strict;
+
+# Koha modules used
+
+use C4::Context;
+use C4::Biblio;
+use MARC::Record;
+use MARC::File::USMARC;
+
+$|=1;
+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();
+
+my $i=1;
+while (my ($biblionumber,$biblioitemnumber)=$sth->fetchrow ){
+ my $record = GetMarcBiblio($biblionumber);
+    print "."; 
+    print "\r$i" unless $i %100;
+    MARCmodbiblionumber($biblionumber,$biblioitemnumber,$record);
+}
+
+sub MARCmodbiblionumber{
+    my ($biblionumber,$biblioitemnumber,$record)address@hidden;
+    
+    my ($tagfield,$biblionumtagsubfield) = 
&MARCfind_marc_from_kohafield($dbh,"biblio.biblionumber","");
+    my ($tagfield2,$biblioitemtagsubfield) = 
&MARCfind_marc_from_kohafield($dbh,"biblio.biblioitemnumber","");
+        
+    my $update=0;
+        my @tags = $record->field($tagfield);
+    
+    if (address@hidden){
+        my $newrec = MARC::Field->new( $tagfield,'','', $biblionumtagsubfield 
=> $biblionumber,$biblioitemtagsubfield=>$biblioitemnumber);
+            $record->append_fields($newrec);
+        $update=1;
+    }
+    
+    
+    if ($update){      
+        &MARCmodbiblio($dbh,$biblionumber,$record,'',0);
+        print "\n modified : $biblionumber \n";        
+    }
+    
+}
+END;

Index: 22_to_30/move_marc_to_authheader.pl
===================================================================
RCS file: 22_to_30/move_marc_to_authheader.pl
diff -N 22_to_30/move_marc_to_authheader.pl
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ 22_to_30/move_marc_to_authheader.pl 9 Mar 2007 15:44:38 -0000       1.2
@@ -0,0 +1,126 @@
+#!/usr/bin/perl
+
+# script to shift marc to biblioitems
+# scraped from updatedatabase for dev week by address@hidden
+
+use C4::Context;
+use C4::AuthoritiesMarc;
+use MARC::Record;
+use MARC::File::XML ( BinaryEncoding => 'utf8' );
+
+use strict;
+print "moving MARC record to marc_header table\n";
+
+my $dbh = C4::Context->dbh();
+# changing marc field type
+$dbh->do('ALTER TABLE auth_header CHANGE marc marc BLOB NULL DEFAULT NULL ');
+
+# adding marc xml, just for convenience
+$dbh->do(
+'ALTER TABLE auth_header ADD marcxml LONGTEXT CHARACTER SET utf8 COLLATE 
utf8_general_ci NOT NULL '
+);
+
+$|=1; # flushes output
+
+# moving data from marc_subfield_value to biblio
+my $sth = $dbh->prepare('select authid,authtypecode from auth_header');
+$sth->execute;
+my $sth_update =
+  $dbh->prepare(
+    'update auth_header set marc=?,marcxml=? where authid=?');
+my $totaldone = 0;
+while ( my ( $authid,$authtypecode ) = $sth->fetchrow ) {
+#     my $authtypecode = AUTHfind_authtypecode($dbh,$authid);
+    my $record = old_AUTHgetauthority( $dbh, $authid );
+    $record->leader('     nac  22     1u 4500');
+    my $string;
+    $string=~s/\-//g;
+    $string = sprintf("%-*s",26, $string);
+    substr($string,9,6,"frey50");
+    unless ($record->subfield(100,"a")){
+      $record->insert_fields_ordered(MARC::Field->new(100,"","","a"=>$string));
+    }
+    if ($record->field(152)){
+      if ($record->subfield('152','b')){
+      } else {
+        $record->field('152')->add_subfields("b"=>$authtypecode);
+      }
+    } else {
+      
$record->insert_fields_ordered(MARC::Field->new(152,"","","b"=>$authtypecode));
+    }
+    unless ($record->field('001')){
+      $record->insert_fields_ordered(MARC::Field->new('001',$authid));
+    }
+                                                                               
                                                                                
                
+
+    #Force UTF-8 in record leaded
+    $record->encoding('UTF-8');
+#     warn "REC : ".$record->as_formatted;
+    $sth_update->execute( $record->as_usmarc(),$record->as_xml("UNIMARCAUTH"),
+        $authid );
+    $totaldone++;
+    print "\r$totaldone" unless ( $totaldone % 100 );
+}
+print "\rdone\n";
+
+#
+# copying the 2.2 getauthority function, to retrieve authority correctly
+# before moving it to marcxml field.
+#
+sub old_AUTHgetauthority {
+# Returns MARC::Record of the biblio passed in parameter.
+    my ($dbh,$authid)address@hidden;
+    my $record = MARC::Record->new();
+#---- TODO : the leader is missing
+       $record->leader('                        ');
+    my $sth=$dbh->prepare("select 
authid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue
+                                from auth_subfield_table
+                                where authid=? order by 
tag,tagorder,subfieldorder
+                        ");
+       $sth->execute($authid);
+       my $prevtagorder=1;
+       my $prevtag='XXX';
+       my $previndicator;
+       my $field; # for >=10 tags
+       my $prevvalue; # for <10 tags
+       while (my $row=$sth->fetchrow_hashref) {
+               if ($row->{tagorder} ne $prevtagorder || $row->{tag} ne 
$prevtag) {
+                       $previndicator.="  ";
+                       if ($prevtag <10) {
+                       $record->add_fields((sprintf 
"%03s",$prevtag),$prevvalue) unless $prevtag eq "XXX"; # ignore the 1st loop
+                       } else {
+                               $record->add_fields($field) unless $prevtag eq 
"XXX";
+                       }
+                       undef $field;
+                       $prevtagorder=$row->{tagorder};
+                       $prevtag = $row->{tag};
+                       $previndicator=$row->{tag_indicator};
+                       if ($row->{tag}<10) {
+                               $prevvalue = $row->{subfieldvalue};
+                       } else {
+                               $field = MARC::Field->new((sprintf 
"%03s",$prevtag), substr($row->{tag_indicator}.'  ',0,1), 
substr($row->{tag_indicator}.'  ',1,1), $row->{'subfieldcode'}, 
$row->{'subfieldvalue'} );
+                       }
+               } else {
+                       if ($row->{tag} <10) {
+                               $record->add_fields((sprintf 
"%03s",$row->{tag}), $row->{'subfieldvalue'});
+                       } else {
+                               $field->add_subfields($row->{'subfieldcode'}, 
$row->{'subfieldvalue'} );
+                       }
+                       $prevtag= $row->{tag};
+                       $previndicator=$row->{tag_indicator};
+               }
+       }
+       # the last has not been included inside the loop... do it now !
+       if ($prevtag ne "XXX") { # check that we have found something. 
Otherwise, prevtag is still XXX and we
+                                               # must return an empty record, 
not make MARC::Record fail because we try to
+                                               # create a record with XXX as 
field :-(
+               if ($prevtag <10) {
+                       $record->add_fields($prevtag,$prevvalue);
+               } else {
+       #               my $field = MARC::Field->new( $prevtag, "", "", 
%subfieldlist);
+                       $record->add_fields($field);
+               }
+       }
+       return $record;
+}
+

Index: 22_to_30/move_marc_to_biblioitems.pl
===================================================================
RCS file: 22_to_30/move_marc_to_biblioitems.pl
diff -N 22_to_30/move_marc_to_biblioitems.pl
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ 22_to_30/move_marc_to_biblioitems.pl        9 Mar 2007 15:44:38 -0000       
1.2
@@ -0,0 +1,204 @@
+#!/usr/bin/perl
+
+# script to shift marc to biblioitems
+# scraped from updatedatabase for dev week by address@hidden
+
+use C4::Context;
+use C4::Biblio;
+use MARC::Record;
+use MARC::File::XML ( BinaryEncoding => 'utf8' );
+
+print "moving MARC record to biblioitems table\n";
+
+my $dbh = C4::Context->dbh();
+
+#
+# moving MARC data from marc_subfield_table to biblioitems.marc
+#
+
+# changing marc field type
+$dbh->do('ALTER TABLE `biblioitems` CHANGE `marc` `marc` BLOB NULL DEFAULT 
NULL ');
+# adding marc xml, just for convenience
+$dbh->do('ALTER TABLE `biblioitems` ADD `marcxml` LONGTEXT CHARACTER SET utf8 
COLLATE utf8_general_ci NOT NULL ');
+# moving data from marc_subfield_value to biblio
+$sth = $dbh->prepare('select bibid,biblionumber from marc_biblio');
+$sth->execute;
+my $sth_update = $dbh->prepare('update biblioitems set marc=?, marcxml=? where 
biblionumber=?');
+my $totaldone=0;
+
+$|=1;
+
+while (my ($bibid,$biblionumber) = $sth->fetchrow) {
+    my $record = MARCgetbiblio($dbh,$bibid);
+    #Force UTF-8 in record leader
+    $record->encoding('UTF-8');
+    
$sth_update->execute($record->as_usmarc(),$record->as_xml_record(),$biblionumber);
+    $totaldone++;
+    print ".";
+    print "\r$totaldone / $totaltodo" unless ($totaldone % 100);
+}
+print "\rdone\n";
+
+
+#
+# those 2 subs are a copy of Biblio.pm, version 2.2.4
+# they are useful only once, for moving from 2.2 to 3.0
+# the MARCgetbiblio & MARCgetitem subs in Biblio.pm
+# are still here, but uses other tables
+# (the ones that are filled by updatedatabase !)
+#
+
+sub MARCgetbiblio {
+
+    # Returns MARC::Record of the biblio passed in parameter.
+    my ( $dbh, $bibid ) = @_;
+    my $record = MARC::Record->new();
+#    warn "". $bidid;
+
+    my $sth =
+      $dbh->prepare(
+"select 
bibid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink
+                  from marc_subfield_table
+                  where bibid=? order by tag,tagorder,subfieldorder
+              "
+    );
+    my $sth2 =
+      $dbh->prepare(
+        "select subfieldvalue from marc_blob_subfield where blobidlink=?");
+    $sth->execute($bibid);
+    my $prevtagorder = 1;
+    my $prevtag      = 'XXX';
+    my $previndicator;
+    my $field;        # for >=10 tags
+    my $prevvalue;    # for <10 tags
+    while ( my $row = $sth->fetchrow_hashref ) {
+
+        if ( $row->{'valuebloblink'} ) {    #---- search blob if there is one
+            $sth2->execute( $row->{'valuebloblink'} );
+            my $row2 = $sth2->fetchrow_hashref;
+            $sth2->finish;
+            $row->{'subfieldvalue'} = $row2->{'subfieldvalue'};
+        }
+        if ( $row->{tagorder} ne $prevtagorder || $row->{tag} ne $prevtag ) {
+            $previndicator .= "  ";
+            if ( $prevtag < 10 ) {
+                if ($prevtag ne '000') {
+                    $record->add_fields( ( sprintf "%03s", $prevtag ), 
$prevvalue ) unless $prevtag eq "XXX";    # ignore the 1st loop
+                } else {
+                    $record->leader(sprintf("%24s",$prevvalue));
+                }
+            }
+            else {
+                $record->add_fields($field) unless $prevtag eq "XXX";
+            }
+            undef $field;
+            $prevtagorder  = $row->{tagorder};
+            $prevtag       = $row->{tag};
+            $previndicator = $row->{tag_indicator};
+            if ( $row->{tag} < 10 ) {
+                $prevvalue = $row->{subfieldvalue};
+            }
+            else {
+                $field = MARC::Field->new(
+                    ( sprintf "%03s", $prevtag ),
+                    substr( $row->{tag_indicator} . '  ', 0, 1 ),
+                    substr( $row->{tag_indicator} . '  ', 1, 1 ),
+                    $row->{'subfieldcode'},
+                    $row->{'subfieldvalue'}
+                );
+            }
+        }
+        else {
+            if ( $row->{tag} < 10 ) {
+                $record->add_fields( ( sprintf "%03s", $row->{tag} ),
+                    $row->{'subfieldvalue'} );
+            }
+            else {
+                $field->add_subfields( $row->{'subfieldcode'},
+                    $row->{'subfieldvalue'} );
+            }
+            $prevtag       = $row->{tag};
+            $previndicator = $row->{tag_indicator};
+        }
+    }
+
+    # the last has not been included inside the loop... do it now !
+    if ( $prevtag ne "XXX" )
+    { # check that we have found something. Otherwise, prevtag is still XXX 
and we
+         # must return an empty record, not make MARC::Record fail because we 
try to
+         # create a record with XXX as field :-(
+        if ( $prevtag < 10 ) {
+            $record->add_fields( $prevtag, $prevvalue );
+        }
+        else {
+
+            #          my $field = MARC::Field->new( $prevtag, "", "", 
%subfieldlist);
+            $record->add_fields($field);
+        }
+    }
+    return $record;
+}
+
+sub MARCgetitem {
+
+    # Returns MARC::Record of the biblio passed in parameter.
+    my ( $dbh, $bibid, $itemnumber ) = @_;
+    my $record = MARC::Record->new();
+
+    # search MARC tagorder
+    my $sth2 =
+      $dbh->prepare(
+"select tagorder from marc_subfield_table,marc_subfield_structure where 
marc_subfield_table.tag=marc_subfield_structure.tagfield and 
marc_subfield_table.subfieldcode=marc_subfield_structure.tagsubfield and 
bibid=? and kohafield='items.itemnumber' and subfieldvalue=?"
+    );
+    $sth2->execute( $bibid, $itemnumber );
+    my ($tagorder) = $sth2->fetchrow_array();
+
+    #---- TODO : the leader is missing
+    my $sth =
+      $dbh->prepare(
+"select 
bibid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink
+                  from marc_subfield_table
+                  where bibid=? and tagorder=? order by 
subfieldcode,subfieldorder
+              "
+    );
+    $sth2 =
+      $dbh->prepare(
+        "select subfieldvalue from marc_blob_subfield where blobidlink=?");
+    $sth->execute( $bibid, $tagorder );
+    while ( my $row = $sth->fetchrow_hashref ) {
+        if ( $row->{'valuebloblink'} ) {    #---- search blob if there is one
+            $sth2->execute( $row->{'valuebloblink'} );
+            my $row2 = $sth2->fetchrow_hashref;
+            $sth2->finish;
+            $row->{'subfieldvalue'} = $row2->{'subfieldvalue'};
+        }
+        if ( $record->field( $row->{'tag'} ) ) {
+            my $field;
+
+#--- this test must stay as this, because of strange behaviour of mySQL/Perl 
DBI with char var containing a number...
+            #--- sometimes, eliminates 0 at beginning, sometimes no ;-\\\
+            if ( length( $row->{'tag'} ) < 3 ) {
+                $row->{'tag'} = "0" . $row->{'tag'};
+            }
+            $field = $record->field( $row->{'tag'} );
+            if ($field) {
+                my $x =
+                  $field->add_subfields( $row->{'subfieldcode'},
+                    $row->{'subfieldvalue'} );
+                $record->delete_field($field);
+                $record->add_fields($field);
+            }
+        }
+        else {
+            if ( length( $row->{'tag'} ) < 3 ) {
+                $row->{'tag'} = "0" . $row->{'tag'};
+            }
+            my $temp =
+              MARC::Field->new( $row->{'tag'}, " ", " ",
+                $row->{'subfieldcode'} => $row->{'subfieldvalue'} );
+            $record->add_fields($temp);
+        }
+
+    }
+    return $record;
+}

Index: 22_to_30/phrase_log.sql
===================================================================
RCS file: 22_to_30/phrase_log.sql
diff -N 22_to_30/phrase_log.sql
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ 22_to_30/phrase_log.sql     9 Mar 2007 15:44:38 -0000       1.2
@@ -0,0 +1,49 @@
+-- MySQL Administrator dump 1.4
+--
+-- ------------------------------------------------------
+-- Server version      4.1.15-nt
+
+
+/*!40101 SET @OLD_CHARACTER_SET_CLIENT=@@CHARACTER_SET_CLIENT */;
+/*!40101 SET @OLD_CHARACTER_SET_RESULTS=@@CHARACTER_SET_RESULTS */;
+/*!40101 SET @OLD_COLLATION_CONNECTION=@@COLLATION_CONNECTION */;
+/*!40101 SET NAMES utf8 */;
+
+/*!40014 SET @OLD_UNIQUE_CHECKS=@@UNIQUE_CHECKS, UNIQUE_CHECKS=0 */;
+/*!40014 SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, 
FOREIGN_KEY_CHECKS=0 */;
+/*!40101 SET @OLD_SQL_MODE=@@SQL_MODE, SQL_MODE='NO_AUTO_VALUE_ON_ZERO' */;
+
+
+--
+-- Create schema koha
+--
+
+--
+-- Table structure for table `koha`.`phrase_log`
+--
+
+DROP TABLE IF EXISTS `phrase_log`;
+CREATE TABLE `phrase_log` (
+  `phr_phrase` varchar(100) NOT NULL default '',
+  `phr_resultcount` int(11) NOT NULL default '0',
+  `phr_ip` varchar(30) NOT NULL default '',
+  `user` varchar(45) default NULL,
+  `date` timestamp NOT NULL default CURRENT_TIMESTAMP on update 
CURRENT_TIMESTAMP,
+  `actual` text NOT NULL,
+  KEY `phr_ip` (`phr_ip`)
+) ENGINE=MyISAM DEFAULT CHARSET=utf8;
+
+--
+-- Dumping data for table `koha`.`phrase_log`
+--
+
+/*!40000 ALTER TABLE `phrase_log` DISABLE KEYS */;
+/*!40000 ALTER TABLE `phrase_log` ENABLE KEYS */;
+
+/*!40101 SET address@hidden */;
+/*!40014 SET address@hidden */;
+/*!40014 SET address@hidden */;
+/*!40101 SET address@hidden */;
+/*!40101 SET address@hidden */;
+/*!40101 SET address@hidden */;
+/*!40101 SET address@hidden */;

Index: 22_to_30/rebuild_leader.pl
===================================================================
RCS file: 22_to_30/rebuild_leader.pl
diff -N 22_to_30/rebuild_leader.pl
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ 22_to_30/rebuild_leader.pl  9 Mar 2007 15:44:38 -0000       1.1
@@ -0,0 +1,50 @@
+#!/usr/bin/perl
+# This script finds and fixes missing 090 fields in Koha for MARC21
+#  Written by TG on 01/10/2005
+#  Revised by Joshua Ferraro on 03/31/2006
+use strict;
+
+# Koha modules used
+
+use C4::Context;
+use C4::Biblio;
+use MARC::Record;
+use MARC::File::USMARC;
+
+
+my $dbh = C4::Context->dbh;
+
+my $sth=$dbh->prepare("select m.bibid,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 = MARCgetbiblio($dbh,$biblionumber);
+               
+               MARCmodleader($biblionumber,$record);
+               
+}
+
+sub MARCmodleader{
+my ($biblionumber,$record)address@hidden;
+
+my $update=0;
+#warn "".$record->leader();
+#if (length($record->leader())>24){
+#      $record->leader(substr($record->leader,0,24));  
+#      $update =1;
+#} elsif (length($record->leader())<24){
+       $record->leader('     nac  22     1u 4500');
+       $update=1;
+#}
+
+warn "leader : ".$record->leader if ($biblionumber==2262);
+foreach ($record->field('995')) {
+       $record->delete_field($_);
+}
+if ($update){  
+       &MARCmodbiblio($dbh,$biblionumber,$record,'',0);
+       print "$biblionumber \n";       
+}
+
+}
+END;

Index: 22_to_30/rebuild_unimarc_100.pl
===================================================================
RCS file: 22_to_30/rebuild_unimarc_100.pl
diff -N 22_to_30/rebuild_unimarc_100.pl
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ 22_to_30/rebuild_unimarc_100.pl     9 Mar 2007 15:44:38 -0000       1.1
@@ -0,0 +1,59 @@
+#!/usr/bin/perl
+# This script finds and fixes missing 090 fields in Koha for MARC21
+#  Written by TG on 01/10/2005
+#  Revised by Joshua Ferraro on 03/31/2006
+use strict;
+
+# Koha modules used
+
+use C4::Context;
+use C4::Biblio;
+use MARC::Record;
+use MARC::File::USMARC;
+
+
+my $dbh = C4::Context->dbh;
+
+my $sth=$dbh->prepare("select biblionumber,timestamp from biblioitems");
+       $sth->execute();
+
+while (my ($biblionumber,$time)=$sth->fetchrow ){
+#   my $record;
+  my $record = GetMarcBiblio($biblionumber);
+#print $record->as_marc;
+               MARCmodrecord($biblionumber,$record,$time);
+#
+}
+
+sub MARCmodrecord {
+    my ($biblionumber,$record,$time)address@hidden;
+#     warn "AVANT : ".$record->as_formatted;
+    my $update=0;
+        $record->leader('     nac  22     1u 4500');
+        $update=1;
+        my $string;
+        if ($record->subfield(100,"a")) {
+            $string = $record->subfield(100,"a");
+            my $f100 = $record->field(100);
+            $record->delete_field($f100);
+        } else {
+            $string = POSIX::strftime("%Y%m%d", localtime);
+            $string=~s/\-//g;
+            $string = sprintf("%-*s",35, $string);
+        }
+        substr($string,22,6,"frey50");
+        unless ($record->subfield(100,"a")){
+            
$record->insert_fields_ordered(MARC::Field->new(100,"","","a"=>$string));
+        }
+#     warn "APRES : ".$record->as_formatted;
+    # delete all items related fields
+    foreach ($record->field('995')) {
+        $record->delete_field($_);
+    }
+    if ($update){      
+        &MARCmodbiblio($dbh,$biblionumber,$record,'',0);
+        print "$biblionumber \n";      
+    }
+
+}
+END;

Index: check_dirs.pl
===================================================================
RCS file: check_dirs.pl
diff -N check_dirs.pl
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ check_dirs.pl       9 Mar 2007 15:44:38 -0000       1.1
@@ -0,0 +1,148 @@
+#!/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




reply via email to

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