package IsisDB;
use strict;

use Carp;
use Data::Dumper;

BEGIN {
	use Exporter ();
	use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
	$VERSION     = 0.01;
	@ISA         = qw (Exporter);
	#Give a hoot don't pollute, do not export more than needed by default
	@EXPORT      = qw ();
	@EXPORT_OK   = qw ();
	%EXPORT_TAGS = ();

}

=head1 NAME

IsisDB - Read CDS/ISIS database

=head1 SYNOPSIS

  use IsisDB
  my $isis = new IsisDB(
  	isisdb => './cds/cds',
  );

=head1 DESCRIPTION

This module will read CDS/ISIS databases and create hash values out of it.
It can be used as perl-only alternative to OpenIsis module.

=head1 METHODS

=cut

#  my $ORDN;		# Nodes Order
#  my $ORDF;		# Leafs Order
#  my $N;		# Number of Memory buffers for nodes
#  my $K;		# Number of buffers for first level index
#  my $LIV;		# Current number of Index Levels
#  my $POSRX;		# Pointer to Root Record in N0x
#  my $NMAXPOS;		# Next Available position in N0x
#  my $FMAXPOS;		# Next available position in L0x
#  my $ABNORMAL;	# Formal BTree normality indicator

#
# some binary reads
#

sub Read32 {
	my $self = shift;

	my $f = shift || die "Read32 needs file handle";
	read($$f,$b,4) || die "can't read 4 bytes from $$f from position ".tell($f);
	return unpack("l",$b);
}

=head2 new

Open CDS/ISIS database

 my $isis = new IsisDB(
 	isisdb => './cds/cds',
	read_fdt => 1,
	debug => 1,
 );

Options are described below:

=over 5

=item isisdb

Prefix path to CDS/ISIS. It should contain full or relative path to database
and common prefix of C<.FDT>, C<.MST>, C<.CNT>, C<.XRF> and C<.MST> files.

=item read_fdt

Boolean flag to specify if field definition table should be read. It's off
by default.

=item debug

Dump a C<lot> of debugging output.

=back

It will also set C<$isis-E<gt>{'maxmfn'}> which is maximum MFN stored in database.

=cut

sub new {
	my $class = shift;
	my $self = {};
	bless($self, $class);

	$self->{isisdb} = {@_}->{isisdb} || croak "new needs database name as argument!";

	$self->{debug} = {@_}->{debug};

	# if you want to read .FDT file use read_fdt argument when creating class!
	if ({@_}->{read_fdt} && -e $self->{isisdb}.".FDT") {

		# read the $db.FDT file for tags
		my $fieldzone=0;

		open(fileFDT, $self->{isisdb}.".FDT") || croak "can't read '$self->{isisdb}.FDT': $!";

		while (<fileFDT>) {
			chomp;
			if ($fieldzone) {
				my $name=substr($_,0,30);
				my $tag=substr($_,50,3);

				$name =~ s/\s+$//;
				$tag =~ s/\s+$//;

				$self->{'TagName'}->{$tag}=$name;  
			}

			if (/^\*\*\*/) {
				$fieldzone=1;
			}
		}
		
		close(fileFDT);
	}

	# Get the Maximum MFN from $db.MST

	open(fileMST,$self->{isisdb}.".MST") || croak "can't read '$self->{isisdb}.MST': $!";

	# MST format:	(* = 32 bit signed)
	# CTLMFN*	always 0
	# NXTMFN*	MFN to be assigned to the next record created
	# NXTMFB*	last block allocated to master file
	# NXTMFP	offset to next available position in last block
	# MFTYPE	always 0 for user db file (1 for system)
	seek(fileMST,4,0);
	$self->{'NXTMFN'}=$self->Read32(\*fileMST) || carp "NXTNFN is zero";

	# save maximum MFN
	$self->{'maxmfn'} = $self->{'NXTMFN'} - 1;

	close(fileMST);

	# Get the index information from $db.CNT
   
	open(fileCNT, $self->{isisdb}.".CNT") || croak "can't read '$self->{isisdb}.CNT': $!";

	# There is two 26 Bytes fixed lenght records

	#  0: IDTYPE	BTree type				16
	#  2: ORDN	Nodes Order				16
	#  4: ORDF	Leafs Order				16
	#  6: N		Number of Memory buffers for nodes	16
	#  8: K		Number of buffers for first level index	16
	# 10: LIV	Current number of Index Levels		16
	# 12: POSRX*	Pointer to Root Record in N0x		32
	# 16: NMAXPOS*	Next Available position in N0x		32
	# 20: FMAXPOS*	Next available position in L0x		32
	# 24: ABNORMAL	Formal BTree normality indicator	16
	# length: 26 bytes

	sub unpack_cnt {
		my $self = shift;

		my @flds = qw(ORDN ORDF N K LIV POSRX NMAXPOS FMAXPOS ABNORMAL);

		my $buff = shift || return;
		my @arr = unpack("ssssssllls", $buff);

		my $IDTYPE = shift @arr;
		foreach (@flds) {
			$self->{$IDTYPE}->{$_} = abs(shift @arr);
		}
	}

	my $buff;
	read(fileCNT, $buff, 26);
	$self->unpack_cnt($buff);

	read(fileCNT, $buff, 26);
	$self->unpack_cnt($buff);


	close(fileCNT);

	print Dumper($self) if ($self->{debug});

	$self ? return $self : return undef;
}

