#!/usr/bin/perl

#use utf8;
use strict;
use CGI;

use Opals::Context;
use POSIX qw(
    ceil
);
use Opals::Search qw(
    srch_templateMarcRecord
    srch_getMarcImport
);
use Opals::User qw(
    user_currentUser
);
use Opals::MarcXml qw(
    mxml_retrieveMarcXml_ArchId
);
use MARC::Record;
use MARC::Field;


my $dbh = Opals::Context->dbh();
END { $dbh->disconnect(); }

my $cgi      = CGI->new;
my $input = $cgi->Vars();



my ($errCode, $ck, $user) = user_currentUser($dbh, $cgi);
my $uid     = $user->{'uid'};
my $rid     = $input->{'rid'};
my $tid     = $input->{'tid'};
my $archId  = $input->{'archId'};
my $rOpt    = $input->{'rOpt'};
my $resultId= $input->{'resultId'};
my $filePath= $input->{'filePath'};
my $type    = $input->{'type'};
my $bookId  = $input->{'bookId'};

my $zdbDir = Opals::Context->config('zRoot') .'/'
           . Opals::Context->config('zPort') .'/'
           . 'record' .'/'
           . Opals::Context->config('zDatabase');


my $marcXml="";
 
if($type eq "editRec" || $type eq "hitlist" ){
    $marcXml=getMarcXmlRecord($rid,$zdbDir);
}
elsif($type eq "clone"){
    $marcXml=getMarcXmlRecord($rid,$zdbDir);
    $marcXml =~ s/<controlfield tag="002">.*<\/controlfield>//gi;    
    $marcXml =~ s/<controlfield tag="004">.*<\/controlfield>//gi;    
    $marcXml=cloneRecord($marcXml);
}
elsif($type eq "zImport"){
   $marcXml=getXmlRecFromZimport($dbh,$uid,$resultId);
   $marcXml=createSubfield852hi($marcXml);

}
elsif($type eq "restoreFromArch"){
   ($marcXml,$rid)=getXmlRecordFromArchive($dbh,$archId,$rOpt);
}
elsif($type eq "editTmpl" || $type eq "newFromTmpl"){
    $marcXml=getXmlRecTmpl($dbh,$tid);
}
elsif($type eq "importFromFile" ){
    $marcXml=getXmlFromFile($filePath);

}

if(defined $bookId  && $bookId >0 &&  ($type eq "importFromFile"  || $type eq "zImport")){
    $marcXml =~ s/<controlfield tag="002">.*<\/controlfield>//gi;    
    #$marcXml =~ s/<controlfield tag="004">.*<\/controlfield>//gi;    
    $marcXml = addEbookInfo2Marc($marcXml);
}

if(defined $rid && $rid>0){
    $marcXml =addHoldingStatus($dbh,$rid,$marcXml);
}
print "Content-type: text/xml\n\n";
print $marcXml;


