acqui.simple/bulkmarcimport.pl

   1 #!/usr/bin/perl
   2 #
   3 # Tool for importing bulk marc records
   4 #
   5 # WARNING!!
   6 #
   7 # Do not use this script on a production system, it is still in development
   8 #
   9 #
  10
  11
  12
  13
  14 $file=$ARGV[0];
  15
  16 unless ($file) {
  17     print "USAGE: ./bulkmarcimport.pl filename\n";
  18     exit;
  19 }
  20
  21
  22
  23
  24 my $lc1='#dddddd';
  25 my $lc2='#ddaaaa';
  26
  27
  28 use C4::Database;
  29 use CGI;
  30 use DBI;
  31 #use strict;
  32 use C4::Acquisitions;
  33 use C4::Output;
  34 my $dbh=C4Connect;
  35 my $userid=$ENV{'REMOTE_USER'};
  36 %tagtext = (
  37     '001' => 'Control number',
  38     '003' => 'Control number identifier',
  39     '005' => 'Date and time of latest transaction',
  40     '006' => 'Fixed-length data elements -- additional material characteristics',
  41     '007' => 'Physical description fixed field',
  42     '008' => 'Fixed length data elements',
  43     '010' => 'LCCN',
  44     '015' => 'LCCN Cdn',
  45     '020' => 'ISBN',
  46     '022' => 'ISSN',
  47     '037' => 'Source of acquisition',
  48     '040' => 'Cataloging source',
  49     '041' => 'Language code',
  50     '043' => 'Geographic area code',
  51     '050' => 'Library of Congress call number',
  52     '060' => 'National Library of Medicine call number',
  53     '082' => 'Dewey decimal call number',
  54     '100' => 'Main entry -- Personal name',
  55     '110' => 'Main entry -- Corporate name',
  56     '130' => 'Main entry -- Uniform title',
  57     '240' => 'Uniform title',
  58     '245' => 'Title statement',
  59     '246' => 'Varying form of title',
  60     '250' => 'Edition statement',
  61     '256' => 'Computer file characteristics',
  62     '260' => 'Publication, distribution, etc.',
  63     '263' => 'Projected publication date',
  64     '300' => 'Physical description',
  65     '306' => 'Playing time',
  66     '440' => 'Series statement / Added entry -- Title',
  67     '490' => 'Series statement',
  68     '500' => 'General note',
  69     '504' => 'Bibliography, etc. note',
  70     '505' => 'Formatted contents note',
  71     '508' => 'Creation/production credits note',
  72     '510' => 'Citation/references note',
  73     '511' => 'Participant or performer note',
  74     '520' => 'Summary, etc. note',
  75     '521' => 'Target audience note (ie age)',
  76     '530' => 'Additional physical form available note',
  77     '538' => 'System details note',
  78     '586' => 'Awards note',
  79     '600' => 'Subject added entry -- Personal name',
  80     '610' => 'Subject added entry -- Corporate name',
  81     '650' => 'Subject added entry -- Topical term',
  82     '651' => 'Subject added entry -- Geographic name',
  83     '656' => 'Index term -- Occupation',
  84     '700' => 'Added entry -- Personal name',
  85     '710' => 'Added entry -- Corporate name',
  86     '730' => 'Added entry -- Uniform title',
  87     '740' => 'Added entry -- Uncontrolled related/analytical title',
  88     '800' => 'Series added entry -- Personal name',
  89     '830' => 'Series added entry -- Uniform title',
  90     '852' => 'Location',
  91     '856' => 'Electronic location and access',
  92 );
  93
  94
  95 my $dbh=C4Connect;
  96 if ($file) {
  97     open (F, "$file");
  98     my $data=<F>;
  99     close F;
 100     $splitchar=chr(29);
 101 RECORD:
 102     foreach $record (split(/$splitchar/, $data)) {
 103         my $marctext="<table border=0 cellspacing=0>\n";
 104         $marctext.="<tr><th colspan=3 bgcolor=black><font color=white>MARC RECORD</font></th></tr>\n";
 105         $leader=substr($record,0,24);
 106         $marctext.="<tr><td>Leader:</td><td colspan=2>$leader</td></tr>\n";
 107         print "\n\n---------------------------------------------------------------------------\n";
 108         print "Leader: $leader\n";
 109         $record=substr($record,24);
 110         $splitchar2=chr(30);
 111         my $directory=0;
 112         my $tagcounter=0;
 113         my %tag;
 114         my @record;
 115         my %record;
 116         foreach $field (split(/$splitchar2/, $record)) {
 117             my %field;
 118             ($color eq $lc1) ? ($color=$lc2) : ($color=$lc1);
 119             unless ($directory) {
 120                 $directory=$field;
 121                 my $itemcounter=1;
 122                 $counter=0;
 123                 while ($item=substr($directory,0,12)) {
 124                     $tag=substr($directory,0,3);
 125                     $length=substr($directory,3,4);
 126                     $start=substr($directory,7,6);
 127                     $directory=substr($directory,12);
 128                     $tag{$counter}=$tag;
 129                     $counter++;
 130                 }
 131                 $directory=1;
 132                 next;
 133             }
 134             $tag=$tag{$tagcounter};
 135             $tagcounter++;
 136             $field{'tag'}=$tag;
 137             $marctext.="<tr><td bgcolor=$color valign=top>$tagtext{$tag}</td><td bgcolor=$color valign=top>$tag</td>";
 138             printf "%4s %-40s ",$tag, $tagtext{$tag};
 139             $splitchar3=chr(31);
 140             my @subfields=split(/$splitchar3/, $field);
 141             $indicator=$subfields[0];
 142             $field{'indicator'}=$indicator;
 143             my $firstline=1;
 144             if ($#subfields==0) {
 145                 $marctext.="<td bgcolor=$color valign=top>$indicator</td></tr>";
 146                 print "$indicator\n";
 147             } else {
 148                 print "\n";
 149                 my %subfields;
 150                 $marctext.="<td bgcolor=$color valign=top><table border=0 cellspacing=0>\n";
 151                 my $color2=$color;
 152                 for ($i=1; $i<=$#subfields; $i++) {
 153                     ($color2 eq $lc1) ? ($color2=$lc2) : ($color2=$lc1);
 154                     my $text=$subfields[$i];
 155                     my $subfieldcode=substr($text,0,1);
 156                     my $subfield=substr($text,1);
 157                     $marctext.="<tr><td colour=$color2><table border=0 cellpadding=0 cellspacing=0><tr><td>$subfieldcode </td></tr></table></td><td colour=$color2>$subfield</td></tr>\n";
 158                     print "   $subfieldcode $subfield\n";
 159                     if ($subfields{$subfieldcode}) {
 160                         my $subfieldlist=$subfields{$subfieldcode};
 161                         my @subfieldlist=@$subfieldlist;
 162                         if ($#subfieldlist>=0) {
 163                             push (@subfieldlist, $subfield);
 164                         } else {
 165                             @subfieldlist=($subfields{$subfieldcode}, $subfield);
 166                         }
 167                         $subfields{$subfieldcode}=\@subfieldlist;
 168                     } else {
 169                         $subfields{$subfieldcode}=$subfield;
 170                     }
 171                 }
 172                 $marctext.="</table></td></tr>\n";
 173                 $field{'subfields'}=\%subfields;
 174             }
 175             if ($record{$tag}) {
 176                 my $fieldlist=$record{$tag};
 177                 if ($fieldlist->{'tag'}) {
 178                     @fieldlist=($fieldlist, \%field);
 179                     $fieldlist=\@fieldlist;
 180                 } else {
 181                     push (@$fieldlist,\%field);
 182                 }
 183                 $record{$tag}=$fieldlist;
 184             } else {
 185                 $record{$tag}=[\%field];
 186             }
 187             push (@record, \%field);
 188         }
 189         $marctext.="</table>\n";
 190         $rec=\@record;
 191         $counter++;
 192         my ($lccn, $isbn, $issn, $dewey, $author, $title, $place, $publisher, $publicationyear, $volume, $number, @subjects, $note, $additionalauthors, $illustrator, $copyrightdate, $barcode, $itemtype, $seriestitle, @barcodes);
 193         my $marc=$record;
 194         foreach $field (sort {$a->{'tag'} cmp $b->{'tag'}} @$rec) {
 195             #print $field->{'tag'}." ".$field->{'subfields'}->{'a'}."\n";
 196             if ($field->{'tag'} eq '010') {
 197                 $lccn=$field->{'subfields'}->{'a'};
 198                 $lccn=~s/^\s*//;
 199                 $lccn=~s/cn //;
 200                 $lccn=~s/^\s*//;
 201                 ($lccn) = (split(/\s+/, $lccn))[0];
 202             }
 203             if ($field->{'tag'} eq '015') {
 204                 $lccn=$field->{'subfields'}->{'a'};
 205                 $lccn=~s/^\s*//;
 206                 $lccn=~s/^C//;
 207                 ($lccn) = (split(/\s+/, $lccn))[0];
 208             }
 209             if ($field->{'tag'} eq '020') {
 210                 $isbn=$field->{'subfields'}->{'a'};
 211                 $isbn=~s/^\s*//;
 212                 ($isbn) = (split(/\s+/, $isbn))[0];
 213             }
 214             if ($field->{'tag'} eq '022') {
 215                 $issn=$field->{'subfields'}->{'a'};
 216                 $issn=~s/^\s*//;
 217                 ($issn) = (split(/\s+/, $issn))[0];
 218             }
 219             if ($field->{'tag'} eq '082') {
 220                 $dewey=$field->{'subfields'}->{'a'};
 221                 print "DEWEY: $dewey\n";
 222                 $dewey=~s/\///g;
 223                 if (@$dewey) {
 224                     $dewey=$$dewey[0];
 225                 }
 226                 #$dewey=~s/\///g;
 227             }
 228             if ($field->{'tag'} eq '100') {
 229                 $author=$field->{'subfields'}->{'a'};
 230             }
 231             if ($field->{'tag'} eq '245') {
 232                 $title=$field->{'subfields'}->{'a'};
 233                 $title=~s/ \/$//;
 234                 $subtitle=$field->{'subfields'}->{'b'};
 235                 $subtitle=~s/ \/$//;
 236                 my $name=$field->{'subfields'}->{'c'};
 237                 if ($name=~/illustrated by]*\s+(.*)/) {
 238                     $illustrator=$1;
 239                 }
 240             }
 241             if ($field->{'tag'} eq '260') {
 242                 $place=$field->{'subfields'}->{'a'};
 243                 if (@$place) {
 244                     $place=$$place[0];
 245                 }
 246                 $place=~s/\s*:$//g;
 247                 $publisher=$field->{'subfields'}->{'b'};
 248                 if (@$publisher) {
 249                     $publisher=$$publisher[0];
 250                 }
 251                 $publisher=~s/\s*:$//g;
 252                 $publicationyear=$field->{'subfields'}->{'c'};
 253                 if ($publicationyear=~/c(\d\d\d\d)/) {
 254                     $copyrightdate=$1;
 255                 }
 256                 if ($publicationyear=~/[^c](\d\d\d\d)/) {
 257                     $publicationyear=$1;
 258                 } elsif ($copyrightdate) {
 259                     $publicationyear=$copyrightdate;
 260                 } else {
 261                     $publicationyear=~/(\d\d\d\d)/;
 262                     $publicationyear=$1;
 263                 }
 264             }
 265             if ($field->{'tag'} eq '300') {
 266                 $pages=$field->{'subfields'}->{'a'};
 267                 $pages=~s/ \;$//;
 268                 $size=$field->{'subfields'}->{'c'};
 269                 $pages=~s/\s*:$//g;
 270                 $size=~s/\s*:$//g;
 271             }
 272             if ($field->{'tag'} eq '362') {
 273                 if ($field->{'subfields'}->{'a'}=~/(\d+).*(\d+)/) {
 274                     $volume=$1;
 275                     $number=$2;
 276                 }
 277             }
 278             if ($field->{'tag'} eq '440') {
 279                 $seriestitle=$field->{'subfields'}->{'a'};
 280                 if ($field->{'subfields'}->{'v'}=~/(\d+).*(\d+)/) {
 281                     $volume=$1;
 282                     $number=$2;
 283                 }
 284             }
 285             if ($field->{'tag'} eq '852') {
 286                 $barcode=$field->{'subfields'}->{'p'};
 287                 push (@barcodes, $barcode);
 288                 print "BARCODE: $barcode\n";
 289                 my $q_barcode=$dbh->quote($barcode);
 290                 my $deweyfield=$field->{'subfields'}->{'h'};
 291                 $deweyfield=~/^([\d\.]*)/;
 292                 $dewey=$1;
 293                 if (($deweyfield=~/pbk/) || ($deweyfield=~/pb$/)) {
 294                     $itemtype='PBK';
 295                 } elsif ($dewey) {
 296                     $itemtype='JNF';
 297                 } else {
 298                     $itemtype='JF';
 299                 }
 300
 301                 $replacementprice=$field->{'subfields'}->{'9'};
 302                 #print "BC: $barcode, $title, $author\n";
 303             }
 304             if ($field->{'tag'} eq '700') {
 305                 my $name=$field->{'subfields'}->{'a'};
 306                 if ($field->{'subfields'}->{'c'}=~/ill/) {
 307                     $illustrator=$name;
 308                 } else {
 309                     $additionalauthors.="$name\n";
 310                 }
 311             }
 312             if ($field->{'tag'} =~/^5/) {
 313                 $note.="$field->{'subfields'}->{'a'}\n";
 314             }
 315             if ($field->{'tag'} =~/6\d\d/) {
 316                 (next) if ($field->{'tag'} eq '691');
 317                 my $subject=$field->{'subfields'}->{'a'};
 318                 print "SUBJECT: $subject\n";
 319                 $subject=~s/\.$//;
 320                 if ($gensubdivision=$field->{'subfields'}->{'x'}) {
 321                     my @sub=@$gensubdivision;
 322                     if ($#sub>=0) {
 323                         foreach $s (@sub) {
 324                             $s=~s/\.$//;
 325                             $subject.=" -- $s";
 326                         }
 327                     } else {
 328                         $gensubdivision=~s/\.$//;
 329                         $subject.=" -- $gensubdivision";
 330                     }
 331                 }
 332                 if ($chronsubdivision=$field->{'subfields'}->{'y'}) {
 333                     my @sub=@$chronsubdivision;
 334                     if ($#sub>=0) {
 335                         foreach $s (@sub) {
 336                             $s=~s/\.$//;
 337                             $subject.=" -- $s";
 338                         }
 339                     } else {
 340                         $chronsubdivision=~s/\.$//;
 341                         $subject.=" -- $chronsubdivision";
 342                     }
 343                 }
 344                 if ($geosubdivision=$field->{'subfields'}->{'z'}) {
 345                     my @sub=@$geosubdivision;
 346                     if ($#sub>=0) {
 347                         foreach $s (@sub) {
 348                             $s=~s/\.$//;
 349                             $subject.=" -- $s";
 350                         }
 351                     } else {
 352                         $geosubdivision=~s/\.$//;
 353                         $subject.=" -- $geosubdivision";
 354                     }
 355                 }
 356                 push @subjects, $subject;
 357             }
 358         }
 359
 360         my $q_isbn=$dbh->quote($isbn);
 361         my $q_issn=$dbh->quote($issn);
 362         my $q_lccn=$dbh->quote($lccn);
 363         my $sth=$dbh->prepare("select biblionumber,biblioitemnumber from biblioitems where issn=$q_issn or isbn=$q_isbn or lccn=$q_lccn");
 364         $sth->execute;
 365         my $biblionumber=0;
 366         my $biblioitemnumber=0;
 367         if ($sth->rows) {
 368             ($biblionumber, $biblioitemnumber) = $sth->fetchrow;
 369             my $title=$title;
 370 #title already in the database
 371         } else {
 372             my $q_title=$dbh->quote("$title");
 373             my $q_subtitle=$dbh->quote("$subtitle");
 374             my $q_author=$dbh->quote($author);
 375             my $q_copyrightdate=$dbh->quote($copyrightdate);
 376             my $q_seriestitle=$dbh->quote($seriestitle);
 377             $sth=$dbh->prepare("select biblionumber from biblio where title=$q_title and author=$q_author and copyrightdate=$q_copyrightdate and seriestitle=$q_seriestitle");
 378             $sth->execute;
 379             if ($sth->rows) {
 380                 ($biblionumber) = $sth->fetchrow;
 381 #title already in the database
 382             } else {
 383                 $sth=$dbh->prepare("select max(biblionumber) from biblio");
 384                 $sth->execute;
 385                 ($biblionumber) = $sth->fetchrow;
 386                 $biblionumber++;
 387                 my $q_notes=$dbh->quote($note);
 388                 $sth=$dbh->prepare("insert into biblio (biblionumber, title, author, copyrightdate, seriestitle, notes) values ($biblionumber, $q_title, $q_author, $q_copyrightdate, $q_seriestitle, $q_notes)");
 389                 $sth->execute;
 390                 $sth=$dbh->prepare("insert into bibliosubtitle values ($q_subtitle, $biblionumber)");
 391                 $sth->execute;
 392             }
 393             $sth=$dbh->prepare("select max(biblioitemnumber) from biblioitems");
 394             $sth->execute;
 395             ($biblioitemnumber) = $sth->fetchrow;
 396             $biblioitemnumber++;
 397             my $q_isbn=$dbh->quote($isbn);
 398             my $q_issn=$dbh->quote($issn);
 399             my $q_lccn=$dbh->quote($lccn);
 400             my $q_volume=$dbh->quote($volume);
 401             my $q_number=$dbh->quote($number);
 402             my $q_itemtype=$dbh->quote($itemtype);
 403             my $q_dewey=$dbh->quote($dewey);
 404             $cleanauthor=$author;
 405             $cleanauthor=~s/[^A-Za-z]//g;
 406             $subclass=uc(substr($cleanauthor,0,3));
 407             my $q_subclass=$dbh->quote($subclass);
 408             my $q_publicationyear=$dbh->quote($publicationyear);
 409             my $q_publishercode=$dbh->quote($publishercode);
 410             my $q_volumedate=$dbh->quote($volumedate);
 411             my $q_volumeddesc=$dbh->quote($volumeddesc);
 412             my $q_illus=$dbh->quote($illustrator);
 413             my $q_pages=$dbh->quote($pages);
 414             my $q_notes=$dbh->quote($note);
 415             ($q_notes) || ($q_notes="''");
 416             my $q_size=$dbh->quote($size);
 417             my $q_place=$dbh->quote($place);
 418             my $q_marc=$dbh->quote($marc);
 419
 420             $sth=$dbh->prepare("insert into biblioitems (biblioitemnumber, biblionumber, volume, number, itemtype, isbn, issn, dewey, subclass, publicationyear, publishercode, volumedate, volumeddesc, illus, pages, size, place, lccn, marc) values ($biblioitemnumber, $biblionumber, $q_volume, $q_number, $q_itemtype, $q_isbn, $q_issn, $q_dewey, $q_subclass, $q_publicationyear, $q_publishercode, $q_volumedate, $q_volumeddesc, $q_illus, $q_pages, $q_size, $q_place, $q_lccn, $q_marc)");
 421             $sth->execute;
 422             my $subjectheading;
 423             foreach $subjectheading (@subjects) {
 424                 # convert to upper case
 425                 $subjectheading=uc($subjectheading);
 426                 # quote value
 427                 my $q_subjectheading=$dbh->quote($subjectheading);
 428                 $sth=$dbh->prepare("insert into bibliosubject (biblionumber,subject)
 429                     values ($biblionumber, $q_subjectheading)");
 430                 $sth->execute;
 431             }
 432             my @additionalauthors=split(/\n/,$additionalauthors);
 433             my $additionalauthor;
 434             foreach $additionalauthor (@additionalauthors) {
 435                 # remove any line ending characters (Ctrl-L or Ctrl-M)
 436                 $additionalauthor=~s/\013//g;
 437                 $additionalauthor=~s/\010//g;
 438                 # convert to upper case
 439                 $additionalauthor=uc($additionalauthor);
 440                 # quote value
 441                 my $q_additionalauthor=$dbh->quote($additionalauthor);
 442                 $sth=$dbh->prepare("insert into additionalauthors (biblionumber,author) values ($biblionumber, $q_additionalauthor)");
 443                 $sth->execute;
 444             }
 445         }
 446         my $q_barcode=$dbh->quote($barcode);
 447         my $q_homebranch="'MAIN'";
 448         my $q_notes="''";
 449         #my $replacementprice=0;
 450         my $sth=$dbh->prepare("select max(itemnumber) from items");
 451         $sth->execute;
 452         my ($itemnumber) = $sth->fetchrow;
 453         $itemnumber++;
 454         my @datearr=localtime(time);
 455         my $date=(1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
 456 BARCODE:
 457         foreach $barcode (@barcodes) {
 458             my $q_barcode=$dbh->quote($barcode);
 459             my $sti=$dbh->prepare("select barcode from items where barcode=$q_barcode");
 460             $sti->execute;
 461             if ($sti->rows) {
 462                 print "Skipping $barcode\n";
 463                 next BARCODE;
 464             }
 465             $replacementprice=~s/^p//;
 466             ($replacementprice) || ($replacementprice=0);
 467             $replacementprice=~s/\$//;
 468             $task="insert into items (itemnumber, biblionumber, biblioitemnumber, barcode, itemnotes, homebranch, holdingbranch, dateaccessioned, replacementprice) values ($itemnumber, $biblionumber, $biblioitemnumber, $q_barcode, $q_notes, $q_homebranch, 'MAIN', '$date', $replacementprice)";
 469             $sth=$dbh->prepare($task);
 470             print "$task\n";
 471             $sth->execute;
 472         }
 473     }
 474 }
 475 $dbh->disconnect;