=head2 GetMFN

Read record with selected MFN

  my $rec = $isis->GetMFN(55);

Returns hash with keys which are field names and values are unpacked values
for that field.

=cut

sub GetMFN {
	my $self = shift;

	my $mfn = shift || croak "GetMFN needs MFN as argument!";

	print "GetMFN: $mfn\n" if ($self->{debug});

	open(fileXRF, $self->{isisdb}.".XRF") || croak "can't open '$self->{isisdb}.XRF': $!";

	# XXX check this?
	my $mfnpos=($mfn+int(($mfn-1)/127))*4;

	print "seeking to $mfnpos in file '$self->{isisdb}.XRF'\n" if ($self->{debug});
	seek(fileXRF,$mfnpos,0);

	# read XRFMFB abd XRFMFP
	my $pointer=$self->Read32(\*fileXRF);

	my $XRFMFB = int($pointer/2048);
	my $XRFMFP = $pointer - ($XRFMFB*2048);

	print "XRFMFB: $XRFMFB XRFMFP: $XRFMFP\n" if ($self->{debug});

	# XXX fix this to be more readable!!
	# e.g. (XRFMFB - 1) * 512 + XRFMFP

	my $offset = $pointer;
	my $offset2=int($offset/2048)-1;
	my $offset22=int($offset/4096);
	my $offset3=$offset-($offset22*4096);
	if ($offset3>512) {
		$offset3=$offset3-2048;
	}
	my $offset4=($offset2*512)+$offset3;

	print "$offset - $offset2 - $offset3 - $offset4\n" if ($self->{debug});

	close(fileXRF);

	# Get Record Information

	open(fileMST, $self->{isisdb}.".MST") || croak "can't open '$self->{isisdb}.MST': $!";

	seek(fileMST,$offset4,0);

	my $value=$self->Read32(\*fileMST);

	if ($value!=$mfn) {
print ("Error: The MFN:".$mfn." is not found in MST(".$value.")");    
		return -1;	# XXX deleted record?
	}

#	$MFRL=$self->Read16($fileMST);
#	$MFBWB=$self->Read32($fileMST);
#	$MFBWP=$self->Read16($fileMST);
#	$BASE=$self->Read16($fileMST);
#	$NVF=$self->Read16($fileMST);
#	$STATUS=$self->Read16($fileMST);

	my $buff;
	read(fileMST, $buff, 14);

	my ($MFRL,$MFBWB,$MFBWP,$BASE,$NVF,$STATUS) = unpack("slssss", $buff);

	print "MFRL: $MFRL MFBWB: $MFBWB MFBWP: $MFBWP BASE: $BASE NVF: $NVF STATUS: $STATUS\n" if ($self->{debug});

	# Get Directory Format

	my @FieldPOS;
	my @FieldLEN;
	my @FieldTAG;

	for (my $i = 0 ; $i < $NVF ; $i++) {

#		$TAG=$self->Read16($fileMST);
#		$POS=$self->Read16($fileMST);
#		$LEN=$self->Read16($fileMST);

		read(fileMST, $buff, 6);
		my ($TAG,$POS,$LEN) = unpack("sss", $buff);

		print "TAG: $TAG POS: $POS LEN: $LEN\n" if ($self->{debug});

		# The TAG does not exists in .FDT so we set it to 0.
		#
		# XXX This is removed from perl version; .FDT file is updated manually, so
		# you will often have fields in .MST file which aren't in .FDT. On the other
		# hand, IsisMarc doesn't use .FDT files at all!

		#if (! $self->{TagName}->{$TAG}) {
		#	$TAG=0;
		#}

		push @FieldTAG,$TAG;
		push @FieldPOS,$POS;
		push @FieldLEN,$LEN;
	}

	# Get Variable Fields

	delete $self->{record};

	for (my $i = 0 ; $i < $NVF ; $i++) {
		my $rec;
		read(fileMST,$rec,$FieldLEN[$i]);
		push @{$self->{record}->{$FieldTAG[$i]}}, $rec;
	}
	close(fileMST);

	# The record is marked for deletion
	if ($STATUS==1) {
		return -1;
	}

	print Dumper($self) if ($self->{debug});

	return $self->{'record'};
}

