/[webpac]/trunk/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 /trunk/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 336 by dpavlin, Thu Jun 10 19:20:05 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    $ENCODING = 'windows-1250';
57    
58  my $twig=XML::Twig->new(  my $twig=XML::Twig->new(
59          twig_roots => { 'mods' => \&item },          twig_roots => { 'mods' => \&mods },
60          output_encoding => 'iso-8859-2',          output_encoding => 'UTF8',
61  );  );
62    
63  my $utf2iso = Text::Iconv->new("UTF-8", "ISO-8859-2");  my $utf2iso = Text::Iconv->new("UTF8", $ENCODING);
64    
65  $twig->parsefile($xml_file);  foreach my $xml_file (@ARGV) {
66  $twig->purge;          print "$xml_file: ";
67            $twig->parsefile($xml_file);
68            $twig->purge;
69            print "$nr\n";
70    }
71    
72    print "Saving MARC file...\n";
73    
74  $marc->output({file=>"> $marc_file",'format'=>"usmarc"});  $marc->output({file=>"> $marc_file",'format'=>"usmarc"});
75    
76  sub item {  sub mods {
77          my( $t, $elt)= @_;          my( $t, $elt)= @_;
78    
79          my $xml=$elt->xml_string;          my $xml=$elt->xml_string;
80          my $ref = XMLin("<xml>".$xml."</xml>",          my $ref = XMLin('<xml>'.$xml.'</xml>',
81                  ForceArray => [                  ForceArray => [
82                          'name',                          'name',
83                          'classification',                          'classification',
84                          'topic',                          'topic',
85                          'udc',                          'relatedItem',
86                            'partNumber',
87                  ],                  ],
88                  KeyAttr => {                  KeyAttr => {
89                          'namePart' => 'type',                          'namePart' => 'type',
90                          'identifier' => 'type',                          'identifier' => 'type',
                         'classification' => 'authority',  
91                          'namePart' => 'type',                          'namePart' => 'type',
92                          'role' => 'type',                          'role' => 'type',
93                  },                  },
# Line 82  sub item { Line 99  sub item {
99                  ContentKey => '-content',                  ContentKey => '-content',
100          );          );
101    
102          my $m=$marc->createrecord();          my $m_cache;
103    
104          sub marc_arr {          sub marc_add {
105                  my $m = shift || die "no marc record?";                  my $m_cache = \shift || die "need m_cache";
106                  my $fld = shift || die "no marc field?";                  my $fld = shift || die "need field!";
107                  my $sf = shift || '';                  my $sf = shift;
108                    my $data = shift || return;
109    
110                  return if (! @_);  #print "add: $fld",($sf ? "^".$sf : ''),": $data\n";
111    
112                  my @a;                  if ($sf) {
113                  foreach (@_) {                          push @{$$m_cache->{tmp}->{$fld}}, $sf;
                         next if (! $_);  
                         push @a,$sf;  
 #                       push @a,$utf2iso->convert($_) || $_;  
                         push @a,$_;  
114                  }                  }
115                    push @{$$m_cache->{tmp}->{$fld}}, $utf2iso->convert($data);
116            }
117    
118                  return if (! @a);          sub marc_rep {
119                    my $m_cache = \shift || die "need m_cache";
120                    foreach my $fld (@_) {
121    #print "marc_rep: $fld\n";      
122                            push @{$$m_cache->{array}->{$fld}}, [ @{$$m_cache->{tmp}->{$fld}} ] if ($$m_cache->{tmp}->{$fld});
123                            delete $$m_cache->{tmp}->{$fld};
124                    }
125            }
126    
127  #               print "storing $fld: ",join("|",@a),"\n";          sub marc_single {
128                    my $m_cache = \shift || die "need m_cache";
129                    foreach my $fld (@_) {
130    #print "marc_single: $fld\n";  
131    
132                  $marc->addfield({record=>$m,                          die "$fld already defined! not single?" if ($$m_cache->{single}->{$fld});
133                          field=>$fld,  
134          #               i1=>$i1,                          $$m_cache->{single}->{$fld} = \@{$$m_cache->{tmp}->{$fld}} if ($$m_cache->{tmp}->{$fld});
135          #               i2=>$i2,                          delete $$m_cache->{tmp}->{$fld};
136                  value=>\@a});                  }
137            }
138    
139            sub marc_add_rep {
140                    my $m_cache = \shift || die "need m_cache";
141                    my $fld = shift || die "need field!";
142                    my $sf = shift;
143                    my $data = shift || return;
144    
145                    marc_add($$m_cache,$fld,$sf,$data);
146                    marc_rep($$m_cache,$fld);
147          }          }
148    
149          marc_arr($m,'610','a',@{$ref->{subject}->{topic}});          sub marc_add_single {
150                    my $m_cache = \shift || die "need m_cache";
151                    my $fld = shift || die "need field!";
152                    my $sf = shift;
153                    my $data = shift || return;
154    
155          my $fld = '700';                  marc_add($$m_cache,$fld,$sf,$data);
156                    marc_single($$m_cache,$fld);
157            }
158    
159            my $journal = 0;
160            # Journals start with c- in our MODS
161            $journal = 1 if ($ref->{recordInfo}->{recordIdentifier} =~ m/^c-/);
162    
163            foreach my $t (@{$ref->{subject}->{topic}}) {
164                    marc_add($m_cache,'610','a', $t);
165                    marc_rep($m_cache,'610');
166            }
167    
168            my $fld_700 = '700';
169            my $fld_710 = '710';
170    
171          foreach my $name (@{$ref->{name}}) {          foreach my $name (@{$ref->{name}}) {
172                  my $role = $name->{role}->{roleTerm}->{content};                  my $role = $name->{role}->{roleTerm}->{content};
173                  next if (! $role);                  next if (! $role);
174                  if ($role eq "author") {                  if ($role eq "author") {
175                          marc_arr($m,$fld,'a',$name->{namePart}->{family});                          marc_add($m_cache,$fld_700,'a',$name->{namePart}->{family});
176                          marc_arr($m,$fld,'b',$name->{namePart}->{given});                          marc_add($m_cache,$fld_700,'b',$name->{namePart}->{given});
177                          marc_arr($m,$fld,'4',$role);                          marc_add($m_cache,$fld_700,'4',$role);
178    
179                            marc_rep($m_cache,$fld_700);
180    
181                          # first author goes in 700, others in 701                          # first author goes in 700, others in 701
182                          $fld = '701';                          $fld_700 = '701';
183                  } elsif ($role eq "editor" or $role eq "illustrator") {                  } elsif ($role eq "editor" or $role eq "illustrator") {
184                          marc_arr($m,'702','a',$name->{namePart}->{family});                          marc_add($m_cache,'702','a',$name->{namePart}->{family});
185                          marc_arr($m,'702','b',$name->{namePart}->{given});                          marc_add($m_cache,'702','b',$name->{namePart}->{given});
186                          marc_arr($m,'702','4',$role);                          marc_add($m_cache,'702','4',$role);
187                            marc_rep($m_cache,'702');
188                    } elsif ($role eq "corporate") {
189                            marc_add_single($m_cache,"$fld_710\t0 ",'a',$name->{namePart});
190                            $fld_710 = '711';
191                    } elsif ($role eq "conference") {
192                            marc_add_single($m_cache,"$fld_710\t1 ",'a',$name->{namePart});
193                            $fld_710 = '711';
194                  } else {                  } else {
195                          die "FATAL: don't know how to map role '$role'" if ($role);                          die "FATAL: don't know how to map role '$role'" if ($role);
196                  }                  }
# Line 138  sub item { Line 201  sub item {
201          if ($note) {          if ($note) {
202                  foreach my $n (split(/\s*;\s+/, $note)) {                  foreach my $n (split(/\s*;\s+/, $note)) {
203                          if ($n =~ s/bibliogr:\s+//i) {                          if ($n =~ s/bibliogr:\s+//i) {
204                                  marc_arr($m,'320','a',"Bibliografija: $n");                                  marc_add_rep($m_cache,'320','a',"Bibliografija: $n");
205                          } elsif ($n =~ s/ilustr:\s+//i) {                          } elsif ($n =~ s/ilustr:\s+//i) {
206                                  marc_arr($m,'215','c', $n);                                  marc_add($m_cache,'215','c', $n);
207                          } else {                          } else {
208                                  marc_arr($m,'320','a',$n);                                  marc_add_rep($m_cache,'320','a',$n);
209                          }                          }
210                  }                  }
211          }          }
212                            
213    
214          my $type = $ref->{identifier}->{type};          my $type = $ref->{identifier}->{type};
215    
216          if ($type) {          if ($type) {
217                  if ($type eq "isbn") {                  if ($type eq "isbn") {
218                          marc_arr($m,'010','a',$ref->{identifier}->{content});                          marc_add_rep($m_cache,'010','a',$ref->{identifier}->{content});
219                  } elsif ($type eq "issn") {                  } elsif ($type eq "issn") {
220                          marc_arr($m,'011','a',$ref->{identifier}->{content});                          marc_add_rep($m_cache,'011','a',$ref->{identifier}->{content});
221                    } elsif ($type eq "uri") {
222                            marc_add_rep($m_cache,'856','u',$ref->{identifier}->{content});
223                  } else {                  } else {
224                          die "unknown identifier type $type";                          die "unknown identifier type $type";
225                  }                  }
# Line 167  sub item { Line 232  sub item {
232                          if ($t =~ m/([^:]+):\s+(.+)$/) {                          if ($t =~ m/([^:]+):\s+(.+)$/) {
233                                  $tmp->{$1} = $2;                                  $tmp->{$1} = $2;
234                          } else {                          } else {
235                                  die "can't parse $t";                                  print STDERR "can't parse '$t' in ",Dumper($phy_desc);
236                          }                          }
237                  }                  }
238                  my $data = $tmp->{pagin};                  my $data = $tmp->{pagin};
# Line 175  sub item { Line 240  sub item {
240                  if ($tmp->{str}) {                  if ($tmp->{str}) {
241                          $data .= $tmp->{str}." str";                          $data .= $tmp->{str}." str";
242                  }                  }
243                  marc_arr($m,'210','a', $data) if ($data);                  marc_add($m_cache,'215','a', $data) if ($data);
244                  marc_arr($m,'210','d', $tmp->{visina});                  marc_add($m_cache,'215','d', $tmp->{visina});
245          }          }
246            marc_rep($m_cache,'215');
247    
248          marc_arr($m,'001','',$ref->{recordInfo}->{recordIdentifier});          my $mfn = $ref->{recordInfo}->{recordIdentifier};
249            $mfn =~ s/[^0-9]//g;
250          marc_arr($m,'200','a',$ref->{titleInfo}->{title});          marc_add_single($m_cache,'001',undef,$mfn);
251          marc_arr($m,'200','e',$ref->{titleInfo}->{subTitle});  
252            marc_add($m_cache,'200','a',$ref->{titleInfo}->{title});
253          marc_arr($m,'675','a',$ref->{classification}->{udc});          marc_add($m_cache,'200','e',$ref->{titleInfo}->{subTitle});
254            marc_single($m_cache,'200');
255    
256            foreach my $c (@{$ref->{classification}}) {
257                    if ($c->{'authority'} eq "udc") {
258                            marc_add_rep($m_cache,'675','a', $c->{'content'});
259                    }
260            }
261    
262          my $related = $ref->{relatedItem}->{type};          foreach my $ri (@{$ref->{relatedItem}}) {
263          if ($related) {                  my $related = $ri->{type};
264                  if ($related eq "series") {                  if ($related) {
265                          marc_arr($m,'675','a',$ref->{relatedItem}->{titleInfo}->{title});                          if ($related eq "series") {
266                          marc_arr($m,'999','a',$ref->{relatedItem}->{titleInfo}->{partNumber});                                  marc_add_rep($m_cache,'225','a',$ri->{titleInfo}->{title});
267                  } elsif ($related eq "preceding") {                                  foreach my $pn (@{$ri->{titleInfo}->{partNumber}}) {
268                          marc_arr($m,'430','a',$ref->{relatedItem}->{titleInfo}->{title});                                          if ($journal) {
269                  } else {                                                  marc_add_rep($m_cache,'999','a',$pn);
270                          die "can't parse related item type $related" if ($related);                                          } else {
271                                                    marc_add_rep($m_cache,'225','v',$pn);
272                                            }
273                                    }
274                            } elsif ($related eq "preceding") {
275                                    marc_add($m_cache,'520','a',$ri->{titleInfo}->{title});
276                                    if ($ri->{identifier}) {
277                                            if ($ri->{identifier}->{type} eq "issn") {
278                                                    marc_add($m_cache,'520','x',$ri->{identifier}->{content});
279                                            } else {
280                                                    die "can't store identifier type $type";
281                                            }
282                                    }
283                                    marc_rep($m_cache,'520');
284                            } else {
285                                    die "can't parse related item type $related" if ($related);
286                            }
287                  }                  }
288          }          }
289    
290          marc_arr($m,'205','a',$ref->{originInfo}->{edition});          marc_add_single($m_cache,'205','a',$ref->{originInfo}->{edition});
291    
292            marc_add($m_cache,'210','a',$ref->{originInfo}->{place});
293    
294          my $publisher = $ref->{originInfo}->{publisher};          my $publisher = $ref->{originInfo}->{publisher};
295          if ($publisher =~ m,^(.+?)\s*/\s*(.+)$,) {          if ($publisher =~ m,^(.+?)\s*/\s*(.+)$,) {
296                  marc_arr($m,'210','a', $2);                  marc_add($m_cache,'210','a', $2);
297                  marc_arr($m,'210','c', $1);                  marc_add($m_cache,'210','c', $1);
298          } else {          } else {
299                  marc_arr($m,'210','c', $publisher);                  marc_add($m_cache,'210','c', $publisher);
300          }          }
301    
302          marc_arr($m,'326','a',$ref->{originInfo}->{frequency});          marc_add($m_cache,'210','d',$ref->{originInfo}->{dateIssued});
303          marc_arr($m,'326','a',$ref->{originInfo}->{place});  
304            marc_single($m_cache,'210');
305    
306          marc_arr($m,'210','d',$ref->{originInfo}->{dateIssued});          marc_add_single($m_cache,'326','a',$ref->{originInfo}->{frequency}) if ($journal);
307    
308          $nr++;          $nr++;
309          print "$nr " if ($nr % 100 == 0);          print "$nr " if ($nr % 100 == 0);
310    
311          $t->purge;           # frees the memory          # dump record
312  }          my $bib_level = "m";
313            $bib_level = "s" if ($journal);
314  __END__          my $m=$marc->createrecord({leader=>"00000na".$bib_level."  2200000 a 4500"});
315    
316            foreach my $fld (keys %{$m_cache->{array}}) {
317                    foreach my $arr (@{$m_cache->{array}->{$fld}}) {
318    #print "array = ",Dumper($arr);
319                            my ($i1,$i2);
320                            # do we have indicators?
321                            if ($fld =~ m/^(.+)\t(.)(.)$/) {
322                                    $fld = $1;
323                                    ($i1,$i2) = ($2,$3);
324                            }
325                            $marc->addfield({record=>$m,
326                                    field=>$fld,
327                                    i1=>$i1,
328                                    i2=>$i2,
329                                    value=>$arr
330                            });
331                    }
332            }
333    
334  KNJIGA = {          foreach my $fld (keys %{$m_cache->{single}}) {
335  610a           'subject' => [  #print "single = ",Dumper($m_cache->{single}->{$fld});
336                            {                  my ($i1,$i2);
337                              'topic' => [                  # do we have indicators?
338                                               'LIBRARIES-AUTOMATION',                  if ($fld =~ m/^(.+)\t(.)(.)$/) {
339                                               'ELECTRONIC DATA PROCESSING-LIBRARY SCIENCE'                          $fld = $1;
340                                         ]                          ($i1,$i2) = ($2,$3);
341                            }                  }
342                          ],                  $marc->addfield({record=>$m,
343             'name' => [                          field=>$fld,
344                         {                          i1=>$i1,
345                           'namePart' => {                          i2=>$i2,
346  700b,701a...                                 'given' => 'Robert M.',                          value=>$m_cache->{single}->{$fld}
347  700a,701b...                                 'family' => 'Hayes'                  });
348                                         },          }
                          '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.'  
                            }  
          };  
349    
350            $m_cache = {};
351    
352  =cut          $t->purge;           # frees the memory
353    }
354    
Legend:
Removed from v.325  
changed lines
  Added in v.336
  ViewVC Help
Powered by ViewVC 1.1.26