#---------------------------------------------------------------
sub addEbookInfo2Marc{
    my($marcXml)= @_;
    my $marc = Opals::Marc::Record::newFromXml($marcXml);
    # change Descriptive cataloging form in leader to RDA
    # ref http://www.loc.gov/marc/RDAinMARC.html
    my $ldr = $marc->leader;
        substr( $ldr, 18, 1 ) = "i";
        $marc->leader($ldr);

    my $cf = $marc->field('001');
    $cf->update('0');
    $cf = MARC::Field->new( '002', $bookId );
    $marc->insert_fields_ordered( ($cf) );

    my @f035 = $marc->field('035');
    $marc->delete_fields(@f035) if(@f035);

    
    my $sf260_a = $marc->subfield('260',"a")||"";
    my $sf260_b = $marc->subfield('260',"b")||"";
    my $sf260_c = $marc->subfield('260',"c")||"";

    my $f264 = MARC::Field->new(264, ' ', '1', 'a' => $sf260_a, 'b' => $sf260_b, 'c' => $sf260_c);
    my $f336 = MARC::Field->new(336, ' ', '0', 'a' => 'text', '2' => 'rdacontent');
    my $f337 = MARC::Field->new(337, ' ', '0', 'a' => 'computer', '2' => 'rdamedia');
    my $f338 = MARC::Field->new(338, ' ', '0', 'a' => 'online resource', '2' => 'rdacarrier');

  

    my $f852=getDefaultEbook852($dbh);
    my @f852=$marc->field('852');
    if(scalar(@f852)>0){
        foreach my $code(qw(k h i m)){
            $f852->delete_subfield(code=>$code);
            $f852->add_subfields($code=>$marc->subfield( '852',$code));
        }
    }
    $marc->delete_fields(@f852);

    my $f856 = MARC::Field->new(856, '4', '0', '3' => 'Click to view e-book', 'u' => "/ebook/reader/$bookId");
    
    $marc->insert_fields_ordered($f264) if(!$marc->field('264'));
    $marc->insert_fields_ordered($f336) if(!$marc->field('336'));
    $marc->insert_fields_ordered($f337) if(!$marc->field('337'));
    $marc->insert_fields_ordered($f338) if(!$marc->field('338'));
    my @f856_exist = $marc->field('856');
    if(@f856_exist){
        $marc->delete_fields(@f856_exist);
    }

    $marc->insert_fields_ordered($f856);
    $marc->insert_fields_ordered($f852);
    $marc=_updateMarc2Ebook($marc);
    $marcXml = MARC::File::XML::record($marc);
    return $marcXml;

}

#---------------------------------------------------------------
sub _updateMarc2Ebook {
    my ($marc) = @_;
    if ( $marc->leader && length( $marc->leader ) > 8 ) {
        my $ldr = $marc->leader;
        substr( $ldr, 6, 2 ) = "am";
        $marc->leader($ldr);
    }
    my $cf_006 = "m               ";
    if ( $marc->field('006') ) {
        my @f      = $marc->field('006');
        my $cf_006 = $f[0]->data();
        substr( $cf_006, 0, 1 ) = 'm';
        $marc->delete_fields(@f);
    }
    my $cf = MARC::Field->new( '006', $cf_006 );

    $marc->insert_fields_ordered( ($cf) );

    my $cf_007 = "cr      ";
    if ( $marc->field('007') ) {
        my @f      = $marc->field('007');
        my $cf_007 = $f[0]->data();
        substr( $cf_007, 0, 2 ) = 'cr';
        $marc->delete_fields(@f);
    }
    $cf = MARC::Field->new( '007', $cf_007 );
    $marc->insert_fields_ordered( ($cf) );

    if ( $marc->field('008') ) {
        my @f     = $marc->field('008');
        my $cf008 = $f[0]->data();
        if($cf008 eq'' || length($cf008)<23){
            $cf008="960618s1973    xxu           000 0 eng d";
        }
        substr( $cf008, 23, 1 ) = 's';
        $f[0]->update($cf008);
    }

    return $marc;
}


################################################################################
sub getXmlRecordFromArchive{
    my ($dbh,$archid,$resOpt) = @_;
    my $archRec = mxml_retrieveMarcXml_ArchId($dbh,$archid);
    my $rid     =   $archRec->{'rid'};
    my $marcXml =$archRec->{'marcXml'};
       $marcXml =~ s/[\s]*<subfield code="-">.*<\/subfield>//g;

    if($archRec->{'bcReUsedList'}){
        foreach my $i (@{$archRec->{'bcReUsedList'}}){
            $marcXml=delHolding($marcXml,$i->{'bc'});
        }
    }

    if($resOpt eq 'merge'){       
        # From current marc record
        my $xml = getXmlRecord($dbh,$rid);
        $marcXml=mergeHolding($marcXml,$xml);

    }#END if($resOpt eq 'merge')

    return  ($marcXml,$rid);   
}
#------------------------------------------------------------------------------
sub getXmlRecord{
    my ($dbh, $rid) = @_;
    my $xmlMarc="";
    my $config = Opals::Context->config();

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

    open RECORD, "<$path";
    my $line;
    while (<RECORD>) {
        $line = $_;
        if ($line =~ m/<subfield code="-">/) {
            next;
        }
        
        $xmlMarc .= $line;
    }
    close RECORD;
    return  $xmlMarc;   
}
    
