package Opals::MarcXml;

require Exporter;
@ISA       = qw(Exporter);
# Symbols to be exported by default
#@EXPORT    = qw(
#    opl_
#);
# Symbols to be exported on request
#-------------------------------------------------------------------------
# ON:       Wed, Mar 16, 2011 @ 08:52:25 EDT
# ADD NEW:  mxml_updateItemStatus
#           mxml_updateItemStats            
#
#-------------------------------------------------------------------------
@EXPORT_OK = qw(
    mxml_recordPath
    mxml_update
    mxml_update_ext
    mxml_saveTemplate
    mxml_deleteTemplate
    mxml_updateDbZebra
    mxml_delete
    mxml_newItem
    mxml_updateSubjectsList
    mxml_getAR_info
    mxml_updateARIndex
    mxml_updateRecordIndex
    mxml_writeSortData
    mxml_createSortData
    mxml_del_rec_holding
    mxml_addItemType
    mxml_processReplaceItemType
    mxml_exportRecord
    mxml_exportHolding
    mxml_fixXmlRecord
    mxml_processGE852
    mxml_isLock
    mxml_inventory
    ge852
    mxml_templateMaxOrder
    mxml_updateItemInfo
    mxml_saveRecordIdentifier
    mxml_updateItemStatus   
    mxml_updateItemStats
    mxml_archiveMarcXml
    mxml_retrieveMarcXml
    
);


#    mxml_validateRid
# Version number
$VERSION   = 0.01;


#use utf8;
use strict;
use Business::ISBN;
use MARC::Record;
use MARC::Field;
use POSIX qw(
    ceil
);
use Opals::Template qw(
    tmpl_preference
);

use Opals::Constant;
use Opals::Date qw(
    date_f005
);
use Opals::Marc::Record;
use Opals::Search qw(
    srch_recordBrief
    srch_validateRid
    srch_getRecType
);
#    srch_searchRecord
#    srch_maxRid
use Opals::Utility qw(
    util_formatBarcode
    util_removeChar
    util_getTimeout_min
    util_restoreLiteral
    util_escapeXml
    util_getXmlRecord
);

use Opals::CallNumberUtil qw(
    cn_parseLCC
    cn_parseDewey
    cn_getCallNumSortByDewey
    cn_getCallNumSortByLcc
);


use Opals::User qw(
    user_currentUser
    user_getInformationById
);
# Thu, Jan 15, 2009 @ 12:03:29 EST
use Opals::UnionRequest qw(
    urq_createUnionRequest
    urq_addRec2UnionRequest
    urq_updateUnionRequestStatus
);

use Time::localtime;
use constant    TEMPORARY_ITEM     =>  'temporary';
#####################################################
sub mxml_recordPath {
    my ($rid) = @_;
    
    my $zRoot   = Opals::Context->config('zRoot');
    my $zPort   = Opals::Context->config('zPort');
    my $zDatabase = Opals::Context->config('zDatabase');
    my $dir     = "$zRoot/$zPort/record/$zDatabase/" . ceil($rid/1000);

    return $dir;
}


#####################################################
sub mxml_update {
    my ($dbh, $rid, $marcxml, $barcodeNew, $barcodeDeleted) = @_;
    $rid = mxml_update_ext($dbh, $rid, $marcxml, $barcodeNew,$barcodeDeleted,"");

    my $syspref = tmpl_preference($dbh);

    # Thu, Jan 15, 2009 @ 12:01:35 EST
    # update the corresponding union database
    my $autoUpdateUnion= $syspref->{'autoUpdateUnion'};

    if($rid  && $autoUpdateUnion eq '1'){
        my $uid=1; # may not know who is updating... default to Admin user 1
        if($barcodeNew ne ''){
            my @bcNew = split(/,/, $barcodeNew);
            my $ridBcListNew;
            $ridBcListNew->{$rid}=\@bcNew;
            urq_createUnionRequest($dbh,$uid,"import",$ridBcListNew);

        }
        if($barcodeDeleted ne ''){
            my @bcDel = split(/,/, $barcodeDeleted);
            my $ridBcListDel;
            $ridBcListDel->{$rid}=\@bcDel;
            urq_createUnionRequest($dbh,$uid,"deletion",$ridBcListDel);
        }
     }
    #
     return $rid;
}
#####################################################
# Tue, Nov 18, 2008 @ 15:50:12 EST
#
#  Add  incomplete  field in opl_marcRecord table --- quick item entry
#
sub mxml_update_ext {
    my ($dbh, $rid, $marcxml, $barcodeNew, $barcodeDeleted,$temporaryILL,$incomplete) = @_;
         
    $rid = srch_validateRid($dbh, $rid);
    $marcxml =~ s/<controlfield tag="001">[\d]*<\/controlfield>/<controlfield tag="001">$rid<\/controlfield>/;
    mxml_updateSubjectsList($dbh, $rid, $marcxml);
    mxml_updateARIndex($dbh, $rid, $marcxml);
    mxml_updateRecordIndex($dbh, $rid, $marcxml);
    mxml_archiveMarcXml($dbh, $rid, $marcxml);
    if($incomplete && $incomplete ne "" ){        
        if (mxml_updateDbCirculation($dbh, $rid, $marcxml, $barcodeNew, $barcodeDeleted,$temporaryILL,$incomplete) &&
            mxml_updateDbZebra($dbh, $rid, $marcxml)) {
            return $rid;
        }
    }
    else{
        if (mxml_updateDbCirculation($dbh, $rid, $marcxml, $barcodeNew, $barcodeDeleted,$temporaryILL) &&
            mxml_updateDbZebra($dbh, $rid, $marcxml)) {
            return $rid;
        }
    }
    return;
}



#####################################################
#Wed, Nov 25, 2009 @ 11:59:43 EST

sub mxml_updateARIndex{
    my ($dbh,$rid,$xml) = @_;
    del_AR($dbh,$rid);
    my $ARinfo=mxml_getAR_info($xml);
    if(scalar(@$ARinfo)>0){
        foreach my $ar(@$ARinfo){
            add_AR($dbh,$rid,$ar->{'program'},$ar->{'interestLevel'},$ar->{'readingLevel'},$ar->{'pointValue'},$ar->{'quizNum'});
        }
    }
}

sub mxml_getAR_info{
    my ($xml) = @_;
    my @ARinfo=();
    while ($xml =~ s/[\s]*<datafield tag="526" ind1="([\d ])" ind2="([\d ])">(([\s]*<subfield code="[\w-]">.*<\/subfield>)*)[\s]*<\/datafield>//) {
        #if($1 eq '0'){
            my $sfXml = $3;
            my($program,$readingLevel,$interestLevel,$gradeLevel_b,$gradeLevel_e,$pointValue,$quizNum)=('','','','','','','');
            while ($sfXml =~ s/[\s]*<subfield code="([\w|-])">(.*)<\/subfield>//) {
               my ($sfCode, $sfdata) = ($1, $2);
               if($sfCode eq 'a' && $sfdata =~ m/reading count|RC/gi){
                   $program='Reading Counts';
               }
               if($sfCode eq 'a' && $sfdata =~ m/accelerated reader|AR/gi){
                   $program='Accelerated Reader';
               }
               if($sfCode eq 'b'){
                  if( $sfdata =~ m/(K|[\d]+[\.]?[\d]*)-([\d]+[\.]?[\d]*)/i){
                      $gradeLevel_b = $1;
                      $gradeLevel_e = $2;
                      if(($gradeLevel_b eq 'k' || $gradeLevel_b eq 'K' || $gradeLevel_b <=3) && $gradeLevel_e<='3'){
                          $interestLevel='LG';
                      }
                      elsif($gradeLevel_e le '8'){
                          $interestLevel='MG';
                      }
                      elsif($gradeLevel_e le '12'){
                          $interestLevel='UG';
                      }
                      else{
                          $interestLevel='';
                      }
                  }
                  else{
                      $interestLevel=$sfdata;
                  }
               }
               if($sfCode eq 'c'){
                   $readingLevel=$sfdata;
               }
               if($sfCode eq 'd'){
                   $pointValue=$sfdata;
               }
               if($sfCode eq 'z'){
                   $quizNum =$sfdata;
               }
            }
            if($program =~ m/Accelerated Reader|Reading Counts/gi){
               push @ARinfo, {program=>$program,
                              interestLevel=>$interestLevel,
                              readingLevel=>$readingLevel,
                              pointValue=>$pointValue,
                              quizNum=>$quizNum
                             };
            }

        #}
    }
    return \@ARinfo;

}

#####################################################
sub del_AR{
    my ($dbh,$rid)=@_;
    my $sth = $dbh->prepare("delete from opl_arl where rid=?");
    $sth->execute($rid);
    $sth->finish;

}
sub add_AR{
    my ($dbh,$rid,$program,$gradeLevel,$readingLevel,$pointValue,$quizNum)=@_;
    my $sth = $dbh->prepare("insert into opl_arl(rid,program,interestLevel,readingLevel,pointValue,quizNum) values(?,?,?,?,?,?)");
    $sth->execute($rid,$program,$gradeLevel,$readingLevel,$pointValue,$quizNum);
    $sth->finish;
}


#####################################################
sub mxml_updateSubjectsList{
    my ($dbh, $rid, $newMarcXml) = @_;

    if ($rid && $rid =~ m/^[1-9][\d]*$/) {
#        my $zdbDir = mxml_recordPath($rid);
#        my $xml = getXmlRecord($zdbDir, $rid);
        my $xml = util_getXmlRecord($rid);
        if ($xml) {
            my @sbjArr = getSubjectList($xml);
            foreach my $s(@sbjArr) {
                deleteSubject($dbh, $s);
            }
        }
    }
    if($newMarcXml && $newMarcXml ne ""){
        my @newSbjArr = getSubjectList($newMarcXml);
        foreach my $s (@newSbjArr) {
            addSubject($dbh, $s);
        }
    }
}

sub getSubjectList{
    my ($xml) = @_;

    my @subject;
    my ($subj, $field, $code, $data);
    while ($xml =~ s/([\s]*<datafield tag="6[\d]{2}" ind1="[\d ]" ind2="[\d ]">([\s]*<subfield code="[\w\-]">.*<\/subfield>)+[\s]*<\/datafield>)//) {
        $field = $1;
        $subj = '';
        while ($field =~ s/<subfield code="([\w\-])">(.*)<\/subfield>//) {
            $code = $1;
            $data = $2;
            $data =~ s/[\.|,|:|;]*$//g;
            if ($code !~ m/^(2|-)$/) {
                $subj = ($subj ne '') ? "$subj -- $data" : $data;
            }
        }
        push @subject, $subj;
    }

    return @subject;

}

sub deleteSubject{
    my($dbh,$subject)=@_;
    my $sth ;
    $sth = $dbh->prepare( <<_SQL_);
update opl_subjects 
set    recCount=recCount-1
where   subject = ?
_SQL_
  $sth->execute($subject); 
}

sub addSubject{
    my($dbh,$subject)=@_;
    my $sth ;
    my $sql;
 $sth = $dbh->prepare(<<_SQL);
select id from opl_subjects 
where   subject = ?
_SQL

     $sth->execute($subject);

    my ($rec) =$sth->fetchrow_hashref;
    if($rec){
$sql = <<_SQL_;
update opl_subjects 
set    recCount=recCount+1,
       subject=?
where   id = ?
_SQL_
   my $rv = $dbh->do($sql, undef, $subject,$rec->{'id'});
    }
    else{
$sql = <<_SQL_;
insert into opl_subjects
set    subject=? ,
       recCount=1
_SQL_
   my $rv = $dbh->do($sql, undef, $subject);

    }
}



