misc/migration_tools/22_to_30/move_marc_to_authheader.pl

   1 #!/usr/bin/perl
   2
   3 # script to shift marc to biblioitems
   4 # scraped from updatedatabase for dev week by chris@katipo.co.nz
   5 BEGIN {
   6     # find Koha's Perl modules
   7     # test carefully before changing this
   8     use FindBin;
   9     eval { require "$FindBin::Bin/../../kohalib.pl" };
  10 }
  11 use C4::Context;
  12 use C4::AuthoritiesMarc;
  13 use MARC::Record;
  14 use MARC::File::XML ( BinaryEncoding => 'utf8' );
  15
  16 use strict;
  17 print "moving MARC record to marc_header table\n";
  18
  19 my $dbh = C4::Context->dbh();
  20 # changing marc field type
  21 $dbh->do('ALTER TABLE auth_header CHANGE marc marc BLOB NULL DEFAULT NULL ');
  22
  23 # adding marc xml, just for convenience
  24 $dbh->do(
  25 'ALTER TABLE auth_header ADD marcxml LONGTEXT CHARACTER SET utf8 COLLATE utf8_general_ci NOT NULL '
  26 );
  27
  28 $|=1; # flushes output
  29
  30 # moving data from marc_subfield_value to biblio
  31 my $sth = $dbh->prepare('select authid,authtypecode from auth_header');
  32 $sth->execute;
  33 my $sth_update =
  34   $dbh->prepare(
  35     'update auth_header set marc=?,marcxml=? where authid=?');
  36 my $totaldone = 0;
  37 while ( my ( $authid,$authtypecode ) = $sth->fetchrow ) {
  38 #     my $authtypecode = AUTHfind_authtypecode($dbh,$authid);
  39     my $record = old_AUTHgetauthority( $dbh, $authid );
  40     $record->leader('     nac  22     1u 4500');
  41     my $string;
  42     $string=~s/\-//g;
  43     $string = sprintf("%-*s",26, $string);
  44     substr($string,9,6,"frey50");
  45     unless ($record->subfield(100,"a")){
  46       $record->insert_fields_ordered(MARC::Field->new(100,"","","a"=>$string));
  47     }
  48     if ($record->field(152)){
  49       if ($record->subfield('152','b')){
  50       } else {
  51         $record->field('152')->add_subfields("b"=>$authtypecode);
  52       }
  53     } else {
  54       $record->insert_fields_ordered(MARC::Field->new(152,"","","b"=>$authtypecode));
  55     }
  56     unless ($record->field('001')){
  57       $record->insert_fields_ordered(MARC::Field->new('001',$authid));
  58     }
  59
  60
  61     #Force UTF-8 in record leaded
  62     $record->encoding('UTF-8');
  63 #     warn "REC : ".$record->as_formatted;
  64     $sth_update->execute( $record->as_usmarc(),$record->as_xml("UNIMARCAUTH"),
  65         $authid );
  66     $totaldone++;
  67     print "\r$totaldone" unless ( $totaldone % 100 );
  68 }
  69 print "\rdone\n";
  70
  71 #
  72 # copying the 2.2 getauthority function, to retrieve authority correctly
  73 # before moving it to marcxml field.
  74 #
  75 sub old_AUTHgetauthority {
  76 # Returns MARC::Record of the biblio passed in parameter.
  77     my ($dbh,$authid)=@_;
  78     my $record = MARC::Record->new();
  79 #---- TODO : the leader is missing
  80         $record->leader('                        ');
  81     my $sth=$dbh->prepare("select authid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue
  82                                  from auth_subfield_table
  83                                  where authid=? order by tag,tagorder,subfieldorder
  84                          ");
  85         $sth->execute($authid);
  86         my $prevtagorder=1;
  87         my $prevtag='XXX';
  88         my $previndicator;
  89         my $field; # for >=10 tags
  90         my $prevvalue; # for <10 tags
  91         while (my $row=$sth->fetchrow_hashref) {
  92                 if ($row->{tagorder} ne $prevtagorder || $row->{tag} ne $prevtag) {
  93                         $previndicator.="  ";
  94                         if ($prevtag <10) {
  95                         $record->add_fields((sprintf "%03s",$prevtag),$prevvalue) unless $prevtag eq "XXX"; # ignore the 1st loop
  96                         } else {
  97                                 $record->add_fields($field) unless $prevtag eq "XXX";
  98                         }
  99                         undef $field;
 100                         $prevtagorder=$row->{tagorder};
 101                         $prevtag = $row->{tag};
 102                         $previndicator=$row->{tag_indicator};
 103                         if ($row->{tag}<10) {
 104                                 $prevvalue = $row->{subfieldvalue};
 105                         } else {
 106                                 $field = MARC::Field->new((sprintf "%03s",$prevtag), substr($row->{tag_indicator}.'  ',0,1), substr($row->{tag_indicator}.'  ',1,1), $row->{'subfieldcode'}, $row->{'subfieldvalue'} );
 107                         }
 108                 } else {
 109                         if ($row->{tag} <10) {
 110                                 $record->add_fields((sprintf "%03s",$row->{tag}), $row->{'subfieldvalue'});
 111                         } else {
 112                                 $field->add_subfields($row->{'subfieldcode'}, $row->{'subfieldvalue'} );
 113                         }
 114                         $prevtag= $row->{tag};
 115                         $previndicator=$row->{tag_indicator};
 116                 }
 117         }
 118         # the last has not been included inside the loop... do it now !
 119         if ($prevtag ne "XXX") { # check that we have found something. Otherwise, prevtag is still XXX and we
 120                                                 # must return an empty record, not make MARC::Record fail because we try to
 121                                                 # create a record with XXX as field :-(
 122                 if ($prevtag <10) {
 123                         $record->add_fields($prevtag,$prevvalue);
 124                 } else {
 125         #               my $field = MARC::Field->new( $prevtag, "", "", %subfieldlist);
 126                         $record->add_fields($field);
 127                 }
 128         }
 129         return $record;
 130 }
 131