/[webpac]/branches/drustvene/tools/mods2unimarc.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /branches/drustvene/tools/mods2unimarc.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/tools/mods2unimarc.pl revision 326 by dpavlin, Fri May 14 17:22:39 2004 UTC branches/drustvene/tools/mods2unimarc.pl revision 335 by dpavlin, Wed Jun 2 16:13:57 2004 UTC
# Line 6  mods2marc.pl - convert MODS XML back to Line 6  mods2marc.pl - convert MODS XML back to
6    
7  =head1 SYNOPSIS  =head1 SYNOPSIS
8    
9  mods2marc.pl mods.xml export.marc  mods2marc.pl export.marc mods.xml [mods2.xml ... ]
10    
11  =head1 DESCRIPTION  =head1 DESCRIPTION
12    
# Line 24  of fields which are in Croatian). Line 24  of fields which are in Croatian).
24    
25  Feel free to hack this script and convert it to your own needs.  Feel free to hack this script and convert it to your own needs.
26    
27  =head1 WARNING  =head1 CAVEAT
28    
29  This script is in state of flux.  This script will parse imput XML twice: once with C<XML::Twig> and
30    then each entry with C<XML::Simple> to produce in-memory structure.
31    That's because I wanted to keep node selection logical (and perl-like).
32    
33    If you don't like it, you can rewrite this script to use XPATH. I tried
34    and failed (it seems that MODS is too complicated for my limited knowledge
35    of XPATH).
36    
37  =cut  =cut
38    
# Line 38  use Text::Iconv; Line 44  use Text::Iconv;
44    
45  use Data::Dumper;  use Data::Dumper;
46    
47  my $xml_file = "/data/tehnika/fer/all.xml";  my $marc_file = shift @ARGV || die "$0: need MARC export file";
48  $xml_file = "/data/tehnika/fer/modsFER_1.xml";  die "$0: need at least one MODS XML file" if (! @ARGV);
 my $marc_file = "fer.marc";  
49    
50  $|=1;  $|=1;
51  my $nr = 0;  my $nr = 0;
52    
53  my $marc = MARC->new;  my $marc = MARC->new;
54    
55    my $ENCODING = 'ISO-8859-2';
56    
57  my $twig=XML::Twig->new(  my $twig=XML::Twig->new(
58          twig_roots => { 'mods' => \&item },          twig_roots => { 'mods' => \&mods },
59          output_encoding => 'iso-8859-2',          output_encoding => 'UTF8',
60  );  );
61    
62  my $utf2iso = Text::Iconv->new("UTF-8", "ISO-8859-2");  my $utf2iso = Text::Iconv->new("UTF8", $ENCODING);
63    
64    foreach my $xml_file (@ARGV) {
65            print "$xml_file: ";
66            $twig->parsefile($xml_file);
67            $twig->purge;
68            print "$nr\n";
69    }
70    
71  $twig->parsefile($xml_file);  print "Saving MARC file...\n";
 $twig->purge;  