sub mxml_updateDbCirculation {
    my ($dbh, $rid, $marcxml, $barcodeNew, $barcodeDeleted,$temporaryILL,$incomplete) = @_;
    my $sth;

    my $tm = localtime;
    my $todayStr = sprintf("%04d-%02d-%02d", $tm->year +1900, ($tm->mon)+1, $tm->mday);
  
    # Add new holding
    my $barcodeNewErr = '';
    my $titleSort="";
    my $pubDateSort="";
    my @bcNew = split(/,/, $barcodeNew);
    if (@bcNew) {
        $sth = $dbh->prepare(<<_STH_);
insert into opl_item
(barcode, rid, dateImport)
values
(?, ?, now())
_STH_


#START:Mon, Jun 28, 2010 @ 12:27:22 EDT
      my  $sth_bcm = $dbh->prepare(<<_STH_);
update opl_bcmBc set status = 'taken',pending= -1 ,pendingFor=''          
where barcode=?
_STH_

#END: Mon, Jun 28, 2010 @ 12:27:34 EDT
        foreach my $bc (@bcNew) {
            $bc =~  s/\s+$//g;
            $sth->execute($bc, $rid) || ($barcodeNewErr .= $bc . ',');
            $sth_bcm->execute($bc);
            mxml_updateItemStats($dbh,$bc,ITEM_ACTIVE,$todayStr);
        }

        $sth->finish;
        $sth_bcm->finish;
    }

    # Delete 
    #my $sth_itemstatus_del = $dbh->prepare("insert into opl_itemstatus set barcode=?, ondate=now(), status=?");
    foreach my $bcDel (split(/,/, $barcodeDeleted)) {
#        my $maxBarcodeDel = getMaxBcDelNumber($dbh,$bcDel);
#        $maxBarcodeDel++;
#        my $delPostFix = sprintf("%0.3d",$maxBarcodeDel);
#        my $bcDelNew = '___' .  $bcDel . '_' . $delPostFix;
        #$sth_itemstatus_del->execute($bcDelNew, ITEM_DELETED);
        mxml_updateItemStatus($dbh,$bcDel,ITEM_DELETED,'');
        #mxml_assignDeletionNumber($dbh,$bcDel,$bcDelNew );
    }
    #$sth_itemstatus_del->finish;
    #Tue, Oct 28, 2008 @ 15:50:35 EDT
    #get title sort field        
    if($marcxml =~ m/([\s]*<datafield tag="245" ind1="[\d\ ]" ind2="[\d\ ]">([\s]*<subfield code="[\w\d]">.*<\/subfield>)*[\s]*<\/datafield>)/) {
        my @sfCode = ('a', 'b', 'p');
        $titleSort=mxml_createSortData($1,245,\@sfCode);
    }
    if($marcxml =~ m/([\s]*<datafield tag="260" ind1="[\d\ ]" ind2="[\d\ ]">([\s]*<subfield code="[\w\d]">.*<\/subfield>)*[\s]*<\/datafield>)/) {
        my @sfCode=('c');
        $pubDateSort=mxml_createSortData($1,260,\@sfCode);
    }
   
    # END get title sort field    
    
    # Update record info
    $marcxml =~ s/[\s]*<subfield code="-">.*<\/subfield>//g;
    $marcxml =~ s/[\s]*<subfield code="+">.*<\/subfield>//g;
    my $record = srch_recordBrief($marcxml);
    
    my ($leader, $cf_008)=('','');
    my $xmlTmp=$marcxml;
    # get leader
    if ($xmlTmp =~ s/[\s]*<leader>([\w ]{24})<\/leader>//) {
        $leader=$1;
    }    
    # get control field -- 008
    if($xmlTmp =~ s/[\s]*<controlfield tag="008">(.*)<\/controlfield>//){
        $cf_008=$1;
    }
    
      
    my ($title, $author, $pubPlace, $pubName, $pubDate);
    $title      = $record->{'title'};
    $author     = $record->{'author'};
    $pubPlace   = $record->{'pubPlace'};
    $pubName    = $record->{'pubName'};
    $pubDate    = $record->{'pubDate'};
    my $recFormat=_getRecType($marcxml);

my $query = " replace into opl_marcRecord
set rid         = ?,
    title       = ?,
    titleSort   = ?,
    author      = ?,
    pubPlace    = ?,
    pubName     = ?,
    pubDate     = ?,
    pubDateSort = ?,
    leader      = ?,
    cf_008      = ?,
    recFormat   = ?,
    modDate     = now() ";

    if($temporaryILL && $temporaryILL ne "" ){
        $query .= ", tempIll = '" . $temporaryILL ."'"; 
    }
        
    if($incomplete &&  $incomplete ne ""){
        $query .= ", incomplete ='" . $incomplete ."'" ;
    }
 
    $sth = $dbh->prepare($query);
    $sth->execute($rid, $title, $titleSort,$author, $pubPlace, $pubName, $pubDate,$pubDateSort,$leader,$cf_008,$recFormat);
    $sth->finish;
    # TODO: error checking

    my $itemList = $record->{'itemList'};
    foreach my $itm (@$itemList) {
        mxml_updateItem(
            $dbh,
            $rid,
            $itm->{'barcode'},
            $itm->{'typeCircCode'},
            $itm->{'callnumber'},
            $itm->{'price'},
            $itm->{'f852_c'},
            cn_getCallNumSortByDewey($itm->{'callnumber'}),
            cn_getCallNumSortByLcc($itm->{'callnumber'}),


        );
    }
    
    $sth = $dbh->prepare(<<_STH_);
update opl_marcRecord m inner join (select max(i.modDate) as modDate,rid from opl_item i where i.rid=? group by rid) as t
on m.rid=t.rid && m.modDate <t.modDate 
set m.modDate=t.modDate;   
_STH_

$sth->execute($rid);
    $sth->finish;
        
    mxml_updateItemInfo($dbh, $marcxml);
#    mxml_updateItem($dbh, $rid, $marcxml);
   $sth = $dbh->prepare("select title from opl_marcRecord where rid=?");
   $sth->execute($rid);
   my ($t)= $sth->fetchrow_array;

    return 1;
}

#####################################################
sub _getRecType{
    my ($xml)=@_;
    my($leader,$cf006,$cf007,$cf008)=('','','');
    if ($xml =~ m/[\s]*<leader>([\w ]{24})<\/leader>/) {
        $leader=$1;
    }   
    if($xml =~ m/[\s]*<controlfield tag="006">(.*)<\/controlfield>/){
        $cf006=$1;
    }
    if($xml =~ m/[\s]*<controlfield tag="007">(.*)<\/controlfield>/){
        $cf007=$1;
    }
    if($xml =~ m/[\s]*<controlfield tag="008">(.*)<\/controlfield>/){
        $cf008=$1;
    }

    return srch_getRecType($leader,$cf006,$cf007,$cf008);

}

#####################################################
sub mxml_updateItemInfo {
    my ($dbh, $marcxml) = @_;

    my $sth_remove = $dbh->prepare(<<_STH_);
delete from opl_itemInfo
where   barcode = ?
_STH_

    my $sth = $dbh->prepare(<<_STH_);
insert into opl_itemInfo
set barcode    = ?,
    sf852Code  = ?,
    sf852Data  = ?
_STH_

    while ($marcxml =~ s/([\s]*<datafield tag="852" ind1="[\d ]" ind2="[\d ]">([\s]*<subfield code="[\w]">.*<\/subfield>)*[\s]*<\/datafield>)//) {
        my $f852 = $1;
        my @sf852;
        my $barcode;
        while ($f852 =~ s/<subfield code="([\w])">(.*)<\/subfield>//) {
            my ($code, $data) = ($1, $2);
            if ($code eq 'p') {
                $barcode = $data;
                #$barcode =~ s/[^\w]//g;
            }
            else {
                push @sf852, [$code, $data] if ($code && defined $data);
            }
        }

        $sth_remove->execute($barcode);
        foreach my $sf (@sf852) {
            $sth->execute($barcode, $sf->[0], $sf->[1]);
        }
    }
    $sth_remove->finish;
    $sth->finish;
}


#####################################################
sub mxml_updateItem {
    my ($dbh, $rid, $barcode, $typeId, $callNumber, $price,$location,$cnSort_dewey,$cnSort_lcc) = @_;

    mxml_addItemType($dbh, $typeId);    
    my $sth_chkBc=$dbh->prepare("select barcode from opl_item where rid=? && (barcode=? || barcode regexp ?)  order by modDate desc limit 1");
    $sth_chkBc->execute($rid,$barcode,"___". $barcode ."_");
    if(my ($barcodeOld) =$sth_chkBc->fetchrow_array){

        my $sth = $dbh->prepare(<<_STH_);
    update  opl_item
    set     typeId     = ?,
            callNumber = ?,
            price      = ?,
            location   = ?,
            callNumSort_dewey =?,
            callNumSort_lcc =?,
            barcode    =?
    where   barcode    = ?
_STH_
        $sth->execute($typeId, $callNumber, $price, $location,$cnSort_dewey,$cnSort_lcc,$barcode,$barcodeOld);
        $sth->finish;
    }
}


#####################################################
sub mxml_updateDbZebra {
    my ($dbh, $rid, $xml) = @_;

    my $marc = Opals::Marc::Record::newFromXml($xml);
    mxml_saveRecordIdentifier($dbh, $marc);

    my $zebraidx = Opals::Context->config('zebraidx');
    return unless (-f $zebraidx);

    my $dir = mxml_recordPath($rid);
#    my $zRoot   = Opals::Context->config('zRoot');
#    my $zPort   = Opals::Context->config('zPort');
#    my $zDatabase = Opals::Context->config('zDatabase');
#    my $dir     = "$zRoot/$zPort/record/$zDatabase/" . ceil($rid/1000);

    unless (-d $dir) {
        mkdir $dir, 0775;
        system("chown apache.apache  $dir");
    }

    $xml =~ s/<\?xml(.*)\?>\n//gi;
    $xml =~ s/
/ /gi;

    # Write sort data
    $xml = mxml_writeSortData($xml);
    #/Write sort data


    $xml =~ s/<controlfield tag="001">[\d]*<\/controlfield>/<controlfield tag="001">$rid<\/controlfield>/;
    my $f005 = date_f005();
    $xml =~ s/<controlfield tag="005">.*<\/controlfield>/<controlfield tag="005">$f005<\/controlfield>/;
#Tue, Dec 08, 2009 @ 11:47:25 EST
# dedup 008 field
    
    my $marker_008="___OPALS_MARC_XML_controlfield008marker_f801d6faada54a60faa577bbb60f33___";
    if($xml =~ m/(\s*<controlfield tag="008">.*<\/controlfield>\s*\n)/){
        my $tmp =$1;
        $xml =~ s/\s*<controlfield tag="008">.*<\/controlfield>\s*\n/$marker_008/;
        $xml =~ s/[\t ]*<controlfield tag="008">.*<\/controlfield>\s*\n//g;
        $xml =~ s/$marker_008/$tmp/;

    }
# /dedup


#    open  RECORD, ">:utf8", "$dir/$rid.xml";
    open  RECORD, ">$dir/$rid.xml";
    print RECORD $xml;
    close RECORD;
    system("chown apache.apache $dir/$rid.xml");
    system("chmod 664 $dir/$rid.xml");

    # Enqueueing record for z-index
    $dbh->do("update opl_marcRecord set zIndexed = 0 where rid = $rid");

    return 1;
}


#####################################################
sub mxml_delete {
    my ($dbh, $ridList) = @_;

    my $zebraidx = Opals::Context->config('zebraidx');
    return unless (-f $zebraidx);
    
    my $zRoot   = Opals::Context->config('zRoot');
    my $zPort   = Opals::Context->config('zPort');
    my $zDatabase = Opals::Context->config('zDatabase');

    my $sth_loan = $dbh->prepare(<<_STH_);
select  count(*)
from    opl_item as i, opl_loan as l
where   i.rid = ? &&
        i.barcode not regexp '^___' &&
        i.barcode = l.barcode &&
        l.dateReturn is null
_STH_
    my $sth_hold = $dbh->prepare(<<_STH_);
select  count(*)
from    opl_item as i, opl_hold as h
where   i.rid = ? &&
        i.barcode = h.barcode &&
        to_days(h.dateExpiry) - to_days(now()) >= 0  &&
        h.dateLoan is null &&
        h.dateCancel is null
_STH_
    my $sth_marcDelete = $dbh->prepare(<<_STH_);
insert into opl_marcDelete
set     content = ?
_STH_


    $ridList =~ s/,+/,/g;
    $ridList =~ s/(^,|,$)//g;
    my @ridArray = split(/,/, $ridList);
    
    my %dirList;
    my $remainList = '';
    my ($countLoan, $countHold, $dir, $content);
    foreach my $rid (@ridArray) {
        
        $sth_loan->execute($rid);
        ($countLoan) = $sth_loan->fetchrow_array;

        $sth_hold->execute($rid);
        ($countHold) = $sth_hold->fetchrow_array;
        
        if ( $countLoan > 0 || $countHold > 0 ) {
            $remainList .= $rid . ",";
        }
        else {
            mxml_updateHoldingToDelete($dbh, $rid);

            $dir = "$zRoot/$zPort/record/$zDatabase/" . ceil($rid/1000);

            open REC_DEL, "<$dir/$rid.xml";
            $content = '';
            while (<REC_DEL>) {
                $content .= $_;
            }
            close REC_DEL;

            $sth_marcDelete->execute($content);
            my @sbjArr = getSubjectList($content);
            foreach my $s(@sbjArr) {
                deleteSubject($dbh, $s);
            }
            # Thu, Mar 24, 2011 @ 11:02:36 EDT
            # Store marcXML
            my $marcxml = util_getXmlRecord($rid);
            mxml_archiveMarcXml($dbh, $rid, $marcxml) if ($marcxml);

            unlink "$dir/$rid.xml";
            $dirList{$dir} = 1;
        }
        
        # Enqueueing record for z-index
        # Tue, Oct 28, 2008 @ 16:01:51 EDT 
        # add to query to update the delete status field as well

        $dbh->do("update opl_marcRecord set zIndexed = 0 ,deleted=1, modDate=now() where rid = $rid");
        $dbh->do("delete from opl_recordindex where rid = $rid");
    }
    $sth_loan->finish;
    $sth_hold->finish;
    $sth_marcDelete->finish;

    $remainList =~ s/,+/,/g;
    $remainList =~ s/(^,|,$)//g;

#    foreach my $dir (keys %dirList) {
#        system "$zebraidx -c $zRoot/$zPort/zebra.cfg -d $zDatabase update $dir >> $zRoot/$zPort/log/zebraidx.log 2>&1";
#    }
#    system "$zebraidx -c $zRoot/$zPort/zebra.cfg commit >> $zRoot/$zPort/log/zebraidx.log 2>&1";

    return $remainList;
}


#################################################################
sub mxml_updateHoldingToDelete {
    my ($dbh, $rid) = @_;
    #my @barcodeToChange = mxml_getBarcodeToChangeList($dbh, $rid);
    my $sth = $dbh->prepare(<<_STH_);
select barcode  from opl_item
where   rid = ? &&
        substring(barcode, 1, 3) <> '___'
_STH_

    #my $sth_itemstatus_del = $dbh->prepare("insert into opl_itemstatus set barcode=?, ondate=now(), status=?");
    $sth->execute($rid);
    while (my $holding = $sth->fetchrow_hashref) {
        my $bcDel=$holding->{'barcode'};
#        my $maxBarcodeDel = getMaxBcDelNumber($dbh,$bcDel);
#        $maxBarcodeDel++;
#        my $delPostFix = sprintf("%0.3d",$maxBarcodeDel);
#        my $bcDelNew = '___' .  $bcDel . '_' . $delPostFix;
        #$sth_itemstatus_del->execute($bcDelNew, ITEM_DELETED);
        #mxml_updateItemStatus($dbh,$bcDelNew,ITEM_DELETED,'');
        mxml_updateItemStatus($dbh,$bcDel,ITEM_DELETED,'');
        
        #mxml_assignDeletionNumber($dbh,$bcDel,$bcDelNew);
    }
   $sth->finish;
     
 }

