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