=head2 to_ascii

Dump ascii output of selected MFN

  print $isis->to_ascii(55);

=cut

sub to_ascii {
	my $self = shift;

	my $mfn = shift || croak "need MFN";

	my $rec = $self->GetMFN($mfn);

print STDERR Dumper($rec);

	my $out = "0\t$mfn";

	foreach my $f (sort keys %{$rec}) {
		$out .= "\n$f\t".join("\n$f\t",@{$self->{record}->{$f}});
	}

	$out .= "\n";

	return $out;
}

################# old cruft which is not ported from php to perl

=begin php

  # Load the dictionary from the $db.L0x files.
  # Not usefull Yet
  
  sub LoadDictionary()
  {
    $fileL01=fopen($self->{isisdb}.".L01","r");
    rewind($fileL01);  

    do
    {

      $POS=$self->Read32($fileL01);
      $OCK=$self->Read16($fileL01);
      $IT=$self->Read16($fileL01);
      $PS=$self->Read32($fileL01);
print "<br>PS:".$PS." ".$self->{ORDF}->{1}." ";
      for ($i=0;$i<$OCK;$i++)
      {
        $KEY=fread($fileL01,10);
       
        print $KEY." ### ";

        $INFO1=$self->Read32($fileL01);
        $INFO2=$self->Read32($fileL01);

        #L01Key->{$key}=array($INFO1,$INFO2);
      }
    
      rewind($fileL01);
      $offset=($PS-1)*(12+$self->{ORDF}->{1}*18*2);
      fseek($fileL01,$offset);

    } While (!feof($fileL01));

    fclose($fileL01);
  }

  # self function search through the tree and returns an array of pointers to IFP
  # The function must be recursive

  sub SearchTree($search,$fileNB,$PUNT)
  {       
      $offset=(($PUNT-1)*(8+2*$self->{ORDN}->{1}*14)); 

        rewind($fileNB1); 

        fseek($fileNB,$offset);
 
        $POS=$self->Read32($fileNB);
        $OCK=$self->Read16($fileNB);
        $IT=$self->Read16($fileNB);

#print "<br>".$POS." - ".$OCK." - ".$IT;

        $OLDPUNT=$POS;
        $j=0;
        for ($i=0;$i<$OCK;$i++)
        {
          $KEY=fread($fileNB,10);
       
          $PUNT=$self->Read32($fileNB);

#print " ## ".chop($KEY)."(".$PUNT."-".$OLDPUNT.") ## "; 

          If (strcmp($search,chop($KEY))<0)
          {
            break;
          }
          $OLDPUNT=$PUNT;   
        }        
#print $OLDPUNT; 
        Return $OLDPUNT;
  }

  # Search ISIS for record containing search
  # Return a sorted array of MFN

  sub Search($search)
  {

  $search=strtoupper($search);
#print "Searching....".$search." - ".$self->{POSRX}->{1}."<br>";
    # first search .x01
    

    # Search in .N01  


    $fileN01=fopen($self->{isisdb}.".N01","r");
    $offset=(($self->{POSRX}->{1}-1)*(8+2*$self->{ORDN}->{1}*14));

      do
      {
        rewind($fileN01); 

        fseek($fileN01,$offset);
 
        $POS=$self->Read32($fileN01);
        $OCK=$self->Read16($fileN01);
        $IT=$self->Read16($fileN01);

#print "<br>".$POS." - ".$OCK." - ".$IT;

        $OLDPUNT=$POS;
        for ($i=0;$i<$OCK;$i++)
        {
          $KEY=fread($fileN01,10);
       
          $PUNT=$self->Read32($fileN01);

#print " ## ".chop($KEY)."(".$PUNT."-".$OLDPUNT.") ## "; 

          If (strcmp($search,chop($KEY))<0)
          {
            break;
          }
          $OLDPUNT=$PUNT;   
        }
        $offset=(($OLDPUNT-1)*(8+2*$self->{ORDN}->{1}*14));      
      } while ($OLDPUNT>0);
#print $OLDPUNT; 


    fclose($fileN01);

    # Now look for records in .L01 file
    $fileL01=fopen($self->{isisdb}.".L01","r");
    rewind($fileL01);

    $offset=(-$OLDPUNT-1)*(12+$self->{ORDF}->{1}*18*2);
    fseek($fileL01,$offset);

    $POS=$self->Read32($fileL01);
    $OCK=$self->Read16($fileL01);
    $IT=$self->Read16($fileL01);
    $PS=$self->Read32($fileL01);
#print "<br>POS:".$POS." ".$self->{ORDF}->{1}." ";
    for ($i=0;$i<$OCK;$i++)
    {
      $KEY=fread($fileL01,10);
       
#print $KEY." ### ";

      $INFO1=$self->Read32($fileL01);
      $INFO2=$self->Read32($fileL01);

      If (strcmp($search,chop($KEY))==0)
      {
        break;
      }
    }    

    fclose($fileL01);

#print $INFO1."--".$INFO2;

    # Now look in .IFP for the MFN
    $fileIFP=fopen($self->{isisdb}.".IFP","r");
    rewind($fileIFP);
    $offset=($INFO1-1)*512+($INFO2*4);
    fseek($fileIFP,$offset);   
 
    $IFPBLK=$self->Read32($fileIFP);

    $IFPNXTB=$self->Read32($fileIFP);
    $IFPNXTP=$self->Read32($fileIFP);
    $IFPTOTP=$self->Read32($fileIFP);
    $IFPSEGP=$self->Read32($fileIFP);
    $IFPSEGC=$self->Read32($fileIFP);


#print "<br>IFP:".$IFPBLK." # ".$IFPNXTB." - ".$IFPNXTP." - ".$IFPTOTP." - ".$IFPSEGP." - ".$IFPSEGC;

    rewind($fileIFP);
    $offset=($INFO1-1)*512+24+($INFO2*4);
    fseek($fileIFP,$offset);    
    
    $j=24+($INFO2*4);
    $k=0;
    $l=1;
    $OLDPMFN="";
    for ($i=0;$i<$IFPSEGP;$i++)
    {
      $B1=$self->Read8($fileIFP);
      $B2=$self->Read8($fileIFP);
      $B3=$self->Read8($fileIFP);
      $B4=$self->Read8($fileIFP);
      $B5=$self->Read8($fileIFP);
      $B6=$self->Read8($fileIFP);
      $B7=$self->Read8($fileIFP);
      $B8=$self->Read8($fileIFP);

      $PMFN=$B1*65536+$B2*256+$B3;
      $PTAG=$B4*256+$B5;
      $POCC=$B6;
      $PCNT=$B7*256+$B8;

      if ($OLDPMFN!=$PMFN)
      {
        if ($PMFN!=0)
        {
          $self->{MFNArray}->{$l}=$PMFN;
          $OLDPMFN=$PMFN;
          $l+=1;
        }
      }

      $j=$j+8;
#print "<br>".$PMFN."-".$PTAG." - ".$POCC." - ".$PCNT;
#print "@@".$j."@@@@";
      if ($j>=504)
      {
        if ($IFPNXTB==0 && $IFPNXTP==0)
        {
          $k=$k+1;
          rewind($fileIFP);
          $offset=($INFO1-1+$k)*512;  
          fseek($fileIFP,$offset);      
          $B=$self->Read32($fileIFP);
#print "<br>-".$B."-<br>";
          $j=0;
        } else
        {
          rewind($fileIFP);
          $offset=($IFPNXTB-1)*512;  
          fseek($fileIFP,$offset);

	  $OLDIFPNXTB=$IFPNXTB;
	  $OLDIFPNXTP=$IFPNXTP;

          $IFPBLK=$self->Read32($fileIFP);

          $IFPNXTB=$self->Read32($fileIFP);
          $IFPNXTP=$self->Read32($fileIFP);
          $IFPTOTP=$self->Read32($fileIFP);
          $IFPSEGP=$self->Read32($fileIFP);
          $IFPSEGC=$self->Read32($fileIFP);

          rewind($fileIFP);
          $offset=($OLDIFPNXTB-1)*512+24+($OLDIFPNXTP*4);
          fseek($fileIFP,$offset);    
    
          $j=24+($OLDIFPNXTP*4);
          $k=0;
          $j=0;
        }
      }

    }    
    fclose($fileIFP);
    return $l-1;
  }

