File Coverage

blib/lib/File/BetweenTree.pm

Criterion	Covered	Total	%
statement	135	146	92.4
branch	53	70	75.7
condition	72	128	56.2
subroutine	8	10	80.0
pod	2	5	40.0
total	270	359	75.2

package File::BetweenTree;

# Copyright (C) 2013 by Mitsuru Yasuda. All rights reserved.
# mail bugs, comments and feedback to [e-mail]

use strict;
use warnings;
use Carp ':DEFAULT', 'confess';
use Fcntl qw(:seek O_RDONLY);

our $VERSION = '1.02';

sub new {
	my ($class, $file, $recsep) = @_;
	my $self;

	$self->{_sep_} = $recsep || ($^O =~ /win32/i) ? "\015\012"
	                           :($^O =~ /mac/i)   ? "\015" : "\012";
	bless($self, $class);
	sysopen $self->{fh}, $file, O_RDONLY or return;
	binmode $self->{fh};

	return $self;
}
sub search {
	my($self,
	   $my_min,
	   $my_max,
	   $mode,
	   $result_limit,
	   $result_offset,
	   $order_by,
	   $col_sep,
	   $col_num,
	  ) = @_;
	$my_max = '' ? $my_min : $my_max;
	$result_limit  ||= 1000;
	$result_offset ||= 0;
	$order_by      ||= 'ASC';
	$col_sep       ||= ',';
	$col_num       ||= 0;
	$mode          ||= 0;

	croak "0 mode, only the number" if
	!$mode && ($my_min =~ /[^\-\.\d]/ || $my_max =~ /[^\-\.\d]/);

	my $read_size = 1 << 12;

	# debug reverse
	if (!$mode && ( $my_min > $my_max )) {
	  ($my_min, $my_max) = ($my_max, $my_min);
	}
	elsif ($mode && ($my_min cmp $my_max) eq 1 ) {
	  ($my_min, $my_max) = ($my_max, $my_min);
	}

	seek $self->{fh}, 0, SEEK_END;
	  my $size = tell $self->{fh};

	$self->{col_sep} = $col_sep;
	$self->{col_num} = $col_num;
	my($row,$tip,$str);

	my $_var = int ($size / 2);
	my $_pos = $_var;
	my $_min = 0;
	my $_top = 0;# minimum of _max
	my $_max = $size;
	while (1) {
	  ($str,$tip,$row)=$self->scoop($_pos);
	  $_var = int ($_var / 2);
	  # want to approach the my_max
	  if ($mode) {
	    if ( ($my_max cmp $str) eq -1 && ( $_max > $_pos ) ) {
	      $_max = $_pos; $self->{_mon_} .= "<=|";
	    } elsif (($my_max cmp $str) eq 1 && ($_top < $_pos)) {
	      $_top = $_pos; $self->{_mon_} .= "=>|";
	    } else { $self->{_mon_} .= "  |" }
	  }
	  else {
	    if ( ($my_max-$str) < 0 && ( $_max > $_pos ) ) {
	      $_max = $_pos; $self->{_mon_} .= "<=|";
	    } elsif (($my_max-$str) > 0 && ($_top < $_pos)) {
	      $_top = $_pos; $self->{_mon_} .= "=>|";
	    } else { $self->{_mon_} .= "  |" }
	  }

	  # adjust the minimum value
	  if (
	    ( $mode && ($my_min cmp $str) < 1 ) ||
	    (!$mode &&  $my_min <=  $str)
	  ) {
	    $self->{_mon_} .= "<- $_pos $_var\n";
	    $_pos -= $_var;
	  }
	  else {
	    $self->{_mon_} .= "-> $_pos $_var | min\n";
	    $_min = $_pos; $_pos += $_var;

	  }

	  last if( $_var < $read_size );#
	}

	# adjust the maximum value
	$_var = int(($_max - $_top) / 2);
	$_pos = $_top + $_var;
	while (1) {
	  ($str,$tip,$row)=$self->scoop($_pos);
	  $_var = int ($_var / 2);
	  if (($mode && ($my_max cmp $str) >= 0
	  || (!$mode &&  $my_max >=  $str))){
	    $_pos += $_var;
	    $self->{_mon_} .= "=>|   $_pos $_var\n";
	  }
	  else {

	    $_max = $_pos + $tip; $_pos -= $_var;
	    $self->{_mon_} .= "<=|   $_pos $_var | max\n";
	  }
	  last if( $_var < $read_size );#
	}

	# Locate The Data From Block
	my (@z, @_add);
	my ($dat, $ll, $_z, $_s, $count, $spare);
	my $t = '';
	my $_sep = '';
	$self->{_mon_} = "roughly_offset_addr:$_min "
	                ."search_length:".($_max-$_min)."\n\n"
	                . $self->{_mon_};

	if ($order_by =~ /DESC/i) {
	  my $read_pos = $_max;
	  while (1) {

	    $count++;

	    $read_pos -= $read_size;
	    if ($read_pos < 0) { $read_size += $read_pos; $read_pos = 0 }

	    seek $self->{fh}, $read_pos, 0;
	    read $self->{fh}, $dat, $read_size;

	    $dat .= $t;
	    @z = reverse split $self->{_sep_}, $dat;
	    shift @z if ($count eq 1 && $_max ne $size );

	    for $ll ( 1 .. $#z ){

	      $_z = shift @z;
	      $_s = (split $col_sep, $_z)[$col_num];

	      unless (!$mode && $_s =~ /[^\-\.\d]/) {
	        push @_add, $_z if ((
	          (!$mode && $my_min <= $_s && $_s <= $my_max ) ||
	          ( $mode && ($my_min cmp $_s) < 1 && ($_s cmp $my_max) < 1 ))
	          && (--$result_offset < 0)
	          && (--$result_limit >= 0));

	        $spare = $_z if(
	        (!$spare && !$mode &&  $my_min >=  $_s) ||
	        (!$spare &&  $mode && ($my_min cmp $_s) >= 0) );
	      }

	    last if $result_limit <= 0;
	    }
	  $t = shift @z;
	  $_s = (split $col_sep, $t)[$col_num] || '';

	  push @_add, $t if(($read_pos eq 0)
	    &&((!$mode && $my_min <= $_s && $_s <= $my_max )
	    ||(  $mode && ($my_min cmp $_s) < 1 && ($_s cmp $my_max) < 1 )));

	  last if ($read_pos <= $_min || $result_limit <= 0);
	  }
	}

	else { # AEC

	  my $read_pos = $_min;
	  my $eof = 1;
	  while (1) {

	    $count++;

	    seek $self->{fh}, $read_pos, 0;
	    read $self->{fh}, $dat, $read_size;

	      $dat = $t . $_sep . $dat;
	     #$_sep = $dat =~  /($self->{_sep_})$/  ? $1 : '';
	      $_sep = $dat =~ s/($self->{_sep_})$// ? $1 : '';

	      @z = split $self->{_sep_}, $dat;
	      shift @z if ($count eq 1 && $_min ne 0);

	    $read_pos += $read_size;
	      $eof = 0 if ($read_pos >= $_max);

	    for $ll ( $eof .. $#z ){

	      $_z = shift @z;
	      $_s = (split $col_sep, $_z)[$col_num];

	      unless (!$mode && $_s =~ /[^\-\.\d]/) {
	        push @_add, $_z if ((
	          ( $mode && ($my_min cmp $_s) < 1 && ($_s cmp $my_max) < 1) ||
	          (!$mode && $my_min <= $_s && $_s <= $my_max ))
	          && (--$result_offset < 0)
	          && (--$result_limit >= 0));

	        $spare = $_z if( # && $#z >= 0
	          ( $mode  && ($my_min cmp $_s) >= 0) ) ||
	          (!$mode  && $my_min >= $_s);
	      }

	      last if $result_limit <= 0;
	    }
	    $t = shift @z;

	    last if
	    ($read_pos >= $_max || $read_pos > $size || $result_limit <= 0);
	  }
	}

	$self->{_mon_} = "file_read:$count " . $self->{_mon_};

	$spare = '' unless defined $spare;
	return @_add ? \@_add : ['NULL', $spare];

}
sub scoop {
	my ($self, $_pos) = @_;
	my ($row, $tip);
	seek $self->{fh}, $_pos, 0; read $self->{fh}, $row, 1024;
	($tip, $row) = split /$self->{_sep_}/, $row; $tip = length($tip)+1;
	my $str = (split($self->{col_sep}, $row))[$self->{col_num}];
	return ($str,$tip,$row);
}
sub mon     {
	"Process:\n-----------------------\n".
	shift->{_mon_};
}
sub DESTROY {
	my $self = shift;
	defined $self->{fh} && close $self->{fh};
}
sub view {
	#
	# viewing by specifying a pointer
	#
	# Example:
	# print $bt->view(0, 1024);
	#
	my ($self, $offset_byts, $length) = @_;
	my $dat;
	seek $self->{fh}, $offset_byts, 0;
	read $self->{fh}, $dat, $length;
	join "\n", split $self->{_sep_}, $dat;
}

__END__