CROSBI.pm

   1 package CROSBI;
   2
   3 use warnings;
   4 use strict;
   5
   6 use MARC::Record;
   7 use Data::Dump qw/dump/;
   8 use DBI;
   9 use utf8;
  10
  11 use Scraper;
  12 use base 'Scraper';
  13
  14 my $debug = $ENV{DEBUG} || 0;
  15
  16 sub diag {
  17         warn "# ", @_, $/;
  18 }
  19
  20
  21 # Koha Z39.50 query:
  22 #
  23 # Bib-1 @and @and @and @and @and @and @and @or
  24 # @attr 1=4 title
  25 # @attr 1=7 isbn
  26 # @attr 1=8 issn
  27 # @attr 1=1003 author
  28 # @attr 1=16 dewey (godina)
  29 # @attr 1=21 subject-holding
  30 # @attr 1=12 control-no
  31 # @attr 1=1007 standard-id
  32 # @attr 1=1016 any
  33
  34 sub usemap {{
  35         4               => 'fti_pr:',
  36         7               => 'fti_pr:',
  37         8               => 'fti_pr:',
  38         1003            => 'fti_au:',
  39         16              => 'fti_pr:',
  40         21              => 'fti_pr:',
  41         12              => 'fti_pr:',
  42         1007            => 'fti_pr:',
  43         1016            => 'fti_au,fti_pr:',
  44 }};
  45
  46 =for sql
  47
  48 =cut
  49
  50 my $dbname = 'bibliografija';
  51 my $pg_user = $ENV{PGUSER} || '';
  52 my $pg_passwd = $ENV{PGPASSWD} || '';
  53 my $pg_host = $ENV{PGHOST} || '';
  54 my @and;
  55 my @exec;
  56
  57 sub search {
  58         my ( $self, $query ) = @_;
  59
  60         utf8::decode( $query );
  61         warn "QUERY",dump( $query );
  62
  63         die "ERROR need query" unless defined $query;
  64
  65         $query =~ s/^\s+//;
  66         $query =~ s/\s+$//;
  67
  68         my $table = lc $self->{database};
  69         $table =~ s/^crosbi-//g;
  70
  71         $self->{_table} = $table;
  72
  73         my $sql = qq{
  74
  75 select
  76         $table.*
  77         ,ARRAY( select napomena from rad_napomena where rad_napomena.id = $table.id ) as rad_napomena
  78         ,ARRAY( select projekt from rad_projekt where rad_projekt.id = $table.id ) as rad_projekt
  79         ,ARRAY( select datum from rad_godina where rad_godina.id = $table.id ) as rad_godina
  80         ,ARRAY( select sifra from rad_podrucje where rad_podrucje.id = $table.id ) as rad_podrucje
  81         ,ARRAY( select url from url where url.id = $table.id ) as url
  82 from $table
  83 inner join rad_ustanova using (id) -- sifra
  84         };
  85
  86         @and = ( qq{ rad_ustanova.sifra = ? } );
  87         @exec =  ( 130 ); # FIXME ustanova
  88
  89                 sub parse_fti {
  90                         my $query = shift;
  91                         warn "## parse_fti [$query]";
  92                         my $fti;
  93                         if ( $query =~ s/^(fti_.+):\s*// ) {
  94                                 $fti = $1;
  95                         } else {
  96                                 warn "INVALID QUERY no fti_xxx: [$query]";
  97                         }
  98
  99                         my $tsquery = join(' & ', split(/\s+/,$query) );
 100
 101                         my @or;
 102                         foreach my $f ( split(/,/,$fti) ) {
 103 #                               push @or, "$f @@ to_tsquery('english',?)";
 104 #                               push @exec, $tsquery;
 105
 106                                 push @or, "$f @@ to_tsquery('english',?) or $f @@ to_tsquery('croatian',?)";
 107                                 push @exec, $tsquery, $tsquery;
 108                         };
 109                         push @and, "( " . join(" or ", @or) . ")";
 110                 }
 111
 112         if ( $query =~ / AND / ) {
 113                 foreach my $and ( split(/ AND /, $query) ) {
 114                         parse_fti $and;
 115                 }
 116         } elsif ( $query =~ m/fti_.+:/ ) {
 117                 parse_fti $query;
 118         } else { # no " AND " in query
 119                 my $tsquery = join(' & ', split(/\s+/,$query) );
 120 #               push @and, "( fti_au @@ to_tsquery('english',?) or fti_pr @@ to_tsquery('english',?) )";
 121 #               push @exec, $tsquery,  $tsquery;
 122                 push @and, "( fti_au @@ to_tsquery('english',?) or fti_pr @@ to_tsquery('english',?) or fti_au @@ to_tsquery('croatian',?) or fti_pr @@ to_tsquery('croatian',?) )";
 123                 push @exec, $tsquery,  $tsquery, $tsquery,  $tsquery;
 124         }
 125
 126
 127         $sql .= "where " . join(" and ", @and);
 128
 129 warn "XXX SQL = ",$sql, dump( @exec );
 130
 131         my $dbh = DBI->connect_cached("dbi:Pg:dbname=$dbname;host=$pg_host", $pg_user, $pg_passwd, {AutoCommit => 0});
 132
 133         my $sth = $dbh->prepare( $sql );
 134
 135         $sth->execute( @exec );
 136
 137         my $hits = $sth->rows;
 138
 139         $self->{_sth} = $sth;
 140
 141         warn "# [$query] $hits hits\n";
 142
 143         return $self->{hits} = $hits;
 144 }
 145
 146 my $langrecode008 = {
 147         'bugarski' => 'bul',
 148         'Češki' => 'cze',
 149         'češki' => 'cze',
 150         'ENG' => 'eng',
 151         'Esperanto' => 'epo',
 152         'FRA' => 'fra',
 153         'GER' => 'ger',
 154         'HRV' => 'hrv',
 155         'ITA' => 'ita',
 156         'Japanski' => 'jpn',
 157         'Latinski' => 'lat',
 158         'mađarski' => 'hun',
 159         'Madžarski' => 'hun',
 160         'Makedonski' => 'mac',
 161         'nizozemski' => 'dut',
 162         'Poljski' => 'pol',
 163         'poljski' => 'pol',
 164         'Portugalski' => 'por',
 165         'portugalski' => 'por',
 166         'RUS' => 'rus',
 167         'Rumunjski' => 'rum',
 168         'rumunjski' => 'rum',
 169         'rusinski' => 'sla',
 170         'slovački' => 'slo',
 171         'slovenski' => 'slv',
 172         'SLV' => 'slv',
 173         'SPA' => 'spa',
 174         'Srpski' => 'srp',
 175         'srpski' => 'srp',
 176         'Turski' => 'tur',
 177         'turski' => 'tur',
 178         'ukrajinski' => 'ukr',
 179         'HRV-ENG' => 'mul',
 180         'HRV-GER' => 'mul',
 181         'hrvatsko-francuski' => 'mul',
 182 } ;
 183
 184 sub next_marc {
 185         my ($self,$format) = @_;
 186
 187         $format ||= 'marc';
 188
 189         my $sth = $self->{_sth} || die "ERROR no _sth";
 190         my $row = $sth->fetchrow_hashref;
 191
 192         warn "## row = ",dump($row) if $ENV{DEBUG};
 193
 194         warn "ERROR: no row" unless $row;
 195
 196         my $id = $row->{id} || die "ERROR no id";
 197
 198         my $marc = MARC::Record->new;
 199         $marc->encoding('UTF-8');
 200
 201         my $leader = $marc->leader;
 202
 203 # /srv/webpac2/conf/crosbi/2016-12-12/casopis-dbi2marc.pl
 204
 205 ## LDR 05 - n - new
 206 ## LDR 06 - a - language material
 207 ## LDR 07 - a - monographic component part
 208
 209         $leader =~ s/^(.....)...(.+)/$1naa$2/;
 210
 211 ## LDR 17 - Encoding level ; 7 - minimal level, u - unknown
 212 ## LDR 18 - i = isbd ; u = unknown
 213
 214         $leader =~ s/^(.{17})..(.+)/$1ui$2/;
 215
 216         $marc->leader( $leader );
 217         warn "# leader [$leader]";
 218
 219
 220 ### 008 - All materials
 221
 222 ## 008 - 00-05 - Date entered on file
 223
 224         my $f008 = $1 . $2 . $3 if $row->{time_date} =~ m/\d\d(\d\d)-(\d\d)-(\d\d)/;
 225
 226 ## 008 06 - Type of date/Publication status
 227
 228         $f008 .= 's';
 229
 230 ## 008 07-10 - Date 1
 231
 232         $f008 .= substr( $row->{rad_godina}->[0] ,0,4);
 233
 234 ## 008 11-14 - Date 2
 235
 236         #$f008 .= '    ';
 237
 238         $f008 .= ' ' x ( 15 - length($f008) ); # pad to 15 position
 239 ## 008 15-17 - Place of publication, production, or execution - ako nema 102, popunjava se s |
 240         $f008 .= 'xx ';
 241
 242 ## 008 29 - Conference publication
 243         $f008 .= ' ' x ( 29 - length($f008) );
 244         $f008 .= $self->{_table} eq 'zbornik' ? '1' : '0';
 245
 246 ## 008 35-37 - Language
 247         $f008 .= ' ' x ( 35 - length($f008) ); # pad to 35 position
 248         if ( my $lng = $langrecode008->{ $row->{jezik} } ) {
 249                 $f008 .= $lng;
 250         } else {
 251                 warn "INFO unknown jezik [$row->{jezik}] insert into langrecode008!";
 252                 #$f008 .= '   ';
 253         }
 254         $f008 .= ' ' x ( 38 - length($f008) );
 255 ## 008 38 - Modified record
 256         $f008 .= '|';
 257 ## 008 39 - Cataloging source - d (other)
 258         $f008 .= 'd';
 259
 260         warn "# 008 ",length($f008);
 261
 262         $marc->add_fields('008', $f008); # FIXME - mglavica check
 263
 264
 265         if ( my $doi = $row->{doi} ) {
 266
 267                 $marc->add_fields('024','7',' ',
 268                         2 => 'doi',
 269                         a => $doi,
 270                 );
 271
 272         }
 273
 274 ### 035$
 275
 276 ## marc 035a - System Number
 277 ## polje moze  sadrzavati slova i razmake
 278 ## moguc problem u pretrazivanju ako ima zagrade, kako bi trebalo po standardu
 279
 280         $marc->add_fields('035',' ',' ',
 281                 a => join('', '(CROSBI)', $row->{id})
 282         );
 283
 284 ### 040
 285 ## za sve je isti
 286
 287         $marc->add_fields('040',' ',' ',
 288                 'a' => 'HR-ZaFF',
 289                 'b' => 'hrv',
 290                 'c' => 'HR-ZaFF',
 291                 'e' => 'ppiak'
 292         );
 293
 294 ### 041 - indikatori
 295 # i1=0 - Item not a translation/does not include a translation
 296 # i1=1 - Item is or includes a translation
 297 # i1=' ' - No information provided
 298
 299 ### 041
 300 # ponovljivo potpolje (041a) - marc_repeatable_subfield
 301 # koristi se kad ima vise od jednog jezika, ili kad se radi o prijevodu
 302
 303         $marc->add_fields('041',' ',' ', map {
 304                 ( a => lc($_) )
 305         } split(/-/, $row->{jezik}));
 306
 307
 308 ### 080
 309 ### 245 indikatori
 310 ## i1 = 0 zza anonimne publikacije, i1 = 1 ako postoji 700 ili 710
 311 ## i2 = pretpostavlja se na temelju clana na pocetku naslova i jezika
 312
 313         my ( $first_author, $authors ) = split(/ ;\s*/,$row->{autori});
 314
 315         $marc->add_fields(100,'1',' ','a' => $first_author );
 316
 317
 318
 319         my $naslov = $row->{naslov}; # XXX title?
 320
 321         my $i2 =
 322                 $naslov =~ m/^Eine /                            ? 5 :
 323                 $naslov =~ m/(Die|Das|Der|Ein|Les|Los|The) /    ? 4 :
 324                 $naslov =~ m/^(Um|Un|An|La|Le|Lo|Il) /          ? 3 :
 325                 $naslov =~ m/^(A|L) /                           ? 2 :
 326                 $naslov =~ m/^L'/                               ? 2 :
 327                                                                   0;
 328
 329         $marc->add_fields(245,'1',$i2,
 330                 'a' => $naslov . ' /',
 331                 'c' => $row->{autori} . '.',
 332         );
 333
 334         $marc->add_fields(246,'3',' ',
 335                 'i' => 'Naslov na engleskom:',
 336                 'a' => $row->{title}
 337         );
 338
 339         sub page_range {
 340                 my ( $prefix, $from, $to ) = @_;
 341                 my $out;
 342                 if ( $from ) {
 343                         $out = $prefix . $from;
 344                         $out .= '-' . $to if $to;
 345                 }
 346                 return $out;
 347         }
 348
 349         # fake date for Koha import
 350         #$marc->add_fields(260,' ',' ',
 351         #       c => $row->{godina},
 352         #);
 353
 354         $marc->add_fields(300,' ',' ',
 355                 a => page_range('',$row->{stranica_prva},$row->{stranica_zadnja}),
 356                 f => 'str.'
 357         );
 358
 359         $marc->add_fields(363,' ',' ',
 360                 a => $row->{volumen},
 361                 b => $row->{broj},
 362                 i => $row->{godina},
 363         ) if $row->{volumen};
 364
 365 # /data/FF/crosbi/2016-12-12/casopis-rad_napomena.sql
 366
 367         foreach my $napomena ( @{ $row->{rad_napomena} } ) {
 368                 $marc->add_fields(500,' ',' ',
 369                         a => substr($napomena, 0, 9999), # XXX marc limit for one subfield is 4 digits in dictionary
 370                 );
 371         }
 372
 373         $marc->add_fields(520,' ',' ',
 374                 a => substr($row->{sazetak}, 0, 9999)
 375         );
 376
 377
 378         if ( $row->{rad_projekt} ) {
 379                 $marc->add_fields(536,' ',' ',
 380                         a => 'Projekt MZOS',
 381                         f => 'projekt',
 382                 );
 383         }
 384
 385         $marc->add_fields(546,' ',' ',
 386                 a => $row->{jezik}
 387         );
 388
 389         foreach my $v ( @{ $row->{rad_podrucje} } ) {
 390                 $marc->add_fields(690,' ',' ',
 391                         a => $v,
 392                 );
 393         }
 394
 395
 396         $marc->add_fields(693,' ',' ',
 397                 a => $row->{kljucne_rijeci},
 398                 1 => 'hrv',
 399                 2 => 'crosbi',
 400         );
 401         $marc->add_fields(693,' ',' ',
 402                 a => $row->{key_words},
 403                 1 => 'eng',
 404                 2 => 'crosbi',
 405         );
 406
 407         if ( $row->{autori} =~ m/ ; / ) {
 408                 my @a = split(/ ; /, $row->{autori});
 409                 shift @a; # skip first
 410                 $marc->add_fields(700,'1',' ',
 411                         a => $_,
 412                         4 => 'aut'
 413                 ) foreach @a;
 414         }
 415
 416         sub combine {
 417                 my $out = '';
 418                 my $last_delimiter = '';
 419                 while(@_) {
 420                         my $value = shift @_;
 421                         my $delimiter = shift @_;
 422                         my ( $before,$after ) = ( '', '' );
 423                         ( $before, $value, $after ) = @$value if ( ref $value eq 'ARRAY' );
 424                         $out .= $last_delimiter . $before . $value . $after if $value;
 425                         $last_delimiter = $delimiter || last;
 426                 }
 427                 warn "### [$out]";
 428                 return $out;
 429         }
 430
 431
 432         if ( $self->{_table} =~ m/(casopis|preprint)/ ) {
 433
 434         $marc->add_fields(773,'0',' ',
 435                 t => $row->{casopis},
 436                 x => $row->{issn},
 437 #               g => "$row->{volumen} ($row->{godina}), $row->{broj} ;" . page_range(' str. ',$row->{stranica_prva}, $row->{stranica_zadnja}),
 438                 g => combine( $row->{volumen}, ' ', [ '(', $row->{godina}, ')' ], ', ', $row->{broj}, ' ;', page_range(' str. ',$row->{stranica_prva}, $row->{stranica_zadnja}) ),
 439         );
 440
 441         } elsif ( $self->{_table} =~ m/rknjiga/ ) {
 442
 443         # rknjiga-dbi2marc.pl
 444         $marc->add_fields(773,'0',' ',
 445                 t => $row->{knjiga},
 446 #               d => "$row->{grad} : $row->{nakladnik}, $row->{godina}",
 447                 d => combine( $row->{grad}, ' : ', $row->{nakladnik}, ', ', $row->{godina} ),
 448                 k => $row->{serija},
 449                 h => $row->{ukupno_stranica},
 450                 n => $row->{uredink},
 451                 z => $row->{isbn},
 452                 g => page_range('str. ',$row->{stranica_prva}, $row->{stranica_zadnja}),
 453         );
 454
 455         } elsif ( $self->{_table} =~ m/zbornik/ ) {
 456
 457         # zbornik-dbi2marc.pl
 458         $marc->add_fields(773,'0',' ',
 459                 t => $row->{skup},
 460 #               d => "$row->{grad} : $row->{nakladnik}, $row->{godina}",
 461                 d => combine( $row->{grad}, ' : ', $row->{nakladnik}, ', ', $row->{godina} ),
 462                 k => $row->{serija},
 463                 h => $row->{ukupno_stranica},
 464                 n => $row->{uredink},
 465                 z => $row->{isbn},
 466                 g => page_range('str. ',$row->{stranica_prva}, $row->{stranica_zadnja}),
 467         );
 468
 469         } elsif ( $self->{_table} =~ m/ostalo/ ) {
 470
 471         $marc->add_fields(773,'0',' ',
 472                 t => $row->{izvornik},
 473         );
 474
 475         } else {
 476                 die "ERROR: 773 undefined in row ",dump($row);
 477         }
 478
 479
 480         if ( my $file = $row->{datoteka} ) {
 481                 $marc->add_fields(856,' ',' ',
 482                         u => "http://bib.irb.hr/datoteka/$file",
 483                 );
 484         };
 485
 486
 487         $marc->add_fields(856,' ',' ',
 488                 u => $row->{openurl},
 489         ) if $row->{openurl};
 490
 491         foreach my $url ( @{ $row->{url} } ) {
 492                 $marc->add_fields(856,' ',' ',
 493                         u => $url,
 494                 );
 495         }
 496
 497         my $f942c = {
 498                 casopis  => 'CLA',
 499                 preprint => 'PRE',
 500                 rknjiga  => 'POG',
 501                 zbornik  => 'RZB',
 502         };
 503
 504         my @f942 = (
 505                 c => $f942c->{ $self->{_table} } || die "ERROR no table $self->{_table} in ".dump($f942c),
 506         ) if $self->{_table} !~ m/ostalo/;
 507
 508         if ( $row->{status_rada} ) {
 509                 push @f942, (
 510                 f => 1,
 511                 g => $row->{status_rada}
 512                 );
 513         }
 514
 515         if ( $self->{_table} =~ m/(casopis|preprint)/ ) {
 516
 517                 if ( $row->{kategorija} =~ m/Znanstveni/ ) {
 518                         push @f942, t => '1.01'
 519                 } elsif ( $row->{kategorija} =~ m/Strucni/ ) {
 520                         push @f942, t => '1.04';
 521                 } else {
 522                         warn "ERROR kategorija $row->{kategorija}";
 523                 }
 524
 525         } elsif ( $self->{_table} =~ m/rknjiga/ ) {
 526
 527                 if ( $row->{kategorija} =~ m/Znanstveni/ ) {
 528                         push @f942, t => '1.16.1';
 529                 } elsif ( $row->{kategorija} =~ m/Pregledni/ ) {
 530                         push @f942, t => '1.16.2';
 531                 } elsif ( $row->{kategorija} =~ m/Strucni/ ) {
 532                         push @f942, t => '1.17';
 533                 } else {
 534                         warn "ERROR kategorija $row->{kategorija}";
 535                 }
 536
 537         } elsif ( $self->{_table} =~ m/zbornik/ ) {
 538
 539                 push @f942, v => $row->{vrst_recenzije};
 540
 541         } elsif ( $self->{_table} =~ m/ostalo/ ) {
 542
 543                 # XXX
 544
 545         } else {
 546                 die "ERROR _table $self->{_table}";
 547         }
 548
 549         $marc->add_fields(942,' ',' ',
 550                 @f942,
 551                 u => '1',
 552                 z => join(' - ', grep { defined $_ } ($row->{kategorija}, $row->{vrst_sudjelovanja}, $row->{vrsta_rada})),
 553         );
 554
 555 =for later
 556         $marc->add_fields(999,' ',' ',
 557                 a => $row->{}
 558         );
 559
 560 =cut
 561
 562 #       diag "# hash ",dump($hash);
 563         diag "# marc\n", $marc->as_formatted if $ENV{DEBUG};
 564
 565         $self->save_marc( "$id.marc", $marc->as_usmarc );
 566
 567         return $id;
 568
 569 }
 570
 571 1;