#################################################################
sub mxml_getBarcodeToChangeList {
    my ($dbh, $rid) = @_;
    my @barcodeToChange;

    # Get barcode on loan
    my $sth = $dbh->prepare(<<_STH_);
select  distinct i.barcode
from    opl_item as i, opl_loan as l
where   i.rid = ? &&
        i.barcode = l.barcode &&
        substring(i.barcode,1,3)<> '___' 
_STH_
    $sth->execute($rid);
    while (my $holding = $sth->fetchrow_hashref) {
        push @barcodeToChange, $holding->{'barcode'};
    }
    $sth->finish;
    
    # Get barcode on hold
    $sth = $dbh->prepare(<<_STH_);
select  distinct i.barcode
from    opl_item as i, opl_hold as h
where   i.rid = ? &&
        i.barcode = h.barcode &&
        substring(i.barcode,1,3)<> '___' 
_STH_
    $sth->execute($rid);
    while (my $holding = $sth->fetchrow_hashref) {
        push @barcodeToChange, $holding->{'barcode'};
    }
    $sth->finish;
    
    # Get barcode found
    $sth = $dbh->prepare(<<_STH_);
select  distinct i.barcode
from    opl_item as i, opl_found as f
where   i.rid = ? &&
        i.barcode = f.barcode &&
        substring(i.barcode,1,3)<> '___' 
_STH_
    $sth->execute($rid);
    while (my $holding = $sth->fetchrow_hashref) {
        push @barcodeToChange, $holding->{'barcode'};
    }
    $sth->finish;
    
    # Get barcode in item status table
    $sth = $dbh->prepare(<<_STH_);
select  distinct i.barcode
from    opl_item as i, opl_itemstatus as s
where   i.rid = ? &&
        i.barcode = s.barcode &&
        substring(i.barcode,1,3)<> '___' 
_STH_
    $sth->execute($rid);
    while (my $holding = $sth->fetchrow_hashref) {
        push @barcodeToChange, $holding->{'barcode'};
    }
    $sth->finish;

    return @barcodeToChange;
}


sub mxml_assignDeletionNumber {
   my ($dbh,$bcDel,$bcDelNew) = @_;

   $dbh->do(<<_STH_);
update  opl_itemInfo
set     barcode   = '$bcDelNew'
where   barcode = '$bcDel'
_STH_

   my $sth_item = $dbh->prepare(<<_STH_);
update  opl_item
set     barcode   = ?,
        available = 0
where   barcode   = ?
_STH_
   my $sth_itemStatus = $dbh->prepare(<<_STH_);
update  opl_itemstatus
set     barcode   = ?
where   barcode   = ?
_STH_

    my $sth_loan = $dbh->prepare(<<_STH_);
update  opl_loan
set     barcode = ?
where   barcode = ?
_STH_
    my $sth_hold = $dbh->prepare(<<_STH_);
update  opl_hold
set     barcode = ?
where   barcode = ?
_STH_
    my $sth_found = $dbh->prepare(<<_STH_);
update  opl_found
set     barcode = ?
where   barcode = ?
_STH_
   my $sth_itemStats = $dbh->prepare(<<_STH_);
update  opl_itemStats set     barcode = ?
where   barcode = ?
_STH_


    $sth_item->execute($bcDelNew, $bcDel);
    $sth_itemStatus->execute($bcDelNew, $bcDel);
    $sth_loan->execute($bcDelNew, $bcDel);
    $sth_hold->execute($bcDelNew, $bcDel);
    $sth_found->execute($bcDelNew, $bcDel);
    $sth_itemStats->execute($bcDelNew, $bcDel);

    $sth_item->finish;
    $sth_itemStatus->finish;
    $sth_loan->finish;
    $sth_hold->finish;
    $sth_found->finish;
}


#####################################################
sub mxml_saveTemplate {
    my ($in) = @_;
    my ($dbh, $op, $tid, $rank, $name, $content);
    $dbh        = $in->{'dbh'};
    $op         = $in->{'op'};
    $tid        = $in->{'tid'};
    $rank       = $in->{'rank'};
    $name       = $in->{'name'};
    $content    = $in->{'content'};

    my ($sth, $rv);
    if ($op eq 'tmplMarcSaveAs') {
        $sth = $dbh->prepare(<<_STH_);
insert into opl_template
(rank, name, content)
values
(?, ?, ?)
_STH_
        $rv = $sth->execute($rank, $name, $content) || return;
    }
    else {
        $sth = $dbh->prepare(<<_STH_);
update  opl_template
set     rank = ?, name = ?, content = ?
where   tid = ?
_STH_
        $rv = $sth->execute($rank, $name, $content, $tid) || return;
    }
    $rv = $sth->execute($rank);


    $sth->finish;
    
    return $rv;
}

#####################################################
sub mxml_templateMaxOrder {
    my ($dbh)=@_;
    my $sth = $dbh->prepare("select max(rank) from opl_template");
    $sth->execute() || return 1;
     my ($maxOrder) = $sth->fetchrow_array();
    $sth->finish;

    return $maxOrder;
}


#####################################################
sub mxml_deleteTemplate {
    my ($dbh, $tmplMarcId) = @_;
    my $rv;
    my $sth = $dbh->prepare(<<_STH_);
select  name,rank
from    opl_template
where   tid = ?
_STH_
    
    $sth->execute($tmplMarcId) || return;
    my ($tmplName,$rank) = $sth->fetchrow_array();
    $sth->finish;

    $sth = $dbh->prepare(<<_STH_);
delete from opl_template
where       tid = ?
_STH_
    $sth->execute($tmplMarcId) || return;


# What the heck is this? Delete any template of the same rank? 
#    $rv = $sth->execute($rank);


    $sth->finish;

    return $tmplName;
}


#####################################################
sub mxml_writeSortData {
    my ($xml) = @_;
    
    # Remove existing sort data
    $xml =~ s/[\s]*<subfield code="-">.*<\/subfield>//g;
    #/Remove sort data

    # Write sort data
    my $tag = 245;
    my @sfCode = ('a', 'b', 'p');
    $xml = mxml_addSortData($xml, $tag, \@sfCode);

    $tag = 260;
    @sfCode = ('c');
    $xml = mxml_addSortData($xml, $tag, \@sfCode);

    $tag = 852;
    @sfCode = ('k', 'h', 'i');
    $xml = mxml_addSortData($xml, $tag, \@sfCode);
    #/Write sort data

    return $xml;
}


#####################################################
sub mxml_addSortData {
    my ($xml, $tag, $code) = @_;

# OPALS's signature: __OPALS_MARC_XML_f801d6faada54a60faa577bbb60f33__
# Wed, Oct 29, 2008 @ 09:05:48 EDT
# move the create sort data codes to function mxml_createSortData
# so it can be used from somewhere else such as mxml_updateDbCirculation

    while ($xml =~ s/([\s]*<datafield tag="$tag" ind1="[\d\ ]" ind2="[\d\ ]">([\s]*<subfield code="[\w\d]">.*<\/subfield>)*[\s]*<\/datafield>)/__OPALS_MARC_XML_f801d6faada54a60faa577bbb60f33__/) {
        my $field = $1;
        my $dataSort =mxml_createSortData($field,$tag,$code)  ;
        $field =~ s/<\/datafield>/  <subfield code="-">$dataSort<\/subfield>\n  <\/datafield>/;
        $xml =~ s/__OPALS_MARC_XML_f801d6faada54a60faa577bbb60f33__/$field/;
    }

    return $xml;
}


#####################################################
# Wed, Oct 29, 2008 @ 09:06:19 EDT
# Break from function mxml_addSortData

sub  mxml_createSortData{
    my ($fieldXml,$tag,$code)=@_;
    my $dataSort="";
    my $subfield;
    foreach my $c (@$code) {
        if ($fieldXml =~ m/[\s]*<subfield code="$c">(.*)<\/subfield>/) {
            $subfield->{$c} = $1;
        }
    }        
    if ($tag == 245) {
        if ($subfield->{'a'}) {
            $dataSort .= $subfield->{'a'};
            $dataSort = util_removeChar($dataSort);#~ s/[\ \:]+$//;

            my $ind2 = 0;
            if ($fieldXml =~ m/[\s]*<datafield tag="245" ind1="[01]" ind2="([\d])">/) {
                $ind2 = $1;
            }

            $dataSort = substr($dataSort, $ind2);
        }
        
        if ($subfield->{'b'}) {
            $dataSort .= ': ' . $subfield->{'b'};
        }
        elsif ($subfield->{'p'}) {
            $dataSort .= ': ' . $subfield->{'p'};
        }
    }
    elsif ($tag == 260 && 
           $subfield->{'c'} && 
           $subfield->{'c'} =~ m/([\d]{4})/) {
           $dataSort .= $1;
    }
    elsif ($tag == 852) {
        $dataSort .= $subfield->{'k'} if $subfield->{'k'};
        $dataSort .= ' ' . $subfield->{'h'} if $subfield->{'h'};
        $dataSort .= ' ' . $subfield->{'i'} if $subfield->{'i'};
        $dataSort =~ s/ +/ /g;
        $dataSort =~ s/(^ | $)//g;
    }

   return $dataSort;

}

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

sub getMaxBcDelNumber{
    my ($dbh,$bcDel) = @_;
    # Get max number of deletion for a given barcode
    # FORMAT DEL BARCODE: ___ORGINALBARCODE_maxNum such as ___39942000171049_001, ___39942000171049_002,___39942777777_001 ect.
    my $sth;
        
    $sth = $dbh->prepare(<<_STH_);
select  max(barcode)
from    opl_item
where   barcode like '\_\_\_$bcDel\_%'
_STH_
    
    $sth->execute();
    my ($maxBarcodeDel) = $sth->fetchrow_array;
    $sth->finish;
    if($maxBarcodeDel =~ m/\_([\d]+)$/){
        return int($1);
    }
   return  0;
}

#####################################################
sub mxml_del_rec_holding{
    my ($dbh,$rid_bc_list,$opt,$updateUnion)=@_;

#  opt: 0|1
#       1: delete the marcXml record if it has 0 holding left.
#       0: leave it as it is.

    my $zebraidx = Opals::Context->config('zebraidx');
    my $zRoot   = Opals::Context->config('zRoot');
    my $zPort   = Opals::Context->config('zPort');
    my $zDatabase = Opals::Context->config('zDatabase');
    my %dirList;
    my $str="";
    foreach my $rid (keys  %$rid_bc_list){
        my $dir = "$zRoot/$zPort/record/$zDatabase/" . ceil($rid/1000);
        if (-f "$dir/$rid.xml") {
            $dirList{$dir} = 1;
            del_recHoldings_xml($rid,$rid_bc_list->{$rid});
            del_recHoldings_db($dbh,$rid_bc_list->{$rid});
            
            if($opt==1 && getNumOfRecHolding($dbh,$rid)==0){
                    open REC_DEL, "<$dir/$rid.xml";
                    my $content = '';
                    while (<REC_DEL>) {
                        $content .= $_;
                    }
                    close REC_DEL;
                    my $sth_marcDelete = $dbh->prepare("insert into opl_marcDelete set content = ?");
                    $sth_marcDelete->execute($content);
                    $sth_marcDelete->finish; 
                    unlink "$dir/$rid.xml";
            }
        }
        
        # Enqueueing record for z-index
        if($opt==1 && getNumOfRecHolding($dbh,$rid)==0){
             $dbh->do("update opl_marcRecord set zIndexed = 0 ,deleted=1, modDate=now() where rid = $rid");
        }
        else{
            $dbh->do("update opl_marcRecord set zIndexed = 0 where rid = $rid");
        }
    }

#    foreach my $dir (keys %dirList) {
#        system "$zebraidx -c $zRoot/$zPort/zebra.cfg -d $zDatabase update $dir >> $zRoot/$zPort/log/zebraidx.log 2>&1";
#    }
#    system "$zebraidx -c $zRoot/$zPort/zebra.cfg commit >> $zRoot/$zPort/log/zebraidx.log 2>&1";

# Mon, Feb 02, 2009 @ 09:12:36 EST
# update union deletion 

    my $syspref = tmpl_preference($dbh);
    my $autoUpdateUnion= $syspref->{'autoUpdateUnion'};
    if($updateUnion eq '1' && $autoUpdateUnion eq '1'){
        my $ridBcList;
        foreach my $rid (keys  %$rid_bc_list){
            my @bcList =();
            my $bcdelList=$rid_bc_list->{$rid};
            foreach my $bcDel (keys %$bcdelList){
                push  @bcList,$bcDel;
            }
            $ridBcList->{$rid}=\@bcList;

        }
        urq_createUnionRequest($dbh,1,"deletion",$ridBcList);

    }

#/

}
#####################################################
sub del_recHoldings_xml{
    my($rid,$bc_list) =@_;
    my $zRoot   = Opals::Context->config('zRoot');
    my $zPort   = Opals::Context->config('zPort');
    my $zDatabase = Opals::Context->config('zDatabase');
    my $dir     = "$zRoot/$zPort/record/$zDatabase/" . ceil($rid/1000);
    unless (-d $dir) {
        mkdir $dir, 0775;
        system("chown apache.apache  $dir");
    }        
     
    if (-f "$dir/$rid.xml") {
            my $xml = '';
            open  RECORD, "<$dir/$rid.xml";
            my $line;
            while (<RECORD>) {
                $line = $_;
                if($line =~ m/<\?xml(.*)\?>/i){
                    next;
                }
                if ($line !~ m/<subfield code="-"/) {
                    $xml .= $line;
                }
            }
            my $newSubFields="";
            my $found=0;

            while ($xml =~ s/([\s]*<datafield tag="852" ind1="[\d ]" ind2="[\d ]">([\s]*<subfield code="[\w]">.*<\/subfield>)+[\s]*<\/datafield>)//) {
                my $tmp852 =$1;
                $found=0;
                foreach my $bc (keys %$bc_list){
                    $bc=~ s/(\+|\$|\^|\\|\*)/\\$1/g;
                    if ($tmp852 =~ m/<subfield code="p">$bc<\/subfield>/){
                        $found=1;
                        last;
                    }
                 }
                 if(!$found){
                     $newSubFields .= $tmp852;
                 }
            }
            $xml =~ s/[\s]*<\/record>/$newSubFields\n<\/record>/;
            close RECORD;
            open  RECORD, ">$dir/$rid.xml";
            print RECORD $xml;
            close RECORD;
            system("chown apache.apache $dir/$rid.xml");
            system("chmod 664 $dir/$rid.xml");
            

    }
}
#####################################################
sub del_recHoldings_db{
    my($dbh,$bc_list) =@_;
    #my $sth_itemstatus_del = $dbh->prepare("insert into opl_itemstatus set barcode=?, ondate=now(), status=?");
    foreach my $bcDel (keys %$bc_list){
        if(isBcExisted_db($dbh,$bcDel)){
#            my $maxBcDelNumber= getMaxBcDelNumber($dbh,$bcDel);
#            $maxBcDelNumber++;
#            my $delPostFix = sprintf("%0.3d",$maxBcDelNumber);
#            my $bcDelNew = '___' .  $bcDel . '_' . $delPostFix;
            mxml_updateItemStatus($dbh,$bcDel,ITEM_DELETED,'');
            #$sth_itemstatus_del->execute($bcDelNew, ITEM_DELETED);
            #$sth_itemstatus_del->finish;
#           mxml_assignDeletionNumber($dbh,$bcDel,$bcDelNew);
        }
    }
}