#------------------------------------------------------------------------------
sub getMarcXmlRecord{
    my($rid,$zdbDir) =@_;
    my $dir = ceil($rid/1000);
    my $path="$zdbDir/$dir/$rid.xml";
    my $xml="";
    if(-f $path){
        open MARCXML, "<$path";
        my $line="";
        while (<MARCXML>) {
            $line = $_;
            if ($line =~ m/<subfield code="-">/) {
                next;
            }
            $xml .=$line;
        }
        close MARCXML;
    }
    return $xml;


}
#------------------------------------------------------------------------------
sub getXmlRecFromZimport{
    my($dbh,$uid,$resultId) =@_;
    my $xml=srch_getMarcImport($dbh,$uid,$resultId);
    return $xml;
}

#------------------------------------------------------------------------------
sub getXmlRecTmpl{
    my($dbh,$tid) =@_;
    my $tmplMarcRec=srch_templateMarcRecord($dbh,$tid);
    my $xml = $tmplMarcRec->{'content'};

    return $xml;

    
}
sub getXmlFromFile{
    my($filePath) =@_;
    my $xml="";
    #if($filePath -f){
        open FILE ,"<$filePath";
        while(<FILE>){
            $xml .=$_;
        }
    #}
    return $xml;

    
}

#------------------------------------------------------------------------------
sub cloneRecord{
    my ($xmlMarc) = @_;
    my $tmpf852 = "";
    $xmlMarc =~ s/<controlfield tag="001">.*<\/controlfield>/<controlfield tag="001">0<\/controlfield>/gi;    
    while ($xmlMarc =~ s/([\s]*<datafield tag="852" ind1="[\d ]" ind2="[\d ]">\n([\s]*<subfield code="[\w\d]">.*<\/subfield>\n)*[\s]*<\/datafield>\n)//) {
        if($tmpf852 eq ''){
            $tmpf852 =$1;
        }    
    }
    $tmpf852 =~ s/<subfield code="p">.*<\/subfield>/<subfield code="p"><\/subfield>/gi; 
    $xmlMarc =~ s/<\/record>/$tmpf852<\/record>/;

    return $xmlMarc;
}

