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