git.rot13.org Git - koha-zs-skipped/blob - koha-zs-skipped.pl

   1 #!/usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5
   6 use Data::Dump qw(dump);
   7 use autodie;
   8
   9 use lib '/srv/koha';
  10 use C4::Context;
  11
  12 my $dbh = C4::Context->dbh;
  13
  14 warn "# create t1";
  15 $dbh->do(qq{
  16
  17 create temporary table if not exists t1 as
  18
  19 select
  20         substr(itemcallnumber,1,2) as prefix,
  21         substr(itemcallnumber,4) as num,
  22
  23         items.biblionumber,
  24         itemnumber,
  25         itemcallnumber as signatura,
  26         ccode as zbirka,
  27         location as lokacija,
  28         itype as vrsta_gradje_item,
  29         itemtype as vrsta_gradje_bib,
  30         itemlost,
  31         damaged,
  32         withdrawn,
  33         issues,
  34         renewals,
  35         onloan
  36 from items
  37 join biblioitems on items.biblionumber=biblioitems.biblionumber
  38 where
  39         itype <> 'PER' and
  40 itemcallnumber rlike '^[PDFMS][ABCDERO] ';
  41 });
  42
  43 =for comment
  44 /*
  45 ./DD-SE/07-MR.sql:where itemcallnumber like 'MR %' and
  46 ./DD-SE/08-DR.sql:where itemcallnumber like 'DR %' and
  47 ./DD-SE/09-FO.sql:where itemcallnumber like 'FO %' and
  48 ./DD-SE/06-DD.sql:where itemcallnumber like 'DD %' and
  49 ./DD-SE/10-SE.sql:where itemcallnumber like 'SE %' and
  50
  51 ./PC-PE/04-PD.sql:where itemcallnumber like 'PD %' and
  52 ./PC-PE/05-PE.sql:where itemcallnumber like 'PE %' and
  53 ./PC-PE/03-PC.sql:where itemcallnumber like 'PC %' and
  54
  55 ./PA/01-PA.sql:where itemcallnumber like 'PA %' and
  56
  57 ./PB/02-PB.sql:where itemcallnumber like 'PB %' and
  58 ./PB2/02-PB.sql:where itemcallnumber like 'PB %' and
  59 ./PB3/02-PB.sql:where itemcallnumber like 'PB %' and
  60 ./PB4/02-PB.sql:where itemcallnumber like 'PB %' and
  61 ./PB5/02-PB.sql:where itemcallnumber like 'PB %' and
  62 */
  63 =cut
  64
  65 my $sth = $dbh->prepare(qq{
  66 select
  67         prefix,
  68         num
  69 from t1
  70 order by prefix,num
  71 });
  72
  73 $sth->execute();
  74
  75 my $prefix;
  76 my $num;
  77
  78 while( my $row = $sth->fetchrow_hashref ) {
  79
  80         $row->{num} =~ s/\s+$//;
  81
  82         if ( $row->{num} !~ m/^\d+$/ ) {
  83                 warn "SKIP ",dump($row);
  84                 next;
  85         }
  86
  87         if ( ! defined $prefix || $prefix ne $row->{prefix}) {
  88                 $prefix = $row->{prefix};
  89                 $num    = $row->{num};
  90                 warn "NEW $prefix $num";
  91                 print "\n";
  92                 next;
  93         }
  94         $num++;
  95         while ( $row->{num} > $num ) {
  96                 print "$prefix $num\n";
  97                 $num++;
  98         }
  99 }