#####################################################
sub isBcExisted_db{
    my($dbh,$bc) =@_;
    my $sth = $dbh->prepare("select count(*) from opl_item where barcode=?");
    $sth->execute($bc);
    my ($count) = $sth->fetchrow_array;
    $sth->finish;
    return $count;
    
    
}
#####################################################
sub getNumOfRecHolding{
    my ($dbh,$rid) = @_;
    my $sth = $dbh->prepare("select count(*) from opl_item where rid=? && substring(barcode, 1, 3) <> '___'");
    $sth->execute($rid);
    my ($count) = $sth->fetchrow_array;
    $sth->finish;
    return $count;
 
}

#####################################################
sub mxml_newItem_bk {
    my ($dbh, $ridList,$expireDays) = @_;
    $ridList =~ s/,+/,/g;
    $ridList =~ s/(^,|,$)//g;
# Wed, Jan 14, 2009 @ 15:12:03 EST
# default expiry.
    
    if(!$expireDays || $expireDays eq''){
        $expireDays= 'date_add(now(), INTERVAL 365 DAY)';
    }
    else {
        $expireDays="$expireDays 23:59:59";
    }
#
    


    my $dateToday = date_f005();
       $dateToday =~ s/([\d]{4})([\d]{2})([\d]{2})[\d]+\.(0|1)/$1-$2-$3/;
    my $noteStr="set new on: " . $dateToday  ;
    
    my $sql = "select barcode from opl_item where rid in (" . $ridList .") && substring(barcode, 1, 3) <> '___'";
    my $sth = $dbh->prepare($sql);
    $sth->execute();
    while(my ($bc)=$sth->fetchrow_array){
        mxml_updateItemStatus($dbh,$bc,6,$noteStr,$expireDays);
    }
    $sth->finish;

        #my $sql = "insert into opl_itemstatus (barcode,ondate,status,note) 
        #                         select distinct barcode, $expireDays ,6 , '" . $noteStr . "'
        #                         from opl_item where rid in (" . $ridList .") && substring(barcode, 1, 3) <> '___'";
        #my $sth = $dbh->prepare($sql);
        #$sth->execute();   
}

#####################################################
sub mxml_newItem {
    my ($dbh, $ridList,$expireDays) = @_;
    $ridList =~ s/,+/,/g;
    $ridList =~ s/(^,|,$)//g;
    
    if($expireDays =~ m/^\d\d\d\d-\d\d-\d\d$/){
        $expireDays="$expireDays 23:59:59";
    }

    my @ridArr =split(/,/,$ridList);
    foreach my $rid(@ridArr){
        _setFeatureItem($dbh,$rid,'newItem',$expireDays);
    }
}

#####################################################
sub mxml_addItemType {
    my ($dbh, $itemTypeId) = @_;

    my ($isInDb) = $dbh->selectrow_array('select count(*) from opl_itemType where id=?', undef, $itemTypeId);
    if ($isInDb) {
        return;
    }
     
    if (!$dbh->do("insert into opl_itemType set id = ?", undef, $itemTypeId)) {
        return;
    }
   
    my $sth;
    my $defItemType;

    my ($defaultItemTypeId) = $dbh->selectrow_array(<<_SQL_);
select  id
from    opl_itemType
where   defaultType = 1
_SQL_
    $sth = $dbh->prepare(<<_STH_);
select  *
from    opl_itemTypeParam
where   itemTypeId = ?
_STH_
    $sth->execute($defaultItemTypeId) || return;
    while (my $itemType = $sth->fetchrow_hashref) {
        $defItemType->{$itemType->{'userTypeId'}} = {
            loanPeriod    => $itemType->{'loanPeriod'},
            renewalPeriod => $itemType->{'renewalPeriod'},
            reservePeriod => $itemType->{'reservePeriod'},
            holdPeriod    => $itemType->{'holdPeriod'},
            gracePeriod   => $itemType->{'gracePeriod'},
            maxRenewal    => $itemType->{'maxRenewal'},
        };
    }
    $sth->finish;

    $sth = $dbh->prepare(<<_STH_);
select  catid
from    opl_category
_STH_

    my $sth_itemTypeParam = $dbh->prepare(<<_STH_);
insert into opl_itemTypeParam
set     itemTypeId    = ?,
        userTypeId    = ?,
        loanPeriod    = ?,
        renewalPeriod = ?,
        reservePeriod = ?,
        holdPeriod    = ?,
        gracePeriod   = ?,
        maxRenewal    = ?
_STH_

    $sth->execute() || return;
    while (my ($userTypeId) = $sth->fetchrow_array) {
        $sth_itemTypeParam->execute(
            $itemTypeId,
            $userTypeId,
            $defItemType->{$userTypeId}->{'loanPeriod'},
            $defItemType->{$userTypeId}->{'renewalPeriod'},
            $defItemType->{$userTypeId}->{'reservePeriod'},
            $defItemType->{$userTypeId}->{'holdPeriod'},
            $defItemType->{$userTypeId}->{'gracePeriod'},
            $defItemType->{$userTypeId}->{'maxRenewal'}
        );
    }
    $sth_itemTypeParam->finish;
    $sth->finish;
}



#####################################################
# added 2006-11-20  -- Ha
# 
# Global Edit subfield 852
# 
#####################################################

sub mxml_processGE852 {
    my ($dbh) = @_;
    print 'STARTTIME: ', `date -R`, "\n";

    my $syspref = tmpl_preference($dbh);
    my $timeout_min =  util_getTimeout_min($syspref->{'timeout'});
  
    my $sth = $dbh->prepare(<<_SQL_);
select  *
from    opl_ge852request 
where   status in ('waiting', 'processing')
_SQL_

    my $sth_rid = $dbh->prepare(<<_SQL_);
select  * 
from    opl_ge852record
where   req_id = ? && status='waiting' 
order by rid
_SQL_
   
    my $sth_rid_cnt = $dbh->prepare(<<_SQL_);
select  count(distinct rid) as count
from    opl_ge852record
where   req_id = ? &&
        status='waiting'
_SQL_

    my $sth_start = $dbh->prepare(<<_SQL_);
update  opl_ge852request
set     status = 'processing'
where   req_id = ?
_SQL_

    my $sth_finish = $dbh->prepare(<<_SQL_);
update  opl_ge852request
set     status = 'done',
        finishDate = now()
where   req_id = ?
_SQL_

 
    $sth->execute();
    my ($req_id, $action, $targetRid, $ridNum, $ridDone);
    my ($isLock, $last_sessionid);
    while (my $request = $sth->fetchrow_hashref) {
        $req_id = $request->{'req_id'};
        $action = $request->{'action'};
        $request->{'n_data'} =util_escapeXml(util_restoreLiteral($request->{'n_data'}));
        $request->{'o_data'} =util_escapeXml(util_restoreLiteral($request->{'o_data'}));

        $sth_rid_cnt->execute($req_id);
        ($ridNum) = $sth_rid_cnt->fetchrow_array;
        $ridDone = 0;

        if ($action eq 'moveHolding') {
            # Moving holding uses column n_data to store the target record.
            $targetRid = $request->{'n_data'};

            ($isLock, $last_sessionid) = mxml_isLock($dbh, $targetRid);
            if ($isLock eq 'true') {
                next;
            }

            # Lock the target record. If failed, go to the next request.
            lockRecord($dbh, $targetRid, $timeout_min) || next;
            $ridDone++;
        }

        $sth_start->execute($req_id);
        $sth_rid->execute($req_id);
        $sth_rid_cnt->execute($req_id);

        my $record;
        while (my $rec = $sth_rid->fetchrow_hashref) {
            push @{$record->{$rec->{'rid'}}}, $rec->{'barcode'} ;
        }
        #Mon, Aug 13, 2012 @ 16:28:27 EDT
        #fix insert field more than once.....
        my $appended={};
        foreach my $rid (keys %{$record}) {
            ($isLock, $last_sessionid) = mxml_isLock($dbh, $rid);
            if ($isLock eq 'true') {
                next;
            }
            
            # Lock the record. If failed, go to the next record.
            lockRecord($dbh, $rid, $timeout_min) || next;

            if ($action eq 'moveHolding') {
                geMoveHolding($dbh, $req_id, $targetRid, $rid);
            }
            elsif ($action eq 'changeRecType') {
               geChangeRecType($dbh, $req_id, $rid, $request->{'newRecType'} ); 
            }
            elsif ($action eq 'appendF') {
                if(!$appended->{$rid}){
                    $appended->{$rid}=1;
                    geInsertDataField($dbh, $req_id, $rid, 
                            $request->{'tag'}, 
                            $request->{'n_code'}, $request->{'n_data'}
                            );
                }
            }
            else {
                # $record->{$rid} is an array reference
                geDataField($dbh, $req_id, $rid,
                    $record->{$rid},
                    $action, 
                    $request->{'tag'}, 
                    $request->{'o_code'}, $request->{'n_code'},
                    $request->{'o_data'}, $request->{'n_data'}
                );
            }

            $ridDone++;
            unlockRecord($dbh, $rid);
        }       

        # Set request status to 'done'.
        if ($ridDone == $ridNum) {
            $sth_finish->execute($req_id);
        }

        if ($action eq 'moveHolding') {
            unlockRecord($dbh, $targetRid);
        }
    }

    $sth_finish->finish;
    $sth_start->finish;
    $sth_rid_cnt->finish;
    $sth_rid->finish;
    $sth->finish;
}
#####################################################
sub mxml_isLock {
    my ($dbh, $rid, $uid) = @_;
    my ($retval,$sessionid,$lockTime ) = ('false','','false');
    my $sql_MARCrec = $dbh->prepare(<<_SQL_);
select  sessionid, lockExpire,
        editUid,
        time_to_sec(timediff(lockExpire, now())) as deltaLockTime
from    opl_marcRecord
where   rid = ?
_SQL_
    $sql_MARCrec->execute($rid);
    my $sf = $sql_MARCrec->fetchrow_hashref;

    if (   (   !$uid
            &&  $sf->{'deltaLockTime'}
            &&  $sf->{'deltaLockTime'} > 0)
        || (    $uid
            &&  $sf->{'editUid'} != $uid
            &&  $sf->{'deltaLockTime'}
            &&  $sf->{'deltaLockTime'} > 0)
       ) 
    {

        $retval    = 'true';
    }
    if(!$sf->{'lockExpire'} &&  $sf->{'deltaLockTime'}){
      $lockTime = 'true';
    };
    
    $sessionid =$sf->{'sessionid'};
    $sql_MARCrec->finish;

    return ($retval,$sessionid,$lockTime); 
}
#####################################################
sub ge852 {
    my ($dbh,$req_id, $rid, $bcList, $action,$o_code, $n_code,$o_data, $n_data) = @_;

    my $zRoot     = Opals::Context->config('zRoot');
    my $zPort     = Opals::Context->config('zPort');
    my $zDatabase = Opals::Context->config('zDatabase');
    my $dir = "$zRoot/$zPort/record/$zDatabase/" . ceil($rid/1000);
    my $syspref = tmpl_preference($dbh);
    my $timeout = $syspref->{'timeout'}; 
    my $timeout_min =  util_getTimeout_min($timeout);
    my $sth_status = $dbh->prepare(<<_SQL_);
update  opl_ge852record
set     status = 'done'
where   req_id = ? && rid= ?
_SQL_

    #set lock record in table opl_marcRecord
    lockRecord($dbh,$rid,$timeout_min)|| return;   
    my $content = '';
    my $line;
    
    my $tmp_data;
    # Read XML records
    open RECORD, "<$dir/$rid.xml";
    #Action : Delete | Replace | Add new | Transfer | Copy 
    my @sf852=();
    my $skipLine=0;
    my $isField852 = 0;
    while (<RECORD>) {
        $line = $_;

        if ($line =~ m/<datafield tag="852" /) {
            $isField852 = 1;
        }
        elsif ($line =~ m/<\/datafield>/) {
            if(holdingHasBc($bcList,\@sf852)){
               @sf852 = geSubfields(\@sf852,$action,$o_code, $n_code,$o_data, $n_data);
            }
            $content .= join("",@sf852);
            undef (@sf852);
            $isField852 = 0;
            $skipLine   = 0;
        }
        elsif ($line =~ m/<subfield code="([\-\+])">/ ||
                $line =~ m/<\?xml(.*)\?>/i ) {
            next;
        }
        else{
            if($isField852){
               push @sf852,$line;
               $skipLine=1; 
            }
        }
        if(!$skipLine){
          $content .= $line; 
        }

    }#while (<RECORD>)

    
    close RECORD;
    # call mxml_update...
    my($barcodeNew, $barcodeDeleted);
    $barcodeNew ='';
    $barcodeDeleted='';
    mxml_update($dbh, $rid, $content, $barcodeNew, $barcodeDeleted);
    print "GE852 $rid done.\n";
    unlockRecord($dbh,$rid);
    $sth_status->execute($req_id,$rid);
    $sth_status->finish;
 

}
#####################################################

