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