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