sub geSubfields{
    my ($sf,$action,$o_code, $n_code,$o_data, $n_data)=@_;
    my @rVal=();
    if($action eq 'delete'){
        @rVal = deleteSf($o_code,$sf);
    }
    elsif($action eq 'append'){
        @rVal = addSf($n_code,$n_data,$sf);
    }
    elsif($action eq 'copy'){
        @rVal = copySf($o_code, $n_code,$sf);
    }
    elsif($action eq 'transfer'){
        @rVal = transferSf($o_code, $n_code,$sf);
    }
    elsif($action eq 'update'){
         @rVal = replaceSf($o_code, $o_data, $n_data,$sf);
    }
    elsif($action eq 'updateAddNew'){
        @rVal = addUpdateSf($o_code,$n_data, $sf);
    }
    else{
        return @$sf;
    }
    return @rVal;
}

#----------------------------------------------------
sub holdingHasBc{
    my ($bcList,$sfArray)=@_;
    for(my $i=0; $i< scalar(@$sfArray); $i++){
        if(@$sfArray[$i] =~ m/<subfield code="p">(.+)<\/subfield>/){
            foreach my $bc(@$bcList){
                if($bc eq $1){
                    return 1;        
                }
            }
            return 0;
        }
    }
    return 0;
}

#----------------------------------------------------
sub deleteSf{
    my ($sfCode,$sfArray)=@_;
    my @rVal;
    for(my $i=0; $i< scalar(@$sfArray); $i++){
        if(@$sfArray[$i] !~ m/<subfield code="$sfCode">(.*)<\/subfield>/){
           push @rVal, @$sfArray[$i];
        }
    }
    return @rVal;
}
                               
#----------------------------------------------------
sub addSf{
    my ($sfCode,$sfData,$sfArray)=@_;
    my @rVal;
    for(my $i=0; $i< scalar(@$sfArray); $i++){
        if(@$sfArray[$i] !~ m/<subfield code="$sfCode">(.*)<\/subfield>/){
           push  @rVal,@$sfArray[$i];
        }
        else{
            my $tmp =$1;
            $tmp =~ s/^\s+|\s+$//g;
            if($tmp ne ''){
                return @$sfArray;
            }
        }
    }
    push @rVal,"    <subfield code=\"$sfCode\">$sfData</subfield>\n";
    return @rVal;
}
#----------------------------------------------------

sub replaceSf{
    my ($sfCode,$searchTerm,$replaceTerm,$sfArray)=@_;
#2010-05-12 trim replaceTerm
    $searchTerm =~ s/\$/\\\$/g;
    $replaceTerm =~ s/^\s*|\s*$//g;

    my @rVal;
    for(my $i=0; $i< scalar(@$sfArray); $i++){
        if(@$sfArray[$i] !~ m/<subfield code="$sfCode">(.*)<\/subfield>/){
           push  @rVal,@$sfArray[$i];
        }
        else{
           my $sfData=$1;
           $searchTerm  =~ s/\*/\.\*/g;
           $searchTerm  =~ s/([\{\}\[\]\(\)\\])/\\$1/g;
 #           if ($sfData eq '') { # In case:data field is empty(length=0)
#               $sfData = $replaceTerm;
#           }
#           else {
               $sfData      =~ s/(^$|$searchTerm)/$replaceTerm/i;
               $sfData      =~ s/^\s*|\s*$//g;
#           }
           push @rVal,"    <subfield code=\"$sfCode\">$sfData</subfield>\n";
        }
    }
    return @rVal;
}
#----------------------------------------------------

sub transferSf{
    my ($sfCode,$n_sfCode,$sfArray)=@_;
    my $p=-1;
    my $r=-1;
    my $sfData="";
    for(my $i=0; $i< scalar(@$sfArray); $i++){
        if(@$sfArray[$i] =~ m/<subfield code="$sfCode">(.*)<\/subfield>/){
            $sfData=$1;
            $p=$i;
        }
        elsif(@$sfArray[$i] =~ m/<subfield code="$n_sfCode">(.*)<\/subfield>/){
            if($1 eq ''){
                $r=$i;
            }
            else{
                return  @$sfArray;
            }
        }
    }
    @$sfArray[$p] = "    <subfield code=\"$n_sfCode\">$sfData</subfield>\n";
    if($r>=0){
        splice @$sfArray,$r,1;
    }
    return  @$sfArray;
}

#----------------------------------------------------
sub copySf{
    my ($sfCode,$n_sfCode,$sfArray)=@_;
    my $sfData="";
    my $p=-1;
    for(my $i=0; $i< scalar(@$sfArray); $i++){
        if(@$sfArray[$i] =~ m/<subfield code="$sfCode">(.*)<\/subfield>/){
            $sfData=$1;
        }
        elsif(@$sfArray[$i] =~ m/<subfield code="$n_sfCode">(.*)<\/subfield>/){
            $p=$i;
        }
    }
    if($sfData ne ''){
        if($p>=0){
            @$sfArray[$p] = "    <subfield code=\"$n_sfCode\">$sfData</subfield>\n";
        }
        else{
            push @$sfArray,  "    <subfield code=\"$n_sfCode\">$sfData</subfield>\n";            
        }
    }
    return  @$sfArray;
}
#----------------------------------------------------

sub addUpdateSf{
    my ($sfCode,$sfData,$sfArray)=@_;
    my $fieldExist=0;
    for(my $i=0; $i< scalar(@$sfArray); $i++){
        if(@$sfArray[$i] =~ m/<subfield code="$sfCode">(.*)<\/subfield>/){
           $fieldExist=1; 
           @$sfArray[$i] = "    <subfield code=\"$sfCode\">$sfData</subfield>\n";           
        }
    }
    if(!$fieldExist){
        push @$sfArray,  "    <subfield code=\"$sfCode\">$sfData</subfield>\n";            
    }
    return  @$sfArray;
}


################################################################################
sub geMoveHolding {
    my ($dbh, $req_id, $targetRid, $rid) = @_;

#    my $zRoot     = Opals::Context->config('zRoot');
#    my $zPort     = Opals::Context->config('zPort');
#    my $zDatabase = Opals::Context->config('zDatabase');
#    my $zDir = "$zRoot/$zPort/record/$zDatabase/";# . ceil($rid/1000);
#    my $src = $zDir . ceil($rid/1000)       . '/' . $rid       . '.xml';
#    my $dst = $zDir . ceil($targetRid/1000) . '/' . $targetRid . '.xml';
    my $src = mxml_recordPath($rid)       . '/' . $rid       . '.xml';
    my $dst = mxml_recordPath($targetRid) . '/' . $targetRid . '.xml';

    # Check if file is writable. If not, set requested record status to 
    # 'read_permission_denied' or 'write_permission_denied'.

    my $sth_status = $dbh->prepare(<<_SQL_);
update  opl_ge852record
set     status = ?
where   req_id = ? && rid = ?
_SQL_

    if (! -r $src) {
        $sth_status->execute('read_permission_denied', $req_id, $rid);
        $sth_status->finish;
        return;
    }

    if (! -w $dst) {
        $sth_status->execute('write_permission_denied', $req_id, $targetRid);
        $sth_status->finish;
        return;
    }

    if ($targetRid != $rid) {
        # Copy XML holdings
#        my $xml = getXmlRecord($zDir . ceil($rid/1000), $rid);
        my $xml = util_getXmlRecord($rid);
        my $holdings = getXmlFields($xml, '852');

#        $xml = getXmlRecord($zDir . ceil($targetRid/1000), $targetRid);
        $xml = util_getXmlRecord($targetRid);
        $xml =~ s/([\s]*)<\/record>/$holdings$1<\/record>/;
        open  RECORD, ">$dst";
        print RECORD $xml;
        close RECORD;
        system("chown apache.apache $dst");
        system("chmod 664 $dst");

        # Delete XML record
        unlink $src;

        # Update holdings' RID
        foreach my $table qw(item reserve) {
            $dbh->do(<<_SQL_);
update  opl_$table
set     rid = $targetRid
where   rid = $rid
_SQL_
        }

        # Update record index flags
        $dbh->do(<<_SQL_);
update  opl_marcRecord
set     zIndexed = 0,
        modDate=now()
where   rid in ($targetRid, $rid)
_SQL_

        # Delete record in opl_arl, opl_marcRecord, opl_recordindex
        foreach my $table qw(arl recordindex) {
            $dbh->do(<<_SQL_);
delete
from    opl_$table
where   rid = $rid
_SQL_
        }
    }

    # Set requested record status to 'done'.
    $sth_status->execute('done', $req_id, $targetRid);
    $sth_status->execute('done', $req_id, $rid);
    $sth_status->finish;
}


#####################################################
sub geChangeRecType {
    my ($dbh,$req_id, $rid, $newRecType) = @_;

    my $zRoot     = Opals::Context->config('zRoot');
    my $zPort     = Opals::Context->config('zPort');
    my $zDatabase = Opals::Context->config('zDatabase');
    my $dir = "$zRoot/$zPort/record/$zDatabase/" . ceil($rid/1000);
    my $sth_status = $dbh->prepare(<<_SQL_);
update  opl_ge852record
set     status = 'done'
where   req_id = ? && rid= ?
_SQL_

    my $content = '';
    my $line;
    
    my $tmp_data;
    # Read XML records
    open RECORD, "<$dir/$rid.xml";
    my $skipLine=0;
    my $leader="";
    my $cFields;
    my $geDone=0;
       while (<RECORD>) {
        $line = $_;
        if($line =~ m/<\?xml(.*)\?>/i ){
           next; 
        }
        if($line =~ m/<record>/ || $line =~ m/<\/record>/){
            $skipLine=0;
        }
        elsif ($line =~ m/<leader>(.*)<\/leader>/) {
            $leader=$1;
            $skipLine=1;
        }
        elsif($line =~ m/<controlfield tag=\"00\d\">(.*)<\/controlfield>/){
            if($1 && $1 ne ''){
                push @$cFields,$line;
            }
            $skipLine=1;
        }
        elsif(!$geDone){

            ($leader,$cFields)=changeRecType($newRecType,$leader,$cFields);

            $content .="  <leader>$leader</leader>\n";
            $content .=join("",@$cFields);
            $cFields = undef;#undef @cFields; 
            $skipLine=0; 
            $geDone=1;
        }
        if(!$skipLine){
          $content .= $line; 
        }
    }#while (<RECORD>)
    #print $content;

    close RECORD;
    # call mxml_update...
    my($barcodeNew, $barcodeDeleted);
    $barcodeNew ='';
    $barcodeDeleted='';
    mxml_update($dbh, $rid, $content, $barcodeNew, $barcodeDeleted);
    print "GE852 $rid done.\n";
    $sth_status->execute($req_id,$rid);
    $sth_status->finish;


}
#####################################################
sub lockRecord{
    my ($dbh,$rid,$timeout_min)=@_;
    
    my $sql_rec_lock = $dbh->prepare(<<_SQL_);
update  opl_marcRecord
set     lockExpire = now() + interval $timeout_min MINUTE 
where   rid = $rid
_SQL_
    
    $sql_rec_lock->execute() || return 0;
    $sql_rec_lock->finish;
    return 1;

}
#----------------------------------------------------
sub unlockRecord{
    my ($dbh,$rid)=@_;
    my $sql_rec_unlock = $dbh->prepare(<<_SQL_);
update  opl_marcRecord
set     lockExpire = now() 
where   rid = ?
_SQL_
    $sql_rec_unlock->execute($rid) || return 0;
    $sql_rec_unlock->finish;
    return 1;
    
}


#----------------------------------------------------
sub replaceStr{
    my ($str,$pos,$c)=@_;    
    $str=substr($str,0,$pos) . $c . substr($str,$pos + length($c));
    return $str;    
}
#----------------------------------------------------