=cut

#
# XXX porting from php left-over:
#
# do I *REALLY* need those methods, or should I use
# $self->{something} directly?
#
# Probably direct usage is better!
#

sub GetFieldName {
	my $self = shift;
	return $self->{FieldName};
}

sub GetTagName {
	my $self = shift;
	return $self->{TagName};
}

sub GetFieldTag {
	my $self = shift;
	return $self->{FieldTAG};
}

sub GetNextMFN {
	my $self = shift;
	return $self->{NXTMFN};
}

sub GetMFNArray {
	my $self = shift;
	return $self->{MFNArray};
}
=begin php

  sub Read32($fileNB)
  {
    $B1=ord(fread($fileNB,1));
    $B2=ord(fread($fileNB,1));
    $B3=ord(fread($fileNB,1));
    $B4=ord(fread($fileNB,1));

    if ($B4<=128)
    {
      $value=$B1+$B2*256+$B3*65536+$B4*16777216;
    } else
    {
      $value=$self->Not8($B1)+$self->Not8($B2)*256+$self->Not8($B3)*65536+$self->Not8($B4)*16777216;
      $value=-($value+1);
    }
#    print "(".$B1.",".$B2.",".$B3.",".$B4.":".$value.")";

    return $value;   
  }

  sub Read24($fileNB)
  {
    $B1=ord(fread($fileNB,1));
    $B2=ord(fread($fileNB,1));
    $B3=ord(fread($fileNB,1));

    $value=$B1+$B2*256+$B3*65536;

#    print "(".$B1.",".$B2.",".$B3.":".$value.")";

    return $value;   
  }

  sub Read16($fileNB)
  {
    $B1=ord(fread($fileNB,1));
    $B2=ord(fread($fileNB,1));

    $value=$B1+$B2*256;
#    print "(".$B1.",".$B2.":".$value.")";

    return $value;  
  }

  sub Read8($fileNB)
  {
    $B1=ord(fread($fileNB,1));

    $value=$B1;
#    print "(".$value.")";

    return $value;  
  }

  sub Not8($value)
  { 
    $value=decbin($value);
    if (strlen($value)<8)
    {
      $buffer="";
      for($i=0;$i<(8-strlen($value));$i++)
      {
        $buffer.="0";
      }
      $value=$buffer.$value;
    }
    $value=ereg_replace("0","3",$value);
    $value=ereg_replace("1","0",$value);
    $value=ereg_replace("3","1",$value); 
    $value=bindec($value);
    return $value;
  }
}

=cut

1;
__END__

=head1 BUGS

This module has been very lightly tested. Use with caution and report bugs.

=head1 AUTHOR

	Dobrica Pavlinusic
	CPAN ID: DPAVLIN
	dpavlin@rot13.org
	http://www.rot13.org/~dpavlin/

This module is based heavily on code from LIBISIS.PHP - Library to read ISIS files V0.1.1
written in php and (c) 2000 Franck Martin - <franck@sopac.org> released under LGPL.

=head1 COPYRIGHT

This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the
LICENSE file included with this module.


=head1 SEE ALSO

L<http://www.openisis.org|OpenIsis>, perl(1).