72    
73  $marc->output({file=>"> $marc_file",'format'=>"usmarc"});  $marc->output({file=>"> $marc_file",'format'=>"usmarc"});
74    
75  sub item {  sub mods {
76          my( $t, $elt)= @_;          my( $t, $elt)= @_;
77    
78          my $xml=$elt->xml_string;          my $xml=$elt->xml_string;
79          my $ref = XMLin("<xml>".$xml."</xml>",          my $ref = XMLin('<xml>'.$xml.'</xml>',
80                  ForceArray => [                  ForceArray => [
81                          'name',                          'name',
82                          'classification',                          'classification',
83                          'topic',                          'topic',
84                          'udc',                          'relatedItem',
85                            'partNumber',
86                  ],                  ],
87                  KeyAttr => {                  KeyAttr => {
88                          'namePart' => 'type',                          'namePart' => 'type',
89                          'identifier' => 'type',                          'identifier' => 'type',
                         'classification' => 'authority',  
90                          'namePart' => 'type',                          'namePart' => 'type',
91                          'role' => 'type',                          'role' => 'type',
92                  },                  },
# Line 88  sub item { Line 101  sub item {
101          my $m_cache;          my $m_cache;
102    
103          sub marc_add {          sub marc_add {
104                  my $m_cache = \shift;                  my $m_cache = \shift || die "need m_cache";
105                  my $fld = shift || die "need field!";                  my $fld = shift || die "need field!";
106                  my $sf = shift || '';                  my $sf = shift;
107                    my $data = shift || return;
108    
109    #print "add: $fld",($sf ? "^".$sf : ''),": $data\n";
110    
111                    if ($sf) {
112                            push @{$$m_cache->{tmp}->{$fld}}, $sf;
113                    }
114                    push @{$$m_cache->{tmp}->{$fld}}, $utf2iso->convert($data);
115            }
116    
117            sub marc_rep {
118                    my $m_cache = \shift || die "need m_cache";
119                    foreach my $fld (@_) {
120    #print "marc_rep: $fld\n";      
121                            push @{$$m_cache->{array}->{$fld}}, [ @{$$m_cache->{tmp}->{$fld}} ] if ($$m_cache->{tmp}->{$fld});
122                            delete $$m_cache->{tmp}->{$fld};
123                    }
124            }
125    
126            sub marc_single {
127                    my $m_cache = \shift || die "need m_cache";
128                    foreach my $fld (@_) {
129    #print "marc_single: $fld\n";  
130    
131                  return if (! @_);                          die "$fld already defined! not single?" if ($$m_cache->{single}->{$fld});
132    
133                  my @a;                          $$m_cache->{single}->{$fld} = \@{$$m_cache->{tmp}->{$fld}} if ($$m_cache->{tmp}->{$fld});
134                  foreach (@_) {                          delete $$m_cache->{tmp}->{$fld};
                         next if (! $_);  
                         push @a,$sf if ($sf);  
 #                       push @a,$utf2iso->convert($_) || $_;  
                         push @a,$_;  
135                  }                  }
136            }
137    
138                  return if (! @a);          sub marc_add_rep {
139                    my $m_cache = \shift || die "need m_cache";
140                    my $fld = shift || die "need field!";
141                    my $sf = shift;
142                    my $data = shift || return;
143    
144  #               print "storing $fld: ",join("|",@a),"\n";                  marc_add($$m_cache,$fld,$sf,$data);
145                    marc_rep($$m_cache,$fld);
146            }
147    
148                  push @{$$m_cache->{$fld}}, @a;          sub marc_add_single {
149                    my $m_cache = \shift || die "need m_cache";
150                    my $fld = shift || die "need field!";
151                    my $sf = shift;
152                    my $data = shift || return;
153    
154                    marc_add($$m_cache,$fld,$sf,$data);
155                    marc_single($$m_cache,$fld);
156          }          }
157    
158          my $journal = 0;          my $journal = 0;
159            # Journals start with c- in our MODS
160          $journal = 1 if ($ref->{recordInfo}->{recordIdentifier} =~ m/^c-/);          $journal = 1 if ($ref->{recordInfo}->{recordIdentifier} =~ m/^c-/);
           
         marc_add($m_cache,'610','a',@{$ref->{subject}->{topic}});  
161    
162          my $fld = '700';          foreach my $t (@{$ref->{subject}->{topic}}) {
163                    marc_add($m_cache,'610','a', $t);
164                    marc_rep($m_cache,'610');
165            }
166    
167            my $fld_700 = '700';
168            my $fld_710 = '710';
169    
170          foreach my $name (@{$ref->{name}}) {          foreach my $name (@{$ref->{name}}) {
171                  my $role = $name->{role}->{roleTerm}->{content};                  my $role = $name->{role}->{roleTerm}->{content};
172                  next if (! $role);                  next if (! $role);
173                  if ($role eq "author") {                  if ($role eq "author") {
174                          marc_add($m_cache,$fld,'a',$name->{namePart}->{family});                          marc_add($m_cache,$fld_700,'a',$name->{namePart}->{family});
175                          marc_add($m_cache,$fld,'b',$name->{namePart}->{given});                          marc_add($m_cache,$fld_700,'b',$name->{namePart}->{given});
176                          marc_add($m_cache,$fld,'4',$role);                          marc_add($m_cache,$fld_700,'4',$role);
177    
178                            marc_rep($m_cache,$fld_700);
179    
180                          # first author goes in 700, others in 701                          # first author goes in 700, others in 701
181                          $fld = '701';                          $fld_700 = '701';
182                  } elsif ($role eq "editor" or $role eq "illustrator") {                  } elsif ($role eq "editor" or $role eq "illustrator") {
183                          marc_add($m_cache,'702','a',$name->{namePart}->{family});                          marc_add($m_cache,'702','a',$name->{namePart}->{family});
184                          marc_add($m_cache,'702','b',$name->{namePart}->{given});                          marc_add($m_cache,'702','b',$name->{namePart}->{given});
185                          marc_add($m_cache,'702','4',$role);                          marc_add($m_cache,'702','4',$role);
186                            marc_rep($m_cache,'702');
187                    } elsif ($role eq "corporate") {
188                            marc_add_single($m_cache,"$fld_710\t0 ",'a',$name->{namePart});
189                            $fld_710 = '711';
190                    } elsif ($role eq "conference") {
191                            marc_add_single($m_cache,"$fld_710\t1 ",'a',$name->{namePart});
192                            $fld_710 = '711';
193                  } else {                  } else {
194                          die "FATAL: don't know how to map role '$role'" if ($role);                          die "FATAL: don't know how to map role '$role'" if ($role);
195                  }                  }
# Line 141  sub item { Line 200  sub item {
200          if ($note) {          if ($note) {
201                  foreach my $n (split(/\s*;\s+/, $note)) {                  foreach my $n (split(/\s*;\s+/, $note)) {
202                          if ($n =~ s/bibliogr:\s+//i) {                          if ($n =~ s/bibliogr:\s+//i) {
203                                  marc_add($m_cache,'320','a',"Bibliografija: $n");                                  marc_add_rep($m_cache,'320','a',"Bibliografija: $n");
204                          } elsif ($n =~ s/ilustr:\s+//i) {                          } elsif ($n =~ s/ilustr:\s+//i) {
205                                  marc_add($m_cache,'215','c', $n);                                  marc_add($m_cache,'215','c', $n);
206                          } else {                          } else {
207                                  marc_add($m_cache,'320','a',$n);                                  marc_add_rep($m_cache,'320','a',$n);
208                          }                          }
209                  }                  }
210          }          }
211                            
212    
213          my $type = $ref->{identifier}->{type};          my $type = $ref->{identifier}->{type};
214    
215          if ($type) {          if ($type) {
216                  if ($type eq "isbn") {                  if ($type eq "isbn") {
217                          marc_add($m_cache,'010','a',$ref->{identifier}->{content});                          marc_add_rep($m_cache,'010','a',$ref->{identifier}->{content});
218                  } elsif ($type eq "issn") {                  } elsif ($type eq "issn") {
219                          marc_add($m_cache,'011','a',$ref->{identifier}->{content});                          marc_add_rep($m_cache,'011','a',$ref->{identifier}->{content});
220                    } elsif ($type eq "uri") {
221                            marc_add_rep($m_cache,'856','u',$ref->{identifier}->{content});
222                  } else {                  } else {
223                          die "unknown identifier type $type";                          die "unknown identifier type $type";
224                  }                  }
# Line 170  sub item { Line 231  sub item {
231                          if ($t =~ m/([^:]+):\s+(.+)$/) {                          if ($t =~ m/([^:]+):\s+(.+)$/) {
232                                  $tmp->{$1} = $2;                                  $tmp->{$1} = $2;
233                          } else {                          } else {
234                                  die "can't parse $t";                                  print STDERR "can't parse '$t' in ",Dumper($phy_desc);
235                          }                          }
236                  }                  }
237                  my $data = $tmp->{pagin};                  my $data = $tmp->{pagin};
# Line 181  sub item { Line 242  sub item {
242                  marc_add($m_cache,'215','a', $data) if ($data);                  marc_add($m_cache,'215','a', $data) if ($data);
243                  marc_add($m_cache,'215','d', $tmp->{visina});                  marc_add($m_cache,'215','d', $tmp->{visina});
244          }          }
245            marc_rep($m_cache,'215');
246    
247          marc_add($m_cache,'001',undef,$ref->{recordInfo}->{recordIdentifier});          marc_add_single($m_cache,'001',undef,$ref->{recordInfo}->{recordIdentifier});
248    
249          marc_add($m_cache,'200','a',$ref->{titleInfo}->{title});          marc_add($m_cache,'200','a',$ref->{titleInfo}->{title});
250          marc_add($m_cache,'200','e',$ref->{titleInfo}->{subTitle});          marc_add($m_cache,'200','e',$ref->{titleInfo}->{subTitle});
251            marc_single($m_cache,'200');
252    
253          marc_add($m_cache,'675','a',$ref->{classification}->{udc});          foreach my $c (@{$ref->{classification}}) {
254                    if ($c->{'authority'} eq "udc") {
255                            marc_add_rep($m_cache,'675','a', $c->{'content'});
256                    }
257            }
258    
259          my $related = $ref->{relatedItem}->{type};          foreach my $ri (@{$ref->{relatedItem}}) {
260          if ($related) {                  my $related = $ri->{type};
261                  if ($related eq "series") {                  if ($related) {
262                          marc_add($m_cache,'225','a',$ref->{relatedItem}->{titleInfo}->{title});                          if ($related eq "series") {
263                          marc_add($m_cache,'999','a',$ref->{relatedItem}->{titleInfo}->{partNumber});                                  marc_add_rep($m_cache,'225','a',$ri->{titleInfo}->{title});
264                  } elsif ($related eq "preceding") {                                  foreach my $pn (@{$ri->{titleInfo}->{partNumber}}) {
265                          marc_add($m_cache,'430','a',$ref->{relatedItem}->{titleInfo}->{title});                                          if ($journal) {
266                  } else {                                                  marc_add_rep($m_cache,'999','a',$pn);
267                          die "can't parse related item type $related" if ($related);                                          } else {
268                                                    marc_add_rep($m_cache,'225','v',$pn);
269                                            }
270                                    }
271                            } elsif ($related eq "preceding") {
272                                    marc_add($m_cache,'520','a',$ri->{titleInfo}->{title});
273                                    if ($ri->{identifier}) {
274                                            if ($ri->{identifier}->{type} eq "issn") {
275                                                    marc_add($m_cache,'520','x',$ri->{identifier}->{content});
276                                            } else {
277                                                    die "can't store identifier type $type";
278                                            }
279                                    }
280                                    marc_rep($m_cache,'520');
281                            } else {
282                                    die "can't parse related item type $related" if ($related);
283                            }
284                  }                  }
285          }          }
286    
287          marc_add($m_cache,'205','a',$ref->{originInfo}->{edition});          marc_add_single($m_cache,'205','a',$ref->{originInfo}->{edition});
288    
289            marc_add($m_cache,'210','a',$ref->{originInfo}->{place});
290    
291          my $publisher = $ref->{originInfo}->{publisher};          my $publisher = $ref->{originInfo}->{publisher};
292          if ($publisher =~ m,^(.+?)\s*/\s*(.+)$,) {          if ($publisher =~ m,^(.+?)\s*/\s*(.+)$,) {
# Line 211  sub item { Line 296  sub item {
296                  marc_add($m_cache,'210','c', $publisher);                  marc_add($m_cache,'210','c', $publisher);
297          }          }
298    
299          marc_add($m_cache,'326','a',$ref->{originInfo}->{frequency}) if ($journal);          marc_add($m_cache,'210','d',$ref->{originInfo}->{dateIssued});
300    
301          marc_add($m_cache,'210','a',$ref->{originInfo}->{place});          marc_single($m_cache,'210');
302    
303          marc_add($m_cache,'210','d',$ref->{originInfo}->{dateIssued});          marc_add_single($m_cache,'326','a',$ref->{originInfo}->{frequency}) if ($journal);
304    
305          $nr++;          $nr++;
306          print "$nr " if ($nr % 100 == 0);          print "$nr " if ($nr % 100 == 0);
307    
308          # dump record          # dump record
309          my $m=$marc->createrecord();          my $bib_level = "m";
310          foreach my $fld (keys %{$m_cache}) {          $bib_level = "s" if ($journal);
311  #               print "$fld: ",join(" * ",@{$m_cache->{$fld}}),"\n";          my $m=$marc->createrecord({leader=>"00000na".$bib_level."  2200000 a 4500"});
312    
313            foreach my $fld (keys %{$m_cache->{array}}) {
314                    foreach my $arr (@{$m_cache->{array}->{$fld}}) {
315    #print "array = ",Dumper($arr);
316                            my ($i1,$i2);
317                            # do we have indicators?
318                            if ($fld =~ m/^(.+)\t(.)(.)$/) {
319                                    $fld = $1;
320                                    ($i1,$i2) = ($2,$3);
321                            }
322                            $marc->addfield({record=>$m,
323                                    field=>$fld,
324                                    i1=>$i1,
325                                    i2=>$i2,
326                                    value=>$arr
327                            });
328                    }
329            }
330    
331            foreach my $fld (keys %{$m_cache->{single}}) {
332    #print "single = ",Dumper($m_cache->{single}->{$fld});
333                    my ($i1,$i2);
334                    # do we have indicators?
335                    if ($fld =~ m/^(.+)\t(.)(.)$/) {
336                            $fld = $1;
337                            ($i1,$i2) = ($2,$3);
338                    }
339                  $marc->addfield({record=>$m,                  $marc->addfield({record=>$m,
340                          field=>$fld,                          field=>$fld,
341                          value=>\@{$m_cache->{$fld}}                          i1=>$i1,
342                            i2=>$i2,
343                            value=>$m_cache->{single}->{$fld}
344                  });                  });
345          }          }
346    
347            $m_cache = {};
348    
349          $t->purge;           # frees the memory          $t->purge;           # frees the memory
350  }  }
351    
Legend:
Removed from v.326  
changed lines
  Added in v.335
  ViewVC Help
Powered by ViewVC 1.1.26