my $recTypes={
'Books'             =>{leader=>[{pos=>6,val=>'a'},{pos=>7,val=>' '}], cf006=>[{pos=>0,val=>'a'}], cf007=>[{pos=>0,val=>' '},{pos=>1,val=>' '}], cf008=>[{pos=>23,val=>' '},{pos=>26,val=>' '}]},
'Books'             =>{leader=>[{pos=>6,val=>'t'},{pos=>7,val=>' '}], cf006=>[{pos=>0,val=>'t'}], cf007=>[{pos=>0,val=>' '},{pos=>1,val=>' '}], cf008=>[{pos=>23,val=>' '},{pos=>26,val=>' '}]},
'Journal'           =>{leader=>[{pos=>6,val=>'a'},{pos=>7,val=>'s'}], cf006=>[{pos=>0,val=>' '}], cf007=>[{pos=>0,val=>' '},{pos=>1,val=>' '}], cf008=>[{pos=>23,val=>' '},{pos=>26,val=>' '}]},
'Journal'           =>{leader=>[{pos=>6,val=>'a'},{pos=>7,val=>'b'}], cf006=>[{pos=>0,val=>' '}], cf007=>[{pos=>0,val=>' '},{pos=>1,val=>' '}], cf008=>[{pos=>23,val=>' '},{pos=>26,val=>' '}]},
'ebook'             =>{leader=>[{pos=>6,val=>'a'},{pos=>7,val=>' '}], cf006=>[{pos=>0,val=>'m'}], cf007=>[{pos=>0,val=>'c'},{pos=>1,val=>'r'}], cf008=>[{pos=>23,val=>'s'},{pos=>26,val=>' '}]},
'Sheet Music'       =>{leader=>[{pos=>6,val=>'c'},{pos=>7,val=>' '}], cf006=>[{pos=>0,val=>'c'}], cf007=>[{pos=>0,val=>' '},{pos=>1,val=>' '}], cf008=>[{pos=>23,val=>' '},{pos=>26,val=>' '}]},
'Sheet Music'       =>{leader=>[{pos=>6,val=>'d'},{pos=>7,val=>' '}], cf006=>[{pos=>0,val=>'d'}], cf007=>[{pos=>0,val=>' '},{pos=>1,val=>' '}], cf008=>[{pos=>23,val=>' '},{pos=>26,val=>' '}]},
'Maps'              =>{leader=>[{pos=>6,val=>'e'},{pos=>7,val=>' '}], cf006=>[{pos=>0,val=>'e'}], cf007=>[{pos=>0,val=>' '},{pos=>1,val=>' '}], cf008=>[{pos=>23,val=>' '},{pos=>26,val=>' '}]},
'Maps'              =>{leader=>[{pos=>6,val=>'f'},{pos=>7,val=>' '}], cf006=>[{pos=>0,val=>'f'}], cf007=>[{pos=>0,val=>' '},{pos=>1,val=>' '}], cf008=>[{pos=>23,val=>' '},{pos=>26,val=>' '}]},
'Movies'            =>{leader=>[{pos=>6,val=>'g'},{pos=>7,val=>' '}], cf006=>[{pos=>0,val=>'g'}], cf007=>[{pos=>0,val=>' '},{pos=>1,val=>' '}], cf008=>[{pos=>23,val=>' '},{pos=>26,val=>' '}]},
'Book on Tape'      =>{leader=>[{pos=>6,val=>'i'},{pos=>7,val=>' '}], cf006=>[{pos=>0,val=>'i'}], cf007=>[{pos=>0,val=>' '},{pos=>1,val=>' '}], cf008=>[{pos=>23,val=>' '},{pos=>26,val=>' '}]},
'Music Cassette'    =>{leader=>[{pos=>6,val=>'j'},{pos=>7,val=>' '}], cf006=>[{pos=>0,val=>'j'}], cf007=>[{pos=>0,val=>' '},{pos=>1,val=>' '}], cf008=>[{pos=>23,val=>' '},{pos=>26,val=>' '}]},
'Photos, Posters'   =>{leader=>[{pos=>6,val=>'k'},{pos=>7,val=>' '}], cf006=>[{pos=>0,val=>'k'}], cf007=>[{pos=>0,val=>' '},{pos=>1,val=>' '}], cf008=>[{pos=>23,val=>' '},{pos=>26,val=>' '}]},
'Computer Files'    =>{leader=>[{pos=>6,val=>'m'},{pos=>7,val=>' '}], cf006=>[{pos=>0,val=>'m'}], cf007=>[{pos=>0,val=>' '},{pos=>1,val=>' '}], cf008=>[{pos=>23,val=>' '},{pos=>26,val=>' '}]},
'Internet'          =>{leader=>[{pos=>6,val=>'m'},{pos=>7,val=>' '}], cf006=>[{pos=>0,val=>'m'}], cf007=>[{pos=>0,val=>' '},{pos=>1,val=>' '}], cf008=>[{pos=>23,val=>' '},{pos=>26,val=>'j'}]},
'Libray Kit'        =>{leader=>[{pos=>6,val=>'o'},{pos=>7,val=>' '}], cf006=>[{pos=>0,val=>'o'}], cf007=>[{pos=>0,val=>' '},{pos=>1,val=>' '}], cf008=>[{pos=>23,val=>' '},{pos=>26,val=>' '}]},
'Libray Kit'        =>{leader=>[{pos=>6,val=>'p'},{pos=>7,val=>' '}], cf006=>[{pos=>0,val=>'p'}], cf007=>[{pos=>0,val=>' '},{pos=>1,val=>' '}], cf008=>[{pos=>23,val=>' '},{pos=>26,val=>' '}]},
'Artifact'          =>{leader=>[{pos=>6,val=>'r'},{pos=>7,val=>' '}], cf006=>[{pos=>0,val=>'r'}], cf007=>[{pos=>0,val=>' '},{pos=>1,val=>' '}], cf008=>[{pos=>23,val=>' '},{pos=>26,val=>' '}]},
'Videocassette'     =>{leader=>[{pos=>6,val=>' '},{pos=>7,val=>' '}], cf006=>[{pos=>0,val=>' '}], cf007=>[{pos=>0,val=>'v'},{pos=>1,val=>' '}], cf008=>[{pos=>23,val=>' '},{pos=>26,val=>' '}]},
'Compact Disc'      =>{leader=>[{pos=>6,val=>' '},{pos=>7,val=>' '}], cf006=>[{pos=>0,val=>' '}], cf007=>[{pos=>0,val=>'c'},{pos=>1,val=>'o'}], cf008=>[{pos=>23,val=>' '},{pos=>26,val=>' '}]},
'CD Music'          =>{leader=>[{pos=>6,val=>' '},{pos=>7,val=>' '}], cf006=>[{pos=>0,val=>' '}], cf007=>[{pos=>0,val=>'s'},{pos=>1,val=>'d'}], cf008=>[{pos=>23,val=>' '},{pos=>26,val=>' '}]}
};
   
#----------------------------------------------------
sub changeRecType(){
    my ($type,$leader,$ctrlFields)=@_;
    if($recTypes->{$type}){
        if($recTypes->{$type}->{'leader'}){
           my $a = $recTypes->{$type}->{'leader'};
           foreach my $l (@$a){                
               $leader=replaceStr($leader,$l->{'pos'},$l->{'val'});
           }
        }

        # case change needed  in control field 006
         $ctrlFields = _updateCtrlFieldMarcXml($type,$ctrlFields,'006');
        
        # case change needed  in control field 007
        $ctrlFields = _updateCtrlFieldMarcXml($type,$ctrlFields,'007');
            
        # case change needed  in control field 008. e.g. Internet
        $ctrlFields = _updateCtrlFieldMarcXml($type,$ctrlFields,'008');
    }
    
    return ($leader,$ctrlFields);
}

#----------------------------------------------------
# Fri, Jul 13, 2012 @ 09:01:37 EDT
#
sub _updateCtrlFieldMarcXml{
    my ($type,$ctrlFields,$ctrlTag) = @_;

    print "$type -- $ctrlTag --- $recTypes->{$type}->{'cf'.$ctrlTag}\n";
    # case change needed  in control field : $ctrlTag ('006'|'007' | '008')
    if($recTypes->{$type}->{'cf'.$ctrlTag}){
       my $i=0;
       for($i=0; $i<scalar(@$ctrlFields); $i++ ){
           if(@$ctrlFields[$i] =~ m/<controlfield tag=\"$ctrlTag\">(.+)<\/controlfield>/){
               my $d =$1;
               my $a = $recTypes->{$type}->{'cf'.$ctrlTag};
               foreach my $l (@$a){
                   $d =replaceStr($d,$l->{'pos'},$l->{'val'});
               }
              @$ctrlFields[$i] = "  <controlfield tag=\"$ctrlTag\">$d<\/controlfield>\n"  ;
              last;
           }
       }
       # there is no control field $ctrlTag, insert one. 
       if($ctrlTag ne '008' && $i ==scalar(@$ctrlFields)){
           my $a = $recTypes->{$type}->{'cf'.$ctrlTag};
           my $d=@$a[0]->{'val'};
           if(scalar(@$a)>1){
               $d .= @$a[1]->{'val'};
           }
           ##my $d=@$a[0]->{'val'} . @$a[1]->{'val'};
           for($i=0; $i<scalar(@$ctrlFields); $i++ ){
                if(@$ctrlFields[$i] =~ m/<controlfield tag=\"(\d+)\">(.+)<\/controlfield>/){
                    if($1>$ctrlTag){
                        splice @$ctrlFields,$i,0,"  <controlfield tag=\"$ctrlTag\">$d<\/controlfield>\n";
                        last
                    }
                }
           }
           # no other control field has tag > $ctrlTag, append one
           if($i ==scalar(@$ctrlFields)){
                push @$ctrlFields, "  <controlfield tag=\"$ctrlTag\">$d<\/controlfield>\n";
           }
       }
    }

    return $ctrlFields;
}
#----------------------------------------------------

sub geDataField {
    my ($dbh,$req_id, $rid, $bcList,$action,$fieldTag, $o_code, $n_code,$o_data, $n_data) = @_;
    my $zRoot     = Opals::Context->config('zRoot');
    my $zPort     = Opals::Context->config('zPort');
    my $zDatabase = Opals::Context->config('zDatabase');
    my $dir = "$zRoot/$zPort/record/$zDatabase/" . ceil($rid/1000);
    my $sth_status = $dbh->prepare(<<_SQL_);
update  opl_ge852record
set     status = 'done'
where   req_id = ? && rid= ?
_SQL_

    my $content = '';
    my $line;
    
    
    my $tmp_data;
    # Read XML records
    open RECORD, "<$dir/$rid.xml";

    my $isModifyField = 0;  
    my $sfCode     = '0';
    my $skipLine  = 0;
    my $n_sfData="";
    my @sf=();    
    my $fieldExist = 0;
    while (<RECORD>) {
        $line = $_;
        if ($line =~ m/<datafield tag="$fieldTag" /) {
            $isModifyField = 1;
	        $fieldExist = 1;
        }
        elsif ($line =~ m/<\/datafield>/) {
            if($isModifyField){
                if($fieldTag eq '852'){
                    #if(holdingHasBc($bcList,\@sf)){
                    #Tue, Dec 01, 2009 @ 08:48:27 EST 
                    #if no bc list provideѕ, it means all holdings.
                    if(holdingHasBc($bcList,\@sf) || (scalar(@$bcList)==1 && @$bcList[0] eq '')){
                        @sf = geSubfields(\@sf,$action,$o_code, $n_code,$o_data, $n_data);
                    }                
                }
                else{
                    @sf = geSubfields(\@sf,$action,$o_code, $n_code,$o_data, $n_data);    
                }
                $content .= join("",@sf);
                undef (@sf);
            }
            $isModifyField = 0;
            $skipLine   = 0;
        }
        elsif ($line =~ m/<subfield code="([\-\+])">/ ||
                $line =~ m/<\?xml(.*)\?>/i) {
            next;
        }
        else{
            if($isModifyField){
               push @sf,$line;
               $skipLine=1; 
            }
        }
        if(!$skipLine){
          $content .= $line; 
        }
    } #END while (<RECORD>)
    close RECORD;
    
    if($fieldExist){    
         # call mxml_update...
    	my($barcodeNew, $barcodeDeleted);
    	$barcodeNew ='';
   	    $barcodeDeleted='';
        mxml_update($dbh, $rid, $content, $barcodeNew, $barcodeDeleted);
    }
    elsif($action eq 'append'){
	    geInsertDataField($dbh,$req_id, $rid, $fieldTag, $n_code, $n_data);
    }

    print "GE $rid done.\n";
    $sth_status->execute($req_id,$rid);
    $sth_status->finish;
   
}

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

sub geInsertDataField {
    my ($dbh,$req_id, $rid, $nFieldTag, $n_code, $n_data) = @_;
    my $zRoot     = Opals::Context->config('zRoot');
    my $zPort     = Opals::Context->config('zPort');
    my $zDatabase = Opals::Context->config('zDatabase');
    my $dir = "$zRoot/$zPort/record/$zDatabase/" . ceil($rid/1000);
   
    my $content = '';
    my $line;
    my $done=0;
    my $field = "";  
    
    my $tmp_data;
    # Read XML records
    
    my $newField ="  <datafield tag=\"$nFieldTag\" ind1=\" \" ind2=\" \">\n"
                 ."    <subfield code=\"$n_code\">$n_data</subfield>\n"
		         ."  </datafield>\n";

    open RECORD, "<$dir/$rid.xml";
    
    while (<RECORD>) {
        $line = $_;
        if($line =~ m/<\?xml(.*)\?>/i){
            next;
        }
        if ($line =~ m/<datafield tag="(.+)" /) {
	        $field=$1;
            if(!$done && $field ge $nFieldTag){
                $content .= $newField;
                $done=1;
	        }
        }
        elsif($line =~ m/<\/record>/g && !$done){
            $content .= $newField;
            $done=1;
        }
        $content .= $line; 
 
    } #END while (<RECORD>)

    close RECORD;
   # call mxml_update...
    my($barcodeNew, $barcodeDeleted);
    $barcodeNew ='';
    $barcodeDeleted='';
    mxml_update($dbh, $rid, $content, $barcodeNew, $barcodeDeleted);
   
}

