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