#!/usr/bin/perl -w

use strict;
use DBI;
use Getopt::Std;
use POSIX qw(
    ceil
    floor
);

my %options = ();
getopts("c:p:l:s:",\%options);
my $configFile = $options{c};
my $bcPrefix="";
my $bcLength=10;
my $bcStart=1;
if (!$configFile || ! -f $configFile) {
    print "Usage: $0 -c CONFIG_FILE\n -p BC_PREFIX -l BC_LENGTH -s BC_START";
    exit 1;
}
$bcPrefix=$options{p} if(exists($options{p}));
$bcLength=$options{l} if(exists($options{l}));
$bcStart=$options{s} if(exists($options{s}));
my $config = loadConfig($configFile);
my $dbh = makeConnection($config);
END {
    if ($dbh) {
        $dbh->disconnect();
    }
}

$| = 1;

   my $zRoot   =   $config->{'zRoot'};
   my $zPort   =   $config->{'zPort'};
   my $zDatabase = $config->{'zDatabase'};


    print "Generating barcodes\n";
    genNewBcTable($dbh);
    print "Assigning new barcodes\n";

    my $sth = $dbh->prepare("select rid,barcode,newBarcode from tmp_bc order by barcode, rid ");
    $sth->execute;
    my $count=1;
    $dbh->do("update opl_item set barcode=concat(barcode,'_RBC')");
    $dbh->do("update opl_itemInfo set barcode=concat(barcode,'_RBC')");
    while (my ($rid,$barcode,$newBarcode) = $sth->fetchrow_array) {
        updateRecordBc($dbh,$rid,$barcode,$newBarcode);
        print "." if($count%100 ==0);
        print "\n" if($count%1000 ==0);
        $count++;
    }
    #$dbh->do("drop table tmp_bc");

    print "\ndone.\n";
################################################################################

sub genNewBcTable{
    my ($dbh)=@_;
    my $bcFmtStr=$bcPrefix . "%0" .$bcLength ."d";
    $dbh->do("DROP TABLE IF EXISTS tmp_bc");
    $dbh->do(<<_SQL_);
    CREATE TABLE IF NOT EXISTS tmp_bc(
        `rid` int(10) unsigned NOT NULL DEFAULT '0', 
        barcode varchar(50) NOT NULL default '', 
        newBarcode varchar(50) NOT NULL default '',
        PRIMARY KEY  (`newBarcode`)
    )ENGINE=MyISAM DEFAULT CHARSET=latin1
_SQL_


    my $sth = $dbh->prepare("select rid,barcode,callNumber from opl_item i inner join opl_marcRecord m using(rid)
                             where barcode not regexp '\_\_\_' order by callNumber, m.author,m.title,i.rid");
    my $sth_update = $dbh->prepare("insert into tmp_bc(rid,barcode,newBarcode) values(?,?,?) ");
    $sth->execute;
    my $i=$bcStart;
    while (my ($rid,$barcode,$callNumber) = $sth->fetchrow_array) {
        my $newBc=sprintf("$bcFmtStr",$i++);
        $sth_update->execute($rid,$barcode,$newBc);

    }

}

################################################################################
sub updateRecordBc{
    my ($dbh,$rid,$oldBc,$newBc)=@_;
    my $dir     = "$zRoot/$zPort/record/$zDatabase/" . ceil($rid/1000);
    
    if (-f "$dir/$rid.xml") {
        my $xml = '';
        open  RECORD, "<$dir/$rid.xml";
        my $line;
        while (<RECORD>) {
            $line = $_;
            if ($line !~ m/<subfield code="-"/) {
                $xml .= $line;
            }
        }
        my $newSubFields="";
        while ($xml =~ s/([\s]*<datafield tag="852" ind1="[\d ]" ind2="[\d ]">([\s]*<subfield code="[\w\-]">.*<\/subfield>)+[\s]*<\/datafield>)//) {
            my $tmp852 =$1;
            my $tmpBc=$oldBc;
            $tmpBc=~ s/([.+\$\\\/])/\\$1/g;
            if($tmp852 =~ s/<subfield code="p">($tmpBc)<\/subfield>/<subfield code="p">$newBc<\/subfield>/gi){
                 updateBc($dbh,$oldBc,$newBc);
            }
            $newSubFields .= $tmp852;
        }
        close RECORD;
            $xml =~ s/[\s]*<\/record>/$newSubFields\n<\/record>/;

            open  RECORD, ">$dir/$rid.xml";
            print RECORD $xml;
            close RECORD;

    }
    

}

exit 0;
############################################################
sub updateBc{
    my($dbh,$oldBc,$newBc)=@_;
    $dbh->do("update opl_item set barcode ='$newBc' where barcode='$oldBc" . "_RBC'");
    $dbh->do("update opl_itemInfo set barcode ='$newBc' where barcode='$oldBc" . "_RBC'");
    $dbh->do("update opl_itemstatus set barcode ='$newBc' where barcode='$oldBc'");
    $dbh->do("update opl_itemStats set barcode ='$newBc' where barcode='$oldBc'");
}


################################################################################

sub makeConnection {
    my ($config) = @_;
    if (!$config) {
        return;
    }
    my ($db_driver, $db_name, $db_host, $db_port, $db_user, $db_password);

    $db_driver   = $config->{'db_driver'} || 'mysql';
    $db_name     = $config->{'db_name'};
    $db_host     = $config->{'db_host'};
    $db_port     = $config->{'db_port'}   || '3306';
    $db_user     = $config->{'db_user'};
    $db_password = $config->{'db_password'};

    my $dsn = "dbi:$db_driver:$db_name:$db_host:$db_port";

    return DBI->connect($dsn, $db_user, $db_password);
}
############################################################


sub loadConfig {
    my ($configFile) = @_;
#    print "Enter the config filename of Opals: ";
#    $configFile = <STDIN>;
    my $config = {};

    open CONF, $configFile || die "Cannot open file $configFile";
    while (<CONF>) {
        chomp;
        s/#.*//;                # remove comments
        next if /^\s*$/;        # ignore blank lines

        if (/^\s*(\w+)\s*=\s*(.*?)\s*$/) {
            $config->{$1} = $2;
        }
    }
    close CONF;

    return $config;
} 
############################################################