#####################################################
sub mxml_processReplaceItemType {
    my ($dbh) = @_;

    my $sth = $dbh->prepare(<<_SQL_);
select  *
from    opl_itemTypeChange
where   status in ('waiting', 'processing')
_SQL_
    my $sth_rid = $dbh->prepare(<<_SQL_);
select  *
from    opl_item
where   typeId = ? &&
        dateImport < ?
group by rid
_SQL_
    my $sth_start = $dbh->prepare(<<_SQL_);
update  opl_itemTypeChange
set     status = 'processing'
where   cid = ?
_SQL_
    my $sth_finish = $dbh->prepare(<<_SQL_);
update  opl_itemTypeChange
set     status = 'done',
        dateFinish = now()
where   cid = ?
_SQL_

    $sth->execute();
    while (my $request = $sth->fetchrow_hashref) {
        $sth_start->execute($request->{'cid'});

        $sth_rid->execute($request->{'oldTypeId'}, $request->{'dateRequest'});
        while (my $rec = $sth_rid->fetchrow_hashref) {
#            print $rec->{'rid'}, "==" , $request->{'oldTypeId'},"==\n";
            mxml_replaceItemType($dbh, $rec->{'rid'}, $request->{'oldTypeId'}, $request->{'newTypeId'}, $request->{'cid'});
        }

        $sth_finish->execute($request->{'cid'});
    }
    $sth_finish->finish;
    $sth_start->finish;
    $sth_rid->finish;
    $sth->finish;
}


#####################################################
sub mxml_replaceItemType {
    my ($dbh, $rid, $oldTypeId, $newTypeId, $cid) = @_;
    
    # Potential bug:
    my $oldTypeId_regex = $oldTypeId;
    $oldTypeId_regex =~ s/([\W])/\\$1/g;
    $oldTypeId_regex =" *" if($oldTypeId_regex =~ m/^ *$/g);

    my $zRoot     = Opals::Context->config('zRoot');
    my $zPort     = Opals::Context->config('zPort');
    my $zDatabase = Opals::Context->config('zDatabase');
    my $dir = "$zRoot/$zPort/record/$zDatabase/" . ceil($rid/1000);

    # Read XML records
    open RECORD, "<$dir/$rid.xml";
    my $content = '';
    my $line;
    my $replacement_allowed = 0;
    my $sth = $dbh->prepare(<<_SQL_);
update  opl_itemInfo
set     sf852Data = ?
where   barcode = ? &&
        sf852Code = '3' &&
        sf852Data = ?
_SQL_
    while (<RECORD>) {
        $line = $_;
        if($line =~ m/<\?xml(.*)\?>/i){
            next;
        }
        if ($line =~ /<datafield tag="852" /) {
            $replacement_allowed = 1;
        }
        if ($line =~ /<\/datafield>/) {
            $replacement_allowed = 0;
        }
        
        if ($replacement_allowed) {
            $line =~ s/<subfield code="3">$oldTypeId_regex<\/subfield>/<subfield code="3">$newTypeId<\/subfield>/g;

            if ($line =~ m/<subfield code="p">(.+)<\/subfield>/) {
                $sth->execute($newTypeId, $1, $oldTypeId);
            }
        }

        $content .= $line;
    }
    $sth->finish;
    close RECORD;

    # Write XML records
    open  RECORD, ">$dir/$rid.xml";
    print RECORD $content;
    close RECORD;
    system("chown apache.apache $dir/$rid.xml");
    system("chmod 664 $dir/$rid.xml");

    # Update record in database
    my $sql = <<_SQL_;
update  opl_item
set     typeId = ?
where   rid = ? &&
        typeId = ? && 
        barcode not regExp '^___'

_SQL_
    my @bindValue = ($newTypeId, $rid, $oldTypeId);
    my $count = $dbh->do($sql, undef, @bindValue);

    # Update process counter
    $sql = <<_SQL_;
update  opl_itemTypeChange
set     cReplaced = cReplaced + ?
where   cid = ?
_SQL_
    @bindValue = (($count)?$count:0, $cid);
    $dbh->do($sql, undef, @bindValue);
}
#####################################################