#------------------------------------------------------------------------------
sub addHoldingStatus{
    my ($dbh,$rid,$xmlMarc) = @_;
    my $newSubFields="";
    my $holdingStats=getBcStatus($dbh,$rid);
    while ($xmlMarc =~ s/([\s]*<datafield tag="852" ind1="[\d ]" ind2="[\d ]">([\s]*<subfield code="[\w\-]">.*<\/subfield>)*[\s]*<\/datafield>)//) {
        my $f852 = $1;
        if ($f852 =~ m/<subfield code="p">(.*)<\/subfield>/i) {
            my $barcode =$1;
            my $statsStr = sprintf("onloan=\"%s\" missing=\"%s\" damaged=\"%s\"", 
                                    $holdingStats->{$barcode}->{'onloan'},
                                    $holdingStats->{$barcode}->{'missing'},
                                    $holdingStats->{$barcode}->{'damaged'});

            $f852 =~ s/<(datafield tag="852" ind1="[\d ]" ind2="[\d ]")>/<$1 $statsStr>/g;
            $newSubFields .= $f852; 
        }
    }
    $xmlMarc =~ s/[\s]*<\/record>/$newSubFields\n<\/record>/;

    return $xmlMarc;
}
#------------------------------------------------------------------------------
sub getBcStatus{
    my($dbh,$rid)=@_;
    my $ret={};
    my $sth=$dbh->prepare("select i.barcode,i.available,l.idloan from opl_item i left outer join opl_loan l
                           on l.barcode=i.barcode && l.dateReturn is null 
                           where i.barcode not regexp '\_\_\_' && i.rid=?");
    my $sth_d=$dbh->prepare("select status from opl_itemstatus where barcode=? order by id desc limit 1");
    $sth->execute($rid);
    while(my ($bc,$avail,$idloan)=$sth->fetchrow_array){
        $ret->{$bc}={onloan=>$idloan>0?'true':'false', 
        missing=>$avail?'false':'true',
        damaged=>'false'};
        $sth_d->execute($bc);
        if(my ($s) =$sth_d->fetchrow_array){
            $ret->{$bc}->{"damaged"}=$s==2?'true':'false';
        }
    }
   
    return $ret;
}
#------------------------------------------------------------------------------

sub delHolding{
    my($marcXml,$bc)=@_;
    my $newSubFields="";
    while ($marcXml =~ s/([\s]*<datafield tag="852" ind1="[\d ]" ind2="[\d ]">([\s]*<subfield code="[\w\-]">.*<\/subfield>)*[\s]*<\/datafield>)//) {
        my $f852 = $1;
        if ($f852 =~ m/<subfield code="p">(.*)<\/subfield>/i) {
            if($bc ne $1){
                $newSubFields .= $f852; 
            }
        }
    }
    $marcXml =~ s/[\s]*<\/record>/$newSubFields\n<\/record>/;
    return $marcXml;

}

#------------------------------------------------------------------------------
sub mergeHolding{
    my($xmlFrom,$xmlTo)=@_;

    my $barcode;
    my $newSubFields="";
    while ($xmlTo =~ s/([\s]*<datafield tag="852" ind1="[\d ]" ind2="[\d ]">([\s]*<subfield code="[\w\-]">.*<\/subfield>)*[\s]*<\/datafield>)//) {
        my $f852 = $1;
        if ($f852 =~ m/<subfield code="p">(.*)<\/subfield>/i) {
            $barcode =$1;
            $newSubFields .= $f852; 
            while ($xmlFrom =~ s/([\s]*<datafield tag="852" ind1="[\d ]" ind2="[\d ]">([\s]*<subfield code="[\w\-]">.*<\/subfield>)*[\s]*<\/datafield>)//) {
                my $tmp852 = $1;
                if ($tmp852 !~ m/<subfield code="p">$barcode<\/subfield>/ ){
                    $newSubFields .= $tmp852 ;
                }
            }
            
        }
    }
    $xmlTo =~ s/[\s]*<\/record>/$newSubFields\n<\/record>/;

    return $xmlTo;
}
#------------------------------------------------------------------------------
sub getDefaultEbook852_bk{
    my ($dbh)=@_;
  my $xml852="";
  my $hasEbookTmpl=1;
  my ($xml) = $dbh->selectrow_array("select  content from opl_template where name regexp 'ebook|e-book' limit 1");

  if(!defined $xml || $xml eq ''){
      $hasEbookTmpl=0;
      ($xml) = $dbh->selectrow_array("select  content from opl_template where name  not regexp 'empty' order by rank limit 1");
  }
  my $df852= getdf852($xml);
  if(!$hasEbookTmpl){
      my $hasSf_k=0;
      foreach my $sf(@{$df852->{'sfList'}}){
          if($sf->{'code'} eq'k'){
              $sf->{'data'}='E-Book';
              $hasSf_k=1;
              last;
          }
      }
      if(!$hasSf_k){
          push @{$df852->{'sfList'}},{code=>'k',data=>'E-Book'};
      }
  }

  return   $df852; 
}
#------------------------------------------------------------------------------
sub getDefaultEbook852{
    my ($dbh)=@_;
  my $xml852      ="";
  my $hasEbookTmpl=1;
  my $id          ="";
  my $sth;
  my ($xml) = $dbh->selectrow_array("select  content from opl_template where name regexp 'ebook|e-book' limit 1");
 
  if(!defined $xml || $xml eq ''){
      $hasEbookTmpl=0;
      ($xml) = $dbh->selectrow_array("select  content from opl_template where name  <>'empty' order by rank limit 1");
              
  }
 
  my $df852= getdf852($xml);
  if(!$hasEbookTmpl){
      my $eTypeId=getEbookItemType($dbh);
      $df852->update('3'=>$eTypeId);
      $df852->update('k'=>'E-Book');
  }
  return   $df852; 
}
#------------------------------------------------------------------------------

sub getdf852{
    my ($xml)=@_;
    my $f852 = undef;
    if($xml =~m/<datafield tag="852" ind1="([\d ])" ind2="([\d ])">(.*?)<\/datafield>/s){
        my $ind1=$1;
        my $ind2=$2;
      my $sf=$3;
      while($sf =~ /<subfield code="([\w])">(.*)<\/subfield>/g){
          if(defined $f852){
              $f852->add_subfields("$1"=>"$2");
          }
          else{
              $f852 =  MARC::Field->new(852,$ind1,$ind2,"$1"=>"$2");
          }
      }
   }
   return $f852;
}
#------------------------------------------------------------------------------
sub insertDataField{
    my ($xml,$df)=@_;
    
    my($tag,$ind1,$ind2,$sfList)=($df->{'tag'},$df->{'ind1'},$df->{'ind2'},$df->{'sfList'});

    my $dfTmpl="\n  <datafield  tag=\"%s\" ind1=\"%s\" ind2=\"%s\">%s\n  </datafield>";
    my $sfTmpl="\n    <subfield code=\"%s\">%s</subfield>";
    my $sf="";
    foreach my $s(@$sfList){
        $sf .= sprintf $sfTmpl,$s->{'code'},$s->{'data'};
    }
    my $dataField= sprintf $dfTmpl,$tag,$ind1,$ind2,$sf;
    my $inserted=0;
    while($xml =~ /([\s]*<datafield tag="(\d\d\d)" ind1="[\d ]" ind2="[\d ]">)/g){
        if($2 gt $tag){
             my $m=$1;
             $xml =~ s/$m/$dataField$m/;
             $inserted=1;
             last;
       }
    }
    if(!$inserted){
        $xml =~ s/<\/record>/$dataField<\/record>/;
    }
    return $xml;
}
#------------------------------------------------------------------------------
sub getEbookItemType{
    my($dbh)=@_;
    my $eType='E-book';
    my $sth=$dbh->prepare("select id from opl_itemType where id regexp 'ebook|e-book'");
    $sth->execute();
    if(my $r=$sth->fetchrow_hashref){
        $eType=$r->{'id'};
    }
    $sth->finish;
    return $eType;
}

#------------------------------------------------------------------------------
sub createSubfield852hi{
    my ($marcXml)=@_;
    my $classificationSystem = Opals::Context->preference('classificationSystem');
    if($classificationSystem && $classificationSystem eq 'LCC'){
        $marcXml=copy050_055abTo852hi($marcXml);
    }
    elsif($classificationSystem eq 'dewey'){
        $marcXml=copy082_090abTo852hi($marcXml);
    }
    return $marcXml;
}

#------------------------------------------------------------------------------
sub copy050_055abTo852hi{
    my ($marcXml)=@_;
    my $marc = Opals::Marc::Record::newFromXml($marcXml);
    my ($h,$i)=('','');
    my $f=$marc->field('050');
    if(!$f){
        $f=$marc->field('055');
    }
    if($f){
        $h = $f->subfield('a');
        $h =~ s/^\s+$//g;
        if($h =~ m/^([a-zA-Z]+)(.*)/){
            $h = "$1 $2";
        }
        $i = $f->subfield('b');
    }
    foreach my $f852 ( $marc->field('852')){
        $f852->update('h'=>$h);
        $f852->update('i'=>$i);
    }
    
    $marcXml= MARC::File::XML::record($marc);
    return $marcXml;
}

#------------------------------------------------------------------------------
sub copy082_090abTo852hi{
    my ($marcXml)=@_;
    my $marc = Opals::Marc::Record::newFromXml($marcXml);
    my $h='';
       $h=$marc->subfield('082','a');
    if(!$h || $h eq ''){
        $h=$marc->subfield('090','a');
    }
    if(defined $h){
        foreach my $f852 ( $marc->field('852')){
            $f852->update('h'=>$h);
        }
    }
    
    $marcXml= MARC::File::XML::record($marc);
    return $marcXml;
}