misc/migration_tools/22_to_30/export_Authorities_xml.pl

   1 #!/usr/bin/perl
   2 #use strict;
   3 #use warnings; FIXME - Bug 2505
   4 BEGIN {
   5     # find Koha's Perl modules
   6     # test carefully before changing this
   7     use FindBin;
   8     eval { require "$FindBin::Bin/../../kohalib.pl" };
   9 }
  10 use C4::Context;
  11 use MARC::File::XML(BinaryEncoding=>"utf8");
  12 use MARC::Record;
  13 use C4::AuthoritiesMarc;
  14 use POSIX;
  15 MARC::File::XML::default_record_format("UNIMARCAUTH");
  16 my $dbh = C4::Context->dbh;
  17 my $rq= $dbh->prepare(qq|
  18   SELECT authid
  19   FROM auth_header
  20   |);
  21 my $filename= shift @ARGV;
  22 $rq->execute;
  23 #ATTENTION : Mettre la base en utf8 auparavant.
  24 #BEWARE : Set database into utf8 before.
  25 while (my ($authid)=$rq->fetchrow){
  26 open FILEOUTPUT,">:utf8", "./$filename/$authid.xml" or die "unable to open $filename";
  27   my $record=AUTHgetauthority($dbh,$authid);
  28   if (! utf8::is_utf8($record)) {
  29     utf8::decode($record);
  30   }
  31
  32 #  if (C4::Context->preference('marcflavour') eq "UNIMARC"){
  33         $record->leader('     nac  22     1u 4500');
  34     my $string=$1 if $time=~m/([0-9\-]+)/;
  35     $string=~s/\-//g;
  36      $string = sprintf("%-*s",26, $string);
  37      substr($string,9,6,"frey50");
  38      unless ($record->subfield(100,"a")){
  39        $record->insert_fields_ordered(MARC::Field->new(100,"","","a"=>$string));
  40      }
  41      unless ($record->subfield('001')){
  42        $record->insert_fields_ordered(MARC::Field->new('001',$authid));
  43      }
  44      # } else {
  45 #    $record->encoding( 'UTF-8' );
  46 #  }
  47   print FILEOUTPUT $record->as_xml();
  48 close FILEOUPUT;
  49
  50 }