sub mxml_exportRecord {
    my ($zRoot, $zPort, $zDatabase, $rid) = @_;

    my $dir = "$zRoot/$zPort/record/$zDatabase/" . ceil($rid/1000);

    if (! -r "$dir/$rid.xml") {
        return (undef, undef);
    }

    my ($line, $xml, $cFixed) = ('', '', 0);
    open REC, "<$dir/$rid.xml";
    while (<REC>) {
        $line = $_;
        if ($line =~ m/(<subfield code="\-">|<\?xml version=")/) {
            next;
        }

        $xml .= $line;
        if ($xml =~ s/(.|[\s\r\n])*(<record>(.|[\s\r\n])+<\/record>)(.|[\s\r\n])*/$2/) {
            last;
        }
    }
    close REC;

    ($xml, $cFixed) = mxml_fixXmlRecord($xml);
=item
    if ($cFixed) {
        my $dir = "$zRoot/$zPort/record/$zDatabase/" . ceil($rid/1000);
        open REC, ">$dir/$rid.xml";
        print REC $xml;
        close REC;
    }
=cut    
    return ($xml, $cFixed);
}
#####################################################


sub mxml_exportHolding {
    my ($xml, $holding) = @_;

    my $selectedHolding = '';
    my $f852;
    while ($xml =~ s/([\s]*<datafield tag="852" ind1="[\d ]" ind2="[\d ]">([\s]*<subfield code="[\w]">.*<\/subfield>)*[\s]*<\/datafield>)//) {
        $f852 = $1;
        my $f852_p = '';
        if ($f852 =~ m/<subfield code="p">(.*)<\/subfield>/) {
            $f852_p = $1;
            $f852_p =~ s/[\s]+$//;
        }
        foreach my $bc (keys %{$holding}) {
            #if ($f852 =~ m/<subfield code="p">$bc[\s]*<\/subfield>/) {
            if ($f852_p eq $bc) {
                $selectedHolding .= $f852;
            }
        }
    }

    $xml =~ s/([\s]*<\/record>)/$selectedHolding$1/;

    return $xml;
}
#####################################################


sub mxml_fixXmlRecord {
    my ($xml) = @_;
    my $LEADER = '00000cam  2200241   4500';

    my $cFixed = 0;

    # Fix leader
    $xml =~ m/<leader>(.*)<\/leader>/;
    my $leader = $1;

    if ($leader =~ m/[^a-z0-9 ]/ || length($leader) != 24) {
        $xml =~ s/<leader>.*<\/leader>/<leader>$LEADER<\/leader>/;
        $cFixed++;
    }

    # Replace empty indicator by blank
    if ($xml =~ m/<datafield tag="[\d]{3}" ind1=""/) {
        $xml =~ s/(<datafield tag="[\d]{3}" ind1=)""/$1" "/g;
        $cFixed++;
    }
    if ($xml =~ m/<datafield tag="[\d]{3}" ind1="[\w ]" ind2=""/) {
        $xml =~ s/(<datafield tag="[\d]{3}" ind1="[\w ]" ind2=)""/$1" "/g;
        $cFixed++;
    }
    # Replace empty subfield code by subfield code 'a'
    if ($xml =~ m/<subfield code="">/) {
        $xml =~ s/(<subfield code=)"">/$1"a">/g;
        $cFixed++;
    }

    if ($xml =~ m/<controlfield tag="[\d]{0-2}"/) {
        $xml =~ s/(<controlfield tag=)"[\d]{0-2}"/$1"009"/g;
        $cFixed++;
    }
    if ($xml =~ m/<controlfield tag="(0[1-9][\d]|[1-9][\d]{2})"/) {
        $xml =~ s/(<controlfield tag=)"(0[1-9][\d]|[1-9][\d]{2})"/$1"009"/g;
        $cFixed++;
    }

    if ($xml =~ m/<datafield tag="[\d]{0-2}"/) {
        $xml =~ s/(<datafield tag=)"[\d]{0-2}"/$1"999"/g;
        $cFixed++;
    }
    if ($xml =~ m/<datafield tag="00[\d]"/) {
        $xml =~ s/(<datafield tag=)"00[\d]"/$1"999"/g;
        $cFixed++;
    }
#Mon, Nov 01, 2010 @ 13:13:35 EDT
# dedup 008 field
    
    my $marker_008="___OPALS_MARC_XML_controlfield008marker_f801d6faada54a60faa577bbb60f33___";
    if($xml =~ m/(\s*<controlfield tag="008">.*<\/controlfield>\s*\n)/){
        my $tmp =$1;
        $xml =~ s/\s*<controlfield tag="008">.*<\/controlfield>\s*\n/$marker_008/;
        $xml =~ s/[\t ]*<controlfield tag="008">.*<\/controlfield>\s*\n//g;
        $xml =~ s/$marker_008/$tmp/;

    }
# /dedup

    # Should I fix those errors:
    #  - blank tag/indicator
    #  - wrong tag assigned to control/data field, eg. 002 for data field

    return ($xml, $cFixed);
}
#////////////////////////////////////////////////////////////////////////////
sub loadAttTable{
    my ($dbh) =@_;
    my $attTbl;
    my $sth = $dbh->prepare(<<_SQL_);
select attrval,tag,subfields
from opl_index_map where tag is not null && subfields is not null
_SQL_
    $sth->execute;
    while(my ($attval,$tag,$subfields) = $sth->fetchrow_array){
        push @{$attTbl->{$attval}},{tag=>$tag,subfields=>$subfields};
    }
    return $attTbl;
}
############################################################


sub get_sth_arl {
    my ($dbh) = @_;

    my $sth_arl = $dbh->prepare(<<_SQL_);
insert into opl_arl
set     rid = ?,
        tag = ?,
        ind1 = ?,
        code = ?,
        data1 = ?,
        data2 = ?
_SQL_

    return $sth_arl;
}
############################################################


sub get_arl_spec {
    my $arl_spec;
    $arl_spec->{'521'}->{'0'}->{'a'} = 'range data';
    $arl_spec->{'521'}->{'1'}->{'a'} = 'range data';
    $arl_spec->{'521'}->{'2'}->{'a'} = 'range data';
    $arl_spec->{'526'}->{'0'}->{'a'} = 'data';
    $arl_spec->{'526'}->{'0'}->{'b'} = 'range data';
    $arl_spec->{'526'}->{'0'}->{'c'} = 'range data';
    $arl_spec->{'526'}->{'0'}->{'d'} = 'data';

    return $arl_spec;
}
############################################################


sub add_arl {
    my ($sth_arl, $arl_data) = @_;

    my $rv = $sth_arl->execute(
        $arl_data->{'rid'},
        $arl_data->{'tag'},
        $arl_data->{'ind1'},
        $arl_data->{'code'},
        $arl_data->{'data1'},
        $arl_data->{'data2'}
    );

    return $rv;
}
############################################################


sub mxml_updateRecordIndex {
    my ($dbh, $rid, $xml) = @_;

    $dbh->do("delete from opl_recordindex where rid = $rid");

    my $rv;
    my ($fXml, $ind1Xml, $ind2Xml, $sfXml,
        $tag, $sflist, $sfCode, $sfdata);

    my $sth_arl = get_sth_arl($dbh);
    my $arl_spec = get_arl_spec();

    my $attTbl = loadAttTable($dbh);
    my $rec;
    my @val;
    push @val, $rid;
    my $read;
    foreach my $att (sort keys %$attTbl) {
        $rec->{$att} = "";
        $fXml = $xml;
        foreach my $tag_sf (@{$attTbl->{$att}}) {
            $tag    = $tag_sf->{'tag'};
            $sflist = $tag_sf->{'subfields'};
            if($tag =~ m/00[\d]/) {
                $fXml =~ s/[\s]*<controlfield tag="$tag">(.*)<\/controlfield>//;
                $rec->{$att} .= "$1\n";   
            }
            else{
                while ($fXml =~ s/[\s]*<datafield tag="$tag" ind1="([\d ])" ind2="([\d ])">(([\s]*<subfield code="[\w-]">.*<\/subfield>)*)[\s]*<\/datafield>//) 
                {   
                    $ind1Xml = $1;
                    $ind2Xml = $2;
                    $sfXml = $3;
                    while ($sfXml =~ s/[\s]*<subfield code="([\w|-])">(.*)<\/subfield>//) {
                        ($sfCode, $sfdata) = ($1, $2);

                        if ($tag eq '020' && $sfCode eq 'a') {
                            if ($sfdata =~ m/([\d\-]{9,}[xX]?)/) {
                                $sfdata = $1;
                                $sfdata =~ s/-//g;

                                if (length($sfdata) != 10 &&
                                    length($sfdata) != 13) {
                                    $sfdata = '';
                                }
                            }
                            else {
                                $sfdata = '';
                            }
                        }
                        
                        if ($sflist eq '' || $sflist =~ m/$sfCode/) {
                            if ($tag eq '020') {
                                $rec->{$att} .= "$sfdata ";
                            }
                            else {
                                $rec->{$att} .= "$sfdata\n";
                            }
                        }
                    }
                }
            }

            $read->{$tag} = 1;
        }

        push @val,$rec->{$att};        
    }

    $sth_arl->finish;
    
#    my $query_delete = "delete from opl_recordindex where rid= ?";
#    my $sth = $dbh->prepare($query_delete);
#    $sth->execute($rid);

    my $query_insert="insert into opl_recordindex set rid=? ";
    foreach my $attr (sort keys %$attTbl){
        $query_insert .= ", attr_$attr= ? ";
    }
    $rv = $dbh->do($query_insert, undef, @val);

}
############################################################


#sub getXmlRecord {
#    my ($zdbDir, $rid) = @_;
#
#    my $record = '';
#    if (! -f "$zdbDir/$rid.xml") {
#        print "ERROR: $zdbDir/$rid.xml: not found.\n";
#        return;
#    }
#
#    #print "$rid\n";
#    #return;
#
#    open MARCXML, "<$zdbDir/$rid.xml";
#    while (<MARCXML>) {
#        $record .= $_;
#    }
#    close MARCXML;
#
#    return $record;
#}
############################################################


sub getXmlFields {
    my ($xml, $field) = @_;
    my $fieldStr = '';
    
    if ($field =~ m/leader/) {
        while ($xml =~ s/([\s]*<leader>(.*)<\/leader>)//) {
            $fieldStr = $1;
        }
    }
    elsif ($field =~ m/00\d/) {
        while ($xml =~ s/([\s]*<controlfield tag="$field">.*<\/controlfield>)//) {
            $fieldStr .= $1;
        }
    }
    else {
        while ($xml =~ s/([\s]*<datafield tag="$field" ind1="[\d ]" ind2="[\d ]">([\s]*<subfield code=".">.*<\/subfield>)*[\s]*<\/datafield>)//) {
            $fieldStr .= $1;
        }
    }
    
    return $fieldStr;
}
############################################################


sub mxml_saveRecordIdentifier {
    my ($dbh, $marc) = @_;

    my $rid = getRidFromMarc($marc) || return;

    $dbh->do(<<_SQL_);
delete from opl_recordIdentifier where rid = $rid
_SQL_

    my $sth = $dbh->prepare(<<_SQL_);
insert
into    opl_recordIdentifier
set     rid = ?,
        tag = ?,
        code = ?,
        data = ?
_SQL_

    my ($tag, $code, $data, $isbn_obj, $isbn13);
    foreach my $id (@Opals::Search::RECORD_IDENTIFIERS) {
        $tag = $id->{'tag'};
        $code = $id->{'code'};

        foreach my $f ($marc->field($tag)) {
            $data = $f->subfield($code);

            if (!$data) {
                next;
            }

            if ($tag eq '020' && $code eq 'a') {
                $data =~ s/[\- ]+//g;
                if ($data =~ m/(^|[\D])((\d{3})?\d{9}[0-9xX])([\D]|$)/) {
                    $data = $2;
                    #print "ISBN: $data\n";
                }
                else {
                    next;
                }
                
                $isbn_obj = Business::ISBN->new($data) || next;
                if($isbn_obj->is_valid()){
                    $isbn_obj->fix_checksum;
                    $isbn13 = $isbn_obj->as_isbn13;
                    $data = $isbn13->as_string([]);
                }
            }
            elsif ($tag eq '035' && $code eq 'a' && 
                    $data !~ m/^\(OCoLC\)[1-9]/) {
                next;
            }

            $sth->execute($rid, $tag, $code, $data);
        }
    }

    $sth->finish;
}
############################################################


sub getRidFromMarc {
    my ($marc) = @_;

    if (!$marc) {
        return;
    }

    my $f001 = $marc->field('001');
    if (!$f001) {
        return;
    }

    return $f001->data();
}


#------------------------------------------------------------------------------  
#Thu, Mar 10, 2011 @ 11:08:13 EST
# Upddate record statistics
sub mxml_updateItemStats{
    my ($dbh,$bc,$status,$onDate)=@_;
    my $sth_insert_itemStat=$dbh->prepare(<<_SQL_);
insert into opl_itemStats
set         statId  = ?,      rid      = ?, 
            barcode = ?,      
            import  = ?,      deleted  = ?,
            damaged = ?,      lost     = ?,
            missing = ?,      found    = ?
            
_SQL_
  
    my ($import,$deleted,$damaged,$lost,$missing,$found) =(0,0,0,0,0,0);
    my $rid         = getRid($dbh,$bc);
    my $itemStats   = getItemStats($dbh,$bc, $status);

    if($itemStats eq 'import'){
        $import=1;
    }
    elsif($itemStats eq 'deleted'){
        $deleted=1;
    }
    elsif($itemStats eq 'damaged'){
        $damaged=1;
    }
    elsif($itemStats eq 'lost'){
        $lost=1;
    }
    elsif($itemStats eq 'missing'){
        $missing=1;
    }
    elsif($itemStats eq 'found'){
        $found=1;
    }
    else{
        return;
    }
    
    my $statsId =updateRecStats($dbh,$rid, $itemStats,$onDate);
    if($statsId){
        $sth_insert_itemStat->execute($statsId,$rid,$bc,$import,$deleted,
                                      $damaged,$lost,$missing,$found);
    }
    $sth_insert_itemStat->finish;

}

#------------------------------------------------------------------------------ 
sub updateRecStats{
    my ($dbh,$rid, $itemStats,$onDate)=@_;
    my $sth_insert_recStat=$dbh->prepare(<<_SQL_);
insert into opl_recordStats
set         rid   = ?, 
            onDate = ?, status= ?
_SQL_
    
    my $statId_ret = 0;
    my ($statId,$statStatus,$statDate) = getLastStatRec($dbh,$rid);
    $statDate = substr($statDate, 0,10);
    $onDate   = substr($onDate, 0,10);
    if($itemStats eq 'import'){
        if($statId){
            if(($statStatus eq 'new' || $statStatus eq 'changed') && $onDate eq $statDate ){
                $statId_ret=$statId;
            }
            else{
                $sth_insert_recStat->execute($rid,$onDate,'changed');
                $statId_ret = $dbh->{'mysql_insertid'};
            }
        }
        else{
            $sth_insert_recStat->execute($rid,$onDate,'new');
            $statId_ret = $dbh->{'mysql_insertid'};
        }
    }
    elsif($itemStats eq 'deleted' && getNumOfRecHolding($dbh,$rid) == 0){
        $sth_insert_recStat->execute($rid,$onDate,'deleted');
        $statId_ret = $dbh->{'mysql_insertid'};
    }
    else{
        if($statDate eq $onDate && $statStatus eq 'changed'){
            $statId_ret=$statId;
        }
        else{
            $sth_insert_recStat->execute($rid,$onDate,'changed');
            $statId_ret = $dbh->{'mysql_insertid'};
        }
    }
    $sth_insert_recStat->finish;
    return $statId_ret;

}
#------------------------------------------------------------------------------ 
sub getItemStats{
    my ($dbh,$bc, $status)=@_;
    my $stats="";
       
    if($status == ITEM_ACTIVE ){
        my $secondLastStatus=getSecondLastStatus($dbh,$bc);
        
        if(defined $secondLastStatus && $secondLastStatus == ITEM_LOST){
                $stats = 'found';
        }
        else{
            $stats = 'import' if(isNewItem($dbh,$bc));
        }
    }
    elsif($status == ITEM_DAMAGED){
        $stats = 'damaged';
    }
    elsif($status == ITEM_LOST){
        $stats = 'lost';
    }
    elsif($status == ITEM_DELETED){
        $stats = 'deleted';
    }
    elsif($status == ITEM_INACTIVE){
        $stats = 'missing';
    }
    return $stats;
}



#------------------------------------------------------------------------------ 
sub getSecondLastStatus{
    my ($dbh,$bc)=@_;
    my $status=undef;
    my $sth = $dbh->prepare(<<_SQL_);
    select status  from opl_itemstatus where  barcode = ?
    order by id desc limit 1,1
_SQL_
    $sth->execute($bc);
    if(my ($s)= $sth->fetchrow_array){
        $status=$s;
    }
    $sth->finish;
    return $status;
}

#------------------------------------------------------------------------------ 
sub isNewItem{
    my ($dbh,$bc)=@_;
    my $sth = $dbh->prepare(<<_SQL_);
    select if(dateImport =modDate,1,0) from opl_item where barcode = ?
_SQL_
    $sth->execute($bc);
    my ($isNew)= $sth->fetchrow_array;
    $sth->finish;
    return $isNew;
}
#------------------------------------------------------------------------------ 
sub getLastStatRec{
    my ($dbh,$rid )=@_;
    my $sth = $dbh->prepare(<<_SQL_);
    select statId,status,onDate from opl_recordStats where   rid = ? order by statId desc limit 1
_SQL_
    $sth->execute($rid);
    my ($statId,$status,$onDate) =(0,'','');
       ($statId,$status,$onDate)= $sth->fetchrow_array;
    $sth->finish;
    return ($statId,$status,$onDate);
}


#------------------------------------------------------------------------------ 
sub getItemPrefix{
    my ($dbh,$bc)=@_;
    my $sth = $dbh->prepare(<<_SQL_);
    select sf852Data prefix from opl_itemInfo where sf852Code='k' && barcode =?
_SQL_
    $sth->execute($bc)|| return ;
    my ($prefix)= $sth->fetchrow_array;
    $sth->finish;
    return $prefix;
}
#------------------------------------------------------------------------------ 
sub getRid{
    my ($dbh,$bc)=@_;
    my $sth = $dbh->prepare(<<_SQL_);
    select rid from opl_item where barcode = ?
_SQL_
    $sth->execute($bc)|| return ;
    my ($rid)= $sth->fetchrow_array;
    $sth->finish;
    return $rid;
}

#------------------------------------------------------------------------------ 
# /Upddate record statistics
sub mxml_updateItemStatus{
    my ($dbh,$bc,$status,$note,$onDate)=@_;
    if($status == 6){
        my $rid = getRid($dbh,$bc);
        _setFeatureItem($dbh,$rid,'newItem',$onDate);
    }
    else{
        _setItemStatus($dbh,$bc,$status,$note,$onDate);
   }
}
#------------------------------------------------------------------------------ 
sub _setItemStatus{
    my ($dbh,$bc,$status,$note,$onDate)=@_;
    $note='' if(!defined $note);
    my $sql ="insert into opl_itemstatus set barcode = ?, status = ?, note = ?, ";

    if($onDate && $onDate =~ /^\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d$/g){
        $sql .= " onDate='$onDate'";
    }
    else{
        $sql .= " onDate =now()";
    }
   my $sth =$dbh->prepare($sql);
   $sth->execute($bc,$status,$note);
   my $id = $dbh->{'mysql_insertid'};
   my ($date)= $dbh->selectrow_array("select left(onDate,10) from opl_itemstatus where id=$id");
   if($status  == ITEM_DELETED){
        my $bcDelNew = $bc;
        my $maxBarcodeDel = getMaxBcDelNumber($dbh,$bc);
        $maxBarcodeDel++;
        my $delPostFix = sprintf("%0.3d",$maxBarcodeDel);
        $bcDelNew = '___' .  $bc . '_' . $delPostFix;
        mxml_assignDeletionNumber($dbh,$bc,$bcDelNew);
        $bc =$bcDelNew;
   }    
   mxml_updateItemStats($dbh,$bc,$status,$date);


}
#------------------------------------------------------------------------------ 

sub _setFeatureItem{
    my ($dbh,$rid,$feature,$expDate)=@_;
    my $sql =<<_SQL_;
replace
into  opl_featureItem 
set   rid       = ?,
      feature   = ?,   
        
_SQL_

    if(defined $expDate && $expDate =~/^\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d$/){
        $sql .= " expiryDate='$expDate'";
    }
    else{
        $sql .= " expiryDate=date_add(now(), INTERVAL 365 DAY) ";

    }

    my $sth =$dbh->prepare($sql);
    $sth->execute($rid,$feature);
    $sth->finish;
  
}

#------------------------------------------------------------------------------ 
# Wed, Mar 23, 2011 @ 16:01:01 EDT
sub mxml_archiveMarcXml{
    my ($dbh,$rid,$marcxml)=@_;
    my $sth_insert=$dbh->prepare(<<_SQL_);
insert into opl_recordArchive
set         rid     = ?, 
            marcXml = compress(?),
            onDate=now()
_SQL_
    $sth_insert->execute($rid,$marcxml)  if($marcxml ne '');
    $sth_insert->finish;
}

#------------------------------------------------------------------------------ 
# retrieve marc xml from archive
sub mxml_retrieveMarcXml{
    #*****************************************
    #   params: rid      => $rid,
    #           onDate   => $rDate
    #*****************************************
    my ($dbh,$params)=@_;
    my ($rid,$onDate) = (0,'');
        $rid        = $params->{'rid'}    if ($params->{'rid'});
        $onDate     = $params->{'onDate'} if ($params->{'onDate'});

    my $sql = " select archId,onDate, UNCOMPRESS(marcXml) as marcXml from  opl_recordArchive where ";
    my @val; my $contStr='';
    if($rid){
        $contStr .= " && " if($contStr ne '');
        $contStr .= " rid  = ? ";
        push @val, $rid;
    }
    if($onDate && $onDate ne ''){
        $contStr .= " && " if($contStr ne '');
        #$contStr .= " left(onDate,10) = ?"; 
        #push @val, left($onDate,10);
        $contStr .= " onDate regexp  ?"; 
        push @val, $onDate;
    }
        
    $sql .= " $contStr order by archId desc ";


       my $sth = $dbh->prepare($sql);
    my $archRs = $sth->execute(@val);
    my @aList =();
    #if(my ($onDate,$marcXml) = $sth->fetchrow_array){
    while (my $rec = $sth->fetchrow_hashref) {   
         push @aList, $rec;
 
    }
    $sth->finish;
    return \@aList;
}

#------------------------------------------------------------------------------ 



1;