/[webpac]/trunk2/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 /trunk2/tools/mods2unimarc.pl

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

revision 325 by dpavlin, Fri May 14 16:38:22 2004 UTC revision 328 by dpavlin, Sat May 15 19:52:01 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 19  in this script. Line 19  in this script.
19    
20  This script B<is somewhat specific> to MODS export from  This script B<is somewhat specific> to MODS export from
21  Faculty of Electrical Engineering and Computing  Faculty of Electrical Engineering and Computing
22  so you might want to edit it  so you might want to edit it (among other thing, it includes a lot
23    of fields which are in Croatian).
24    
25  =head1 WARNING  Feel free to hack this script and convert it to your own needs.
26    
27  This script is in state of flux.  =head1 CAVEAT
28    
29    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 35  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 82  sub item { Line 98  sub item {
98                  ContentKey => '-content',                  ContentKey => '-content',
99          );          );
100    
101          my $m=$marc->createrecord();          my $m_cache;
102    
103          sub marc_arr {          sub marc_add {
104                  my $m = shift || die "no marc record?";                  my $m_cache = \shift || die "need m_cache";
105                  my $fld = shift || die "no marc field?";                  my $fld = shift || die "need field!";
106                  my $sf = shift || '';                  my $sf = shift;
107                    my $data = shift || return;
108    
109                  return if (! @_);  #print "add: $fld",($sf ? "^".$sf : ''),": $data\n";
110    
111                  my @a;                  if ($sf) {
112                  foreach (@_) {                          push @{$$m_cache->{tmp}->{$fld}}, $sf;
                         next if (! $_);  
                         push @a,$sf;  
 #                       push @a,$utf2iso->convert($_) || $_;  
                         push @a,$_;  
113                  }                  }
114                    push @{$$m_cache->{tmp}->{$fld}}, $utf2iso->convert($data);
115            }
116    
117                  return if (! @a);          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  #               print "storing $fld: ",join("|",@a),"\n";          sub marc_single {
127                    my $m_cache = \shift || die "need m_cache";
128                    foreach my $fld (@_) {
129    #print "marc_single: $fld\n";  
130    
131                  $marc->addfield({record=>$m,                          die "$fld already defined! not single?" if ($$m_cache->{single}->{$fld});
132                          field=>$fld,  
133          #               i1=>$i1,                          $$m_cache->{single}->{$fld} = \@{$$m_cache->{tmp}->{$fld}} if ($$m_cache->{tmp}->{$fld});
134          #               i2=>$i2,                          delete $$m_cache->{tmp}->{$fld};
135                  value=>\@a});                  }
136            }
137    
138            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                    marc_add($$m_cache,$fld,$sf,$data);
145                    marc_rep($$m_cache,$fld);
146          }          }
147    
148          marc_arr($m,'610','a',@{$ref->{subject}->{topic}});          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          my $fld = '700';                  marc_add($$m_cache,$fld,$sf,$data);
155                    marc_single($$m_cache,$fld);
156            }
157    
158            my $journal = 0;
159            # Journals start with c- in our MODS
160            $journal = 1 if ($ref->{recordInfo}->{recordIdentifier} =~ m/^c-/);
161    
162            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_arr($m,$fld,'a',$name->{namePart}->{family});                          marc_add($m_cache,$fld_700,'a',$name->{namePart}->{family});
175                          marc_arr($m,$fld,'b',$name->{namePart}->{given});                          marc_add($m_cache,$fld_700,'b',$name->{namePart}->{given});
176                          marc_arr($m,$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_arr($m,'702','a',$name->{namePart}->{family});                          marc_add($m_cache,'702','a',$name->{namePart}->{family});
184                          marc_arr($m,'702','b',$name->{namePart}->{given});                          marc_add($m_cache,'702','b',$name->{namePart}->{given});
185                          marc_arr($m,'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 138  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_arr($m,'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_arr($m,'215','c', $n);                                  marc_add($m_cache,'215','c', $n);
206                          } else {                          } else {
207                                  marc_arr($m,'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_arr($m,'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_arr($m,'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 175  sub item { Line 239  sub item {
239                  if ($tmp->{str}) {                  if ($tmp->{str}) {
240                          $data .= $tmp->{str}." str";                          $data .= $tmp->{str}." str";
241                  }                  }
242                  marc_arr($m,'210','a', $data) if ($data);                  marc_add($m_cache,'215','a', $data) if ($data);
243                  marc_arr($m,'210','d', $tmp->{visina});                  marc_add($m_cache,'215','d', $tmp->{visina});
244          }          }
245            marc_rep($m_cache,'215');
246    
247          marc_arr($m,'001','',$ref->{recordInfo}->{recordIdentifier});          marc_add_single($m_cache,'001',undef,$ref->{recordInfo}->{recordIdentifier});
248    
249          marc_arr($m,'200','a',$ref->{titleInfo}->{title});          marc_add($m_cache,'200','a',$ref->{titleInfo}->{title});
250          marc_arr($m,'200','e',$ref->{titleInfo}->{subTitle});          marc_add($m_cache,'200','e',$ref->{titleInfo}->{subTitle});
251            marc_single($m_cache,'200');
252    
253          marc_arr($m,'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_arr($m,'675','a',$ref->{relatedItem}->{titleInfo}->{title});                          if ($related eq "series") {
263                          marc_arr($m,'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_arr($m,'430','a',$ref->{relatedItem}->{titleInfo}->{title});                                          marc_add_rep($m_cache,'999','a',$pn);
266                  } else {                                  }
267                          die "can't parse related item type $related" if ($related);                          } elsif ($related eq "preceding") {
268                                    marc_add_rep($m_cache,'430','a',$ri->{titleInfo}->{title});
269                            } else {
270                                    die "can't parse related item type $related" if ($related);
271                            }
272                  }                  }
273          }          }
274    
275          marc_arr($m,'205','a',$ref->{originInfo}->{edition});          marc_add_single($m_cache,'205','a',$ref->{originInfo}->{edition});
276    
277          my $publisher = $ref->{originInfo}->{publisher};          my $publisher = $ref->{originInfo}->{publisher};
278          if ($publisher =~ m,^(.+?)\s*/\s*(.+)$,) {          if ($publisher =~ m,^(.+?)\s*/\s*(.+)$,) {
279                  marc_arr($m,'210','a', $2);                  marc_add($m_cache,'210','a', $2);
280                  marc_arr($m,'210','c', $1);                  marc_add($m_cache,'210','c', $1);
281          } else {          } else {
282                  marc_arr($m,'210','c', $publisher);                  marc_add($m_cache,'210','c', $publisher);
283          }          }
284    
285          marc_arr($m,'326','a',$ref->{originInfo}->{frequency});          marc_add($m_cache,'210','a',$ref->{originInfo}->{place});
286          marc_arr($m,'326','a',$ref->{originInfo}->{place});          marc_add($m_cache,'210','d',$ref->{originInfo}->{dateIssued});
287    
288            marc_single($m_cache,'210');
289    
290          marc_arr($m,'210','d',$ref->{originInfo}->{dateIssued});          marc_add_single($m_cache,'326','a',$ref->{originInfo}->{frequency}) if ($journal);
291    
292          $nr++;          $nr++;
293          print "$nr " if ($nr % 100 == 0);          print "$nr " if ($nr % 100 == 0);
294    
295          $t->purge;           # frees the memory          # dump record
296  }          my $bib_level = "m";
297            $bib_level = "s" if ($journal);
298  __END__          my $m=$marc->createrecord({leader=>"00000na".$bib_level."  2200000 a 4500"});
299    
300            foreach my $fld (keys %{$m_cache->{array}}) {
301                    foreach my $arr (@{$m_cache->{array}->{$fld}}) {
302    #print "array = ",Dumper($arr);
303                            my ($i1,$i2);
304                            # do we have indicators?
305                            if ($fld =~ m/^(.+)\t(.)(.)$/) {
306                                    $fld = $1;
307                                    ($i1,$i2) = ($2,$3);
308                            }
309                            $marc->addfield({record=>$m,
310                                    field=>$fld,
311                                    i1=>$i1,
312                                    i2=>$i2,
313                                    value=>$arr
314                            });
315                    }
316            }
317    
318  KNJIGA = {          foreach my $fld (keys %{$m_cache->{single}}) {
319  610a           'subject' => [  #print "single = ",Dumper($m_cache->{single}->{$fld});
320                            {                  my ($i1,$i2);
321                              'topic' => [                  # do we have indicators?
322                                               'LIBRARIES-AUTOMATION',                  if ($fld =~ m/^(.+)\t(.)(.)$/) {
323                                               'ELECTRONIC DATA PROCESSING-LIBRARY SCIENCE'                          $fld = $1;
324                                         ]                          ($i1,$i2) = ($2,$3);
325                            }                  }
326                          ],                  $marc->addfield({record=>$m,
327             'name' => [                          field=>$fld,
328                         {                          i1=>$i1,
329                           'namePart' => {                          i2=>$i2,
330  700b,701a...                                 'given' => 'Robert M.',                          value=>$m_cache->{single}->{$fld}
331  700a,701b...                                 'family' => 'Hayes'                  });
332                                         },          }
                          'type' => 'personal',  
                          'role' => {  
                                      'roleTerm' => {  
 7004,7014...                                         'content' => 'author',  
                                                      'type' => 'text'  
                                                    }  
                                    }  
                        },  
                        {  
                          'namePart' => {  
 702b                                     'given' => 'Joseph',  
 702a                                     'family' => 'Becker'  
                                        },  
                          'type' => 'personal',  
                          'role' => {  
                                      'roleTerm' => {  
 7024                                                 'content' => 'editor',  
                                                      'type' => 'text'  
                                                    }  
                                    }  
                        },  
                        {  
                          'namePart' => {  
 702b                                     'given' => 'Joseph',  
 702a                                     'family' => 'Becker'  
                                        },  
                          'type' => 'personal',  
                          'role' => {  
                                      'roleTerm' => {  
 7024                                                 'content' => 'illustrator',  
                                                      'type' => 'text'  
                                                    }  
                                    }  
                        }  
                      ],  
            'note' => 'bibliogr: 645-647; kazalo; ilustr: ilustr.',  
            'identifier' => {  
 010a                         'content' => '0-471-36483-5',  
                              'type' => 'isbn'  
                            },  
 215a;215d  'physicalDescription' => 'str: 688; pagin: xvi; visina: 24. cm',  
 001        'recordInfo' => {  
                              'recordIdentifier' => 'k-7996-8073'  
                            },  
 200a       'titleInfo' => {  
                             'title' => 'Handbook of data processing for libraries'  
                           },  
            'typeOfResource' => 'text',  
 675a       'classification' => {  
                                  'udc' => '=20'  
                                },  
 225a       'relatedItem' => {  
                               'titleInfo' => {  
                                                'title' => 'A WILEY-BECKER & HAYES  SERIES BOOK'  
                                              },  
                               'type' => 'series'  
                             },  
            'originInfo' => {  
                              'issuance' => 'monographic',  
 205a                         'edition' => '2.',  
 210c/210a                    'publisher' => 'MELVILLE PUBLISHING COMPANY /LOS ANGELES, CALIFORNIA/',  
 210d                         'dateIssued' => '1974'  
                            }  
          };  
   
   
   
  CASOPIS = {  
            'identifier' => {  
 011a                         'content' => '1041-5173',  
                              'type' => 'issn'  
                            },  
            'recordInfo' => {  
                              'recordIdentifier' => 'c-1'  
                            },  
            'titleInfo' => {  
                             'title' => 'DBMS - CLIENT/SERVER COMPUTING'  
                           },  
            'typeOfResource' => 'text',  
 999a       'relatedItem' => {  
                               'titleInfo' => {  
                                                'partNumber' => 'g. 1990, vol. 137, br. 5'  
                                              },  
                               'type' => 'series'  
                             },  
            'classification' => {  
                                  'udc' => '=20'  
                                },  
            'originInfo' => {  
 326a                         'frequency' => 'mjese�no',  
                              'issuance' => 'continuing',  
 210a                         'place' => 'SAN MATEO, KANADA',  
 210c                         'publisher' => 'M&T PUBLISHING INC.'  
                            }  
          };  
333    
334            $m_cache = {};
335    
336  =cut          $t->purge;           # frees the memory
337    }
338    
Legend:
Removed from v.325  
changed lines
  Added in v.328
  ViewVC Help
Powered by ViewVC 1.1.26