#!/usr/bin/perl
#
# $Header: /Users/claude/fuzz/lib/Genezzo/SpaceMan/RCS/SMExtent.pm,v 1.36 2006/10/19 09:20:13 claude Exp claude $
#
# copyright (c) 2006 Jeffrey I Cohen, all rights reserved, worldwide
#
#
package Genezzo::SpaceMan::SMExtent;

use strict;
use warnings;

use Carp;
use Genezzo::Util;
use Genezzo::Row::RSBlock;
use Genezzo::SpaceMan::SMFile;

BEGIN {
    use Exporter   ();
    our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);

    # set the version for version checking
#    $VERSION     = 1.00;
    # if using RCS/CVS, this may be preferred
    $VERSION = do { my @r = (q$Revision: 1.36 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker

    @ISA         = qw(Exporter);
    @EXPORT      = ( ); # qw(&NumVal);
    %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],

    # your exported package globals go here,
    # as well as any optionally exported functions
#    @EXPORT_OK   = qw($Var1 %Hashit &func3 &func5);
    @EXPORT_OK   = (); 

}

our $GZERR = sub {
    my %args = (@_);

    return 
        unless (exists($args{msg}));

    if (exists($args{self}))
    {
        my $self = $args{self};
        if (defined($self) && exists($self->{GZERR}))
        {
            my $err_cb = $self->{GZERR};
            return &$err_cb(%args);
        }
    }

    my $warn = 0;
    if (exists($args{severity}))
    {
        my $sev = uc($args{severity});
        $sev = 'WARNING'
            if ($sev =~ m/warn/i);

        # don't print 'INFO' prefix
        if ($args{severity} !~ m/info/i)
        {
            printf ("%s: ", $sev);
            $warn = 1;
        }

    }
    # XXX XXX XXX
    print __PACKAGE__, ": ",  $args{msg};
#    print $args{msg};
#    carp $args{msg}
#      if (warnings::enabled() && $warn);
    
};


sub _init
{
    #whoami;
    #greet @_;
    my $self      =  shift;
    my %required  =  (
                      filename   => "no filename !",
                      numbytes   => "no numbytes !",
                      numblocks  => "no numblocks !",
                      bufcache   => "no bufcache !",
                      filenumber => "no filenumber !",
                      tablename  => "no tablename !",
                      object_id  => "no object id !",
                      object_type => "no object type"
                      );
    
    my %args = (@_);

    return undef
        unless (Validate(\%args, \%required));

    $self->{filename} = $args{filename}; # save for error reporting
    $self->{object_type} = $args{object_type}; # use type to determine
                                               # storage allocation

    my $smf = Genezzo::SpaceMan::SMFile->new($args{filename},
                                             $args{numbytes},
                                             $args{numblocks},
                                             $args{bufcache},
                                             $args{filenumber});

    return undef
        unless (defined($smf));

    $self->{smf} = $smf;

    my %nargs   = (tablename  => $args{tablename},
                   object_id  => $args{object_id}
                   );
    
    my $blockno = $self->{smf}->firstblock(%nargs);

    if (defined($blockno))
    {
        $self->{first_seghdr}   = $blockno;
        $self->{current_seghdr} = $blockno;

        # need to call this way because SELF isn't BLESSed yet...
        my $rowd = _get_rowd($self, $blockno);
        unless (defined($rowd))
        {
            return (undef);
        }

        # get meta data for the segment header
        my $row  = $rowd->_get_meta_row("X1A");

# XXX XXX: remove seghdr 
        # if the current hdr is full...
        while (defined($row) && (scalar(@{$row}) > 0)
               && ($row->[0] =~ m/F/))
        {
            # overflow header is listed in x1b
            my $row2 = $rowd->_get_meta_row("X1B");

            # XXX XXX: need some error checking here...
            last
                unless (defined($row2) && (scalar(@{$row2} > 2)));

            my $nexthdr = $row2->[-1]; # check the end of the array

            my @ggg = $self->_split_extent_descriptor($nexthdr);

            last 
                unless (scalar(@ggg) > 1);

            # advance to the next header...
            $blockno = $ggg[0];
            $self->{current_seghdr} = $blockno;

# XXX XXX            print "advance to next header, block $blockno\n";

            $rowd = _get_rowd($self, $blockno);
            unless (defined($rowd))
            {
                return (undef);
            }

            # get meta data for the segment header
            $row  = $rowd->_get_meta_row("X1A");

        } # end while
        

##        print Data::Dumper->Dump([$row]), "\n";
 
        # need to call this way because SELF isn't BLESSed yet...       
        $rowd = _get_rowd($self, 0);
        unless (defined($rowd))
        {
            return (undef);
        }
    }

    return 1;

}

sub new 
{
    my $invocant = shift;
    my $class = ref($invocant) || $invocant ; 
    my $self = { };
    
#    whoami @_;
    my %args = (@_);
    return undef
        unless (_init($self,%args));

    if ((exists($args{GZERR}))
        && (defined($args{GZERR}))
        && (length($args{GZERR})))
    {
        # NOTE: don't supply our GZERR here - will get
        # recursive failure...
        $self->{GZERR} = $args{GZERR};
    }

    my $blessref = bless $self, $class;

    return $blessref;

} # end new

sub _get_rowd # private
{
    my ($self, $blockno) = @_;

    $blockno = 0
        unless (defined($blockno));

    my $bc = $self->{smf}->{bc};

    unless ($self->{smf}->_tiefh($bc, $blockno))
    {
        whisper "bad fh tie";
        my $fn = $self->{filename};
        my $msg = "bad fh tie for block $blockno, file $fn\n";
        my %earg = (self => $self, msg => $msg,
                    severity => 'warn');
        
        &$GZERR(%earg)
            if (defined($GZERR));

        return (undef);
    }
    my $fileheader = $bc->{fileheader};
    
    my $rowd = $fileheader->{RealTie};

    unless (defined($rowd))
    {
        whisper "bad fh real tie";
        my $msg = "bad fh real tie\n";
        my %earg = (self => $self, msg => $msg,
                    severity => 'warn');
        
        &$GZERR(%earg)
            if (defined($GZERR));

    }
    return $rowd;
}

# for Tablespace::TSGrowFile
sub _file_info
{
    my $self = shift;
    return $self->{smf}->_file_info(@_);
}

# for Tablespace::TSGrowFile
sub SMGrowFile
{
    my $self = shift;
    return $self->{smf}->SMGrowFile(@_);
}

# truncate a number to a certain length, or pad with leading zeros
# Assumes $num is non-negative
sub _trunc_or_pad
{
    use POSIX ; #  need some rounding

    my ($num, $padlen) = @_;

    # Note: outi must be an integer -- round down
    my $outi = POSIX::floor($num);

    if ($padlen == 2)
    {
        # common case
        $outi = 99
            if ($outi > 99);
    }
    else
    {
        # XXX XXX: need to test this...
        $outi = (("9"x$padlen) + 0)
            if ($outi > (10**$padlen));
    }
    $outi = 0
        if ($outi < 1);

    # kind of redundant...
    $outi = substr($num, 0, $padlen)
        if (length($num) > $padlen);

    if (length($outi) < $padlen)
    {
        if ($padlen == 2)
        {
            # common case
            $outi = "0".$outi;
        }
        else
        {
            # XXX XXX: need to test this...
            my $plen = $padlen - length($outi);
            $outi = ("0"x$plen).$outi
        }
    }
    return $outi;
}

sub _make_extent_descriptor
{
    my ($self, $blockno, $extent_size, $total_pctused, 
        $alloc_pctused, $num_free) = @_;

    $total_pctused = 0 unless (defined($total_pctused));

    $total_pctused = _trunc_or_pad($total_pctused, 2);

    $alloc_pctused = $total_pctused unless (defined($alloc_pctused));
    $alloc_pctused = _trunc_or_pad($alloc_pctused, 2);

    $num_free = $extent_size unless (defined($num_free));
    my $free_len = 0; # set to zero for zero free
    $free_len = length($num_free)  # number of digits
        if ($num_free > 0);
    $free_len = 9 if ($free_len > 9);

    return join(':', $blockno, $extent_size, $total_pctused,
                $alloc_pctused, $free_len
                );
}

sub _split_extent_descriptor
{
    my ($self, $extent_desc_str) = @_;

    return split(':', $extent_desc_str);
}

sub _dump_extent_descriptor
{
    my $xdsc = shift @_;
    my $outi;

    my @ggg = _split_extent_descriptor("fakeself", $xdsc);

    unless (scalar(@ggg) > 4)
    {
        $outi = 'invalid descriptor: $xdsc\n';
        return $outi;
    }

    my ($ext_hdr_block, $extent_size, $total_pctused,
        $alloc_pctused, $free_len) = @ggg;

    $outi .= "starts: block number $ext_hdr_block, length: $extent_size\n";
    $outi .= "$total_pctused % of total used, $alloc_pctused % of allocated blocks used\n";
    if (0 == $free_len)
    {
        $outi .= "0 free blocks \n";
    }
    else 
    {
        my $freeb = "0" x $free_len;

        $outi .= "less than 1" . $freeb . " free blocks\n";
    }
    return $outi;
}
sub _meta_row_dump_X1A
{
    my ($self, $v1) =  @_;

    my @val = @{$v1};
# XXX XXX: remove seghdr
#    my $seghdr = shift @val;
    my $vfflag = shift @val;

    my $outi = "Extent Header: ";
    $outi .= (($vfflag =~ m/v/i) ? '[V]acant ' : '[F]ull ');

    $outi .= "\n";
 
    for my $xd (@val)
    {
        $outi .= _dump_extent_descriptor($xd);
    }

    $outi .= "\n";

    return $outi;

}
sub _meta_row_dump_X1B
{
    my ($self, $v1) =  @_;

    my @val = @{$v1};

# XXX XXX: remove segnxt
#    my $segnxt = shift @val;
    my $first_seghdr = shift @val;
    my $prev         = shift @val;

    my $outi;
    $outi .= "First seghdr at $first_seghdr, previous header at block $prev\n";

    if (scalar(@val))
    {
        $outi .= "Next at:\n";
    }


    for my $xd (@val)
    {
        $outi .= _dump_extent_descriptor($xd);
    }

    return $outi;
}
sub _meta_row_dump_XHA
{
    my ($self, $v1) =  @_;

    my @val = @{$v1};

    my $seghdr = shift @val;
    my $extsiz = shift @val;
    my $bvec   = shift @val;

    my $outi = "Segment header at block $seghdr,\n current extent size $extsiz blocks\n";
    my $bvstr = unpack("b*",$bvec);
    $outi .= "bitvec: $bvstr\n";

    my @pct = $self->_xhdr_bv_to_pct($bvec, $extsiz);
    my $extent_stats  = shift @pct;

    $outi .= "block usage:\n";
    $outi .= join('% ', @pct) . "% \n";
    return $outi;

}
sub _meta_row_dump_XHP
{
    my ($self, $v1) =  @_;

    my @val = @{$v1};

    my $offset = shift @val;
    my $pctused = shift @val;

    $pctused = $pctused * 10;

    my $outi = "basic block info - offset: $offset, $pctused" . "% used\n";

    return $outi;
}


sub _create_segment_hdr
{
    my ($self, $rowd, $blockno, $extent_size, $parent, $first_seghdr) = @_;

    return undef
        unless (defined($rowd));

    # X1A (eXtent FIRST _A_):
    #   1 at start of segment (segment header/first extent), and 1 for
    #   each overflow block of the segment header.  The segment header
    #   starts as the first block of the first extent, and each
    #   overflow block is a "subheader".
    #
    #   contains vacant/full flag, which indicates whether this piece
    #   of the segment header has the maximum number of extent listings,
    #   followed by a list of extent descriptors.

    $rowd->_set_meta_row("X1A", 
                         [
# XXX XXX: remove seghdr
#                          "seghdr", 
                          "V", # [V]acant, vs [F]ull
                          $self->_make_extent_descriptor(
                                                         $blockno, 
                                                         $extent_size, 
                                                         '0.0')
                          ]
                         );

    unless (defined($parent))
    {
        # should only be for very first allocated extent
        $self->{first_seghdr}   = $blockno;
        $self->{current_seghdr} = $blockno;
        $parent                 = $blockno;
        $first_seghdr           = $blockno;
    }

    # X1B (eXtent FIRST _B_):
    #   1 at start of segment (segment header/first extent), and 1 for
    #   each overflow block of the segment header.
    #
    #   Initially, just has the block number for the first segment
    #   header and the previous segment header (which is just the
    #   current blockno if this block is the very first).  However,
    #   once the first extent is allocated for this piece of the
    #   segment header, then this extent is designated as the segment
    #   header overflow block, and the extent descriptor is appended
    #   to the X1B row.
    #
    #   Note that the extent descriptor should describe the overall
    #   status of all the extents managed beneath the overflow block,
    #   not just the first extent in that block.

    # no "next" segment header, just list parent piece of seg hdr
    $rowd->_set_meta_row("X1B", [
# XXX XXX: remove segnxt
#                                 "segnxt", 
                                 $first_seghdr,
                                 $parent]);

    return $rowd;
} # end _create_segment_hdr

sub _add_extent_to_segment_hdr
{
    my ($self, $blockno, $extent_size) = @_;

#    whisper "update seg hdr\n";

    my ($row, $row2, $rowd, $val);

  L_bigW:
    while (1)
    {
        $rowd = $self->_get_rowd($self->{current_seghdr});
        unless (defined($rowd))
        {
            return (undef);
        }
        # get meta data for the segment header
        $row2 = $rowd->_get_meta_row("X1B");

        # if current segment header does not have a child for overflow,
        # then the new extent is allocated for that purpose
        if (defined($row2) && (scalar(@{$row2}) < 3)) # XXX XXX: remove segnxt
        {
            # X1B (eXtent FIRST _B_):
            #
            # add the extent descriptor for the overflow block.
            #
            # Note that the "extent_size" in this descriptor can vary,
            # since it's an approximation of the total space allocated
            # under the subheader.  However, we can keep the length of
            # the extent_size approximation a constant 4 characters
            # using standard space suffixes, eg: 100K, 1.2M, .99G
            push @{$row2}, $self->_make_extent_descriptor($blockno, 
                                                          $extent_size, 
                                                          '0.0');

            $rowd->_set_meta_row("X1B", $row2);

            $rowd = $self->_get_rowd($blockno);
            unless (defined($rowd))
            {
                return (undef);
            }
            
            my $parent       = $self->{current_seghdr};
            my $first_seghdr = $self->{first_seghdr};

            # create the new segment subheader in the new extent
            $self->_create_segment_hdr($rowd, 
                                       $blockno, $extent_size, 
                                       $parent,
                                       $first_seghdr);

            $rowd = $self->_get_rowd($self->{current_seghdr});
            unless (defined($rowd))
            {
                return (undef);
            }
        } # end if make overflow

        $row = $rowd->_get_meta_row("X1A");

        unless (defined($row))
        {
            croak "serious error 4!";
            exit;
        }

        my $new_ext = $self->_make_extent_descriptor($blockno,
                                                     $extent_size, 
                                                     '0.0');

        push @{$row}, $new_ext;


# XXX XXX XXX: overflow test? but how to check?
        if (0 && scalar(@{$row}) > 4)
        {
#            print "overflow to next header\n";
            $val = undef;
        }
        else
        {

            $val = $rowd->_set_meta_row("X1A", $row);
        }
        
        ########################################
        #  end here if set meta row correctly  #
        ########################################
        last L_bigW
            if (defined($val));

        # else we set the current header as full, and use the next
        pop @{$row};
# XXX XXX: remove seghdr 
        $row->[0] = 'F' ; # row is full
        $val = $rowd->_set_meta_row("X1A", $row);
        unless (defined($val))
        {
            # should have been able to just update status flag
            croak "serious error 1!";
            exit;
        }
        
        # find the overflow header
        $row2 = $rowd->_get_meta_row("X1B");
        unless (defined($row2) && (scalar(@{$row2} > 2)))
        {
            croak "serious error 2!";
            exit;
        }

        my $nexthdr = $row2->[-1]; # check the end of the array

        my @ggg = $self->_split_extent_descriptor($nexthdr);

        unless (scalar(@ggg) > 1)
        {
            croak "serious error 3!";
            exit;
        }
        
        # find the blockno of the overflow header, and make it current
##        $parent = $self->{current_seghdr};
        $self->{current_seghdr} = $ggg[0];
        # try again...
    } # end while
    
    return $rowd;
} # end _add_extent_to_segment_hdr

sub _update_extent_in_segment_hdr
{
    my ($self, $rowd, $ext_hdr_block, $extent_desc) = @_;

    my $row = $rowd->_get_meta_row("X1A");

    unless (defined($row))
    {
        croak "serious error 4!";
        exit;
    }

    my $maxi = scalar(@{$row});

    return undef
        unless ($maxi);
    # zero based
    $maxi--;

    for my $ii (0..$maxi)
    {
        my $xdsc = $row->[$ii];
        print $xdsc, "\n";
        my @ggg = $self->_split_extent_descriptor($xdsc);
        next
            unless (scalar(@ggg) > 4);
        my ($curr_ext_hdr_block, $extent_size, $total_pctused,
            $alloc_pctused, $free_len) = @ggg;

        # update if they are different
        if ($ext_hdr_block == $curr_ext_hdr_block)
        {
            if ($xdsc eq $extent_desc)
            {
                print "xdsc match - no update: $xdsc\n";
            }
            else
            {
                $row->[$ii] = $extent_desc;
                return $rowd->_set_meta_row("X1A", $row); 
            }
            last;
        }
    }
    return undef;
} # end _update_extent_in_segment_hdr

sub _create_extent_hdr
{
    my ($self, $rowd, $extent_size, $seghdr) = @_;

    return undef
        unless (defined($rowd));

    # XXX XXX: need enforcement of max extent size

    my $numbits = Genezzo::Util::PackBits(2 * $extent_size);
    my $nullstr = pack("B*", "0"x$numbits);

    # XHA (eXtent Header _A_): 
    #   1 per extent.
    #   contains the segment header, extent size and usage bitvec.
    #
    # XHP (eXtent Header Position): 
    #   1 per block (including 0th block of extent).
    #   contains the offset of the block in the extent,
    #   and the percent used in 10% increments (eg 1 is 10%, 9 is 90%)

    $rowd->_set_meta_row("XHA", [$seghdr, $extent_size, $nullstr]);
    # extent position is zero (1st block in extent), initial %used is zero 
    $rowd->_set_meta_row("XHP", [0, 0]);

    return $rowd;
} # end _create_extent_hdr

sub _update_extent_hdr
{
    my ($self, $rowd, $posn, $pct_used) = @_;

    return undef
        unless (defined($rowd));

    # get meta data for the segment header
    my $row = $rowd->_get_meta_row("XHA");

    if (! (defined($row) && scalar(@{$row})))
    {
        my $msg = "bad extent header\n";
        my %earg = (self => $self, msg => $msg,
                    severity => 'warn');
        
        &$GZERR(%earg)
            if (defined($GZERR));

        return undef;
    }

    my ($seghdr, $extent_size, $bvec) = @{$row};

#    whisper "size, bv: $extent_size," , unpack("b*",$bvec), "\n";

    my ($bit1, $bit2) = (0, 0 ); # empty

    if ($pct_used >= 90)
    {
        ($bit1, $bit2) = (1,1 ); # full
    }
    elsif ($pct_used >= 60)
    {
        ($bit1, $bit2) = (1,0 );
    }
    elsif ($pct_used >= 30)
    {
        ($bit1, $bit2) = (0,1 );
    }

    my @pct = $self->_xhdr_bv_to_pct($bvec, $extent_size);
    my $extent_stats  = shift @pct;
    my $avgpct        = $extent_stats->{avgpct};
    my $prev_numempty = $extent_stats->{numempty};
    my $allocpct      = $extent_stats->{allocpct};

    # use 2 bits per posn -- 00 is empty , 11 is full
    vec($bvec, (2*$posn),   1) = $bit1;
    vec($bvec, (2*$posn)+1, 1) = $bit2;
    whisper "size, bv: $extent_size," , unpack("b*",$bvec), "\n";

    @pct = $self->_xhdr_bv_to_pct($bvec, $extent_size);
    $extent_stats     = shift @pct;
    $avgpct           = $extent_stats->{avgpct};
    my $curr_numempty = $extent_stats->{numempty};

    # update
    $rowd->_set_meta_row("XHA", [$seghdr, $extent_size, $bvec]);

    # if this update causes the extent to transition from full to
    # partially-empty, need to return a status so we can update the
    # segment header

    my @outi;

    push @outi, $rowd;

    if ((0 == $prev_numempty) && (0 != $curr_numempty))
    {
# XXX XXX XXX XXX
        print "Emptied a block!!\n";
        @outi = ($rowd, $seghdr, $extent_size, $bvec);
#        return @outi;
    }
    return @outi;
    
} # end _update_extent_hdr

# convert a bitvec to an array of percentages
sub _xhdr_bv_to_pct
{
    my ($self, $bvec, $extent_size) = @_;

    my $bvstr = unpack("b*",$bvec);

    my @bvfull = split(/ */, $bvstr);

    my $bit1;
    my @pct;
    my $totpct   = 0;
    my $numempty = 0;

    # construct an array of percent usage for each block in the extent
    for my $bitty (@bvfull)
    {
        if (!defined($bit1))
        {
            $bit1 = $bitty;
            next;
        }

        my $bit2 = $bitty;
        
        my $blockpct;

        if (0 == $bit1)
        {
            # b01 = d30, b00 = d0
            $blockpct = ($bit2 ? 30: 0);
        }
        else
        {
            # b11 = d90, b10 = d60
            $blockpct = ($bit2 ? 90: 60);
        }
        $numempty++ unless ($blockpct);
        $totpct += $blockpct;
        push @pct, $blockpct;

        $bit1 = undef;
        $extent_size--;
        last unless ($extent_size);

    } # end for
    
    # prefix the array of pct usage with avg usage and number of empty blocks
    if (scalar(@pct))
    {
        $extent_size = scalar(@pct);
        my %extent_stats;

        # prefix array of percentages with avg pct used
        my $avgpct   = $totpct/$extent_size;
        my $allocpct = $avgpct;

        if ($numempty && ($numempty < $extent_size))
        {
            $allocpct = 
                $totpct/($extent_size-$numempty);
            $allocpct = 90 
                if ($allocpct > 90);
        }

        $extent_stats{allocpct} = $allocpct;
        $extent_stats{avgpct}   = $avgpct;
        # track the number of empty blocks in an extent
        $extent_stats{numempty} = $numempty;
        unshift @pct, \%extent_stats;
    }

    return @pct;
} # end  _xhdr_bv_to_pct


sub _find_extent_hdr
{
    whoami;

#    print "find extent header \n";
    
    my ($self, $blockno) = @_;

#    whisper "update seg hdr\n";

    my $rowd = $self->_get_rowd($blockno);
    unless (defined($rowd))
    {
        return (undef);
    }
    # get meta data for the position
    my $row = $rowd->_get_meta_row("XHP");

    unless (defined($row))
    {
        my $msg = "no position!\n";
        my %earg = (self => $self, msg => $msg,
                    severity => 'warn');
        
        &$GZERR(%earg)
            if (defined($GZERR));

        return undef;
    }
    my $posn        = $row->[0];
    my $curr_extent = $blockno - $posn;

    whisper "curr ext: $curr_extent, pos: $posn \n";

    return ($curr_extent, $posn);
}

sub nextfreeblock
{
    # this routine for finding free blocks in allocated extents

    # First, check curr_extent -- if have space there use it.
    # If current extent is full, pop back to segment header.
    # Check for free extents in segment header.  If have one, set it
    # as current and use it.
    # If no space available in the segment header, call SMFile and ask
    # for more space.

    my $self = shift;

    # XXX XXX: should main space information for all objects, but only
    # re-use space for standard tables.
   if (!exists($self->{object_type})
       || ($self->{object_type} ne 'TABLE'))
    {
        goto  L_nospacefound;
    }


    # if no space in current extent, then perform housekeeping on the
    # segment subheader, and check it for free space.

    # XXX XXX: check current extent first, then current seghdr...
    my $seghdr = $self->{first_seghdr};
    unless (defined($seghdr))
    {
        goto  L_nospacefound;
    }

    my $rowd = $self->_get_rowd($seghdr);
    unless (defined($rowd))
    {
        goto  L_nospacefound;
#        return (undef);
    }
    my $row = $rowd->_get_meta_row("X1A");

    unless (defined($row) && (scalar(@{$row}) > 1))
    {
        goto  L_nospacefound;
#        print "bad X1A row for $blockno \n";
#        return (undef);
    }

    my (@checklist, %revised);
    for my $xdesc (@{$row})
    {
        my @ggg = $self->_split_extent_descriptor($xdesc);
        next
            unless (scalar(@ggg) > 4);
        my ($blockno, $extent_size, $total_pctused,
            $alloc_pctused, $free_len) = @ggg;

        next
            unless ($free_len > 0);

        my $checkitem = [$blockno, $extent_size, $total_pctused,
                         $alloc_pctused, $free_len];

        push @checklist, $checkitem;
    } # end for all xdesc in X1A row

    # update the extents in the checklist if necessary
    for my $item (@checklist)
    {
        my ($blockno, $extent_size, $total_pctused,
            $alloc_pctused, $free_len) = @{$item};

        $rowd = $self->_get_rowd($blockno);
        unless (defined($rowd))
        {
            print "bad rowd for $blockno!!\n";
            return (undef);
        }
        $row = $rowd->_get_meta_row("XHA");
        unless (defined($row) && (scalar(@{$row}) > 1))
        {
            print "bad XHA row for $blockno \n";
            return (undef);
        }
        my $seghdr = $row->[0];
        my $extsiz = $row->[1];
        my $bvec   = $row->[2];
        my @pct = $self->_xhdr_bv_to_pct($bvec, $row->[1]);

        my $extent_stats = shift @pct;
        my $avgpct   = $extent_stats->{avgpct};
        my $numempty = $extent_stats->{numempty};
        my $allocpct = $extent_stats->{allocpct};

# XXX XXX XXX XXX        
#        print "block $blockno: ",  join(" ",
#                                        ( $total_pctused,
#                                         $alloc_pctused, $free_len)), "\n";

        # get magnitude of number of empty blocks (0-9, where 0 is 0
        # free, and 9 is 10^9)
        my $new_free_len = $numempty ? length($numempty) : 0;
        $new_free_len = 9 
            if ($new_free_len > 9 );

        $avgpct   =  _trunc_or_pad($avgpct, 2);
        $allocpct =  _trunc_or_pad($allocpct, 2);

# XXX XXX XXX XXX
#        print "now: ", join(" ", ($avgpct, $allocpct, $new_free_len)),"\n";

        if (($total_pctused != $avgpct) ||
            ($alloc_pctused != $allocpct) ||
            ($free_len != $new_free_len))
        {
            # use numempty, not free_len, because make_extent_desc
            # will do calculation
            my $revitem = [$blockno, $extent_size, $avgpct,
                           $allocpct, $numempty];

            $revised{$blockno} =  $revitem;
        }

    } # end for checklist

    $rowd = $self->_get_rowd($seghdr);
    unless (defined($rowd))
    {
        return (undef);
    }
    $row = $rowd->_get_meta_row("X1A");
        
    unless (defined($row) && (scalar(@{$row}) > 1))
    {
        goto  L_nospacefound;
#        print "bad X1A row for $blockno \n";
#        return (undef);
    }

    if (scalar(keys(%revised)))
    {

        for my $ii (0..(scalar(@{$row})-1))
        {
            my $xdesc = $row->[$ii];

            my @ggg = $self->_split_extent_descriptor($xdesc);
            next
                unless (scalar(@ggg) > 4);
            my ($blockno, $extent_size, $total_pctused,
                $alloc_pctused, $free_len) = @ggg;

            next 
                unless (exists($revised{$blockno}));

            my $new_xd = $revised{$blockno};
            $row->[$ii] = $self->_make_extent_descriptor(@{$new_xd});

        } # end for all xdesc in X1A row
        $rowd->_set_meta_row("X1A", $row);
    }

    for my $ii (0..(scalar(@{$row})-1))
    {
        my $xdesc = $row->[$ii];

        my @ggg = $self->_split_extent_descriptor($xdesc);
        next
            unless (scalar(@ggg) > 4);
        my ($blockno, $extent_size, $total_pctused,
            $alloc_pctused, $free_len) = @ggg;

        next 
            unless (exists($revised{$blockno}));

        my $new_xd = $revised{$blockno};
        $row->[$ii] = $self->_make_extent_descriptor(@{$new_xd});

    } # end for all xdesc in X1A row

    if (0)
    {
        # XXX XXX: fixup SMFile and SMExtent

        my $currBlocknum;

        my %nargs = (
                     currblocknum => $currBlocknum
                     );
#        $nargs{currextent}  = $blockno;
#        $nargs{extent_size} = $extent_size;
#        $nargs{extent_posn} = 0;

        my $h1 = 
            Genezzo::SpaceMan::SMFile::_make_all_info_for_free_block(
                                                                     %nargs
                                                                     );

        %nargs = (
                  blocknum        => $currBlocknum,
#                  firstextent     => $firstextent,
                  current_extent  => $self->{curr_extent},
                  extent_size     => $self->{extent_size},
                  extent_position => $self->{extent_posn}
                  );

        my $h2 = 
            Genezzo::SpaceMan::SMFreeBlock->new(%nargs);

    }
    

  L_nospacefound:
    # if no space available, get space from SMFile
    return $self->_file_nextfreeblock(@_);
}

sub _file_nextfreeblock
{
    my $self = shift;
    my $gotnewextent = 0; # true if get new extent
    my $blockinfo = $self->{smf}->nextfreeblock(@_);

    return undef
        unless (defined($blockinfo));

    {
        if (exists($blockinfo->{currextent}))
        {
            greet "new extent", $blockinfo ;
            $gotnewextent = 1; # true if get new extent
        }
    }

    my $blockno = $blockinfo->{basic_array}->[0];

    my $rowd = $self->_get_rowd($blockno);
    unless (defined($rowd))
    {
        return (undef);
    }

    my @new_extent_info;
    if (!$gotnewextent)
    {
        # check if already have extent position
        my $row = undef;

        # if the current extent isn't new, then curr_extent should
        # have been set when the extent was created.  However, if the
        # extent was created in a previous session, we need to track
        # down the header to determine the current position

        unless (exists($self->{curr_extent}) &&
                exists($self->{extent_posn}))
        { # no position info
            $row = $rowd->_get_meta_row("XHP");
            if (defined($row))
            {
                # if the "new" block has a position, then we are done

                whisper "found position!!\n";
                my $posn = $row->[0];
                $self->{curr_extent} = $blockno - $posn;
                $self->{extent_posn} = $posn;

                goto L_setposition;                
            }

            # if we don't know the start of the current extent, check
            # the previous block
            
            $rowd = undef;

            my @ggg = $self->_find_extent_hdr($blockno - 1);

            unless (scalar(@ggg) > 1)
            {
                my $msg = "could not find extent header!\n";
                my %earg = (self => $self, msg => $msg,
                            severity => 'warn');
        
                &$GZERR(%earg)
                    if (defined($GZERR));

                return undef;
            }
            # set info for previous block
            $self->{curr_extent} = shift @ggg;
            $self->{extent_posn} = shift @ggg;
            
            # reload the current block
            $rowd = $self->_get_rowd($blockno);
            unless (defined($rowd))
            {
                return (undef);
            }
 
        } # end no position info

        # if we know the blockno of the current extent, just
        # increment the extent position
        $self->{extent_posn} += 1;

      L_setposition:
        my $posn = $self->{extent_posn};
        # set meta data for the extent header (position, initial %used is zero)
        $rowd->_set_meta_row("XHP", [$posn, 0]);

    }
    else # got new extent
    {
        # size of extent is last entry in blockinfo
        my $extent_size = $blockinfo->{currextent}->[-1];

        $self->{extent_size}  = $extent_size;

        # curr_extent is the block number of the start of the current extent
        $self->{curr_extent}  = $blockno;

        # each block in the extent has a "position" -- an offset from
        # the 1st block.  The 1st block is position zero, 
        # the 2nd is position 1, etc.
        $self->{extent_posn}  = 0;

        if ($blockinfo->{firstextent})
        {
            # set meta data for the segment header in this file
            unless ($self->_create_segment_hdr($rowd, $blockno, $extent_size))
            {
                my $msg = "could not create segment header\n";
                my %earg = (self => $self, msg => $msg,
                            severity => 'warn');
        
                &$GZERR(%earg)
                    if (defined($GZERR));

                return undef;
            }
        }
        else
        {
            # get info for segment header
            push @new_extent_info, $blockno, $extent_size;
        }
        # set meta data for the extent header
        unless ($self->_create_extent_hdr($rowd, $extent_size,
                                          $self->{current_seghdr}))
        {
            my $msg = "could not create extent header\n";
            my %earg = (self => $self, msg => $msg,
                        severity => 'warn');
        
            &$GZERR(%earg)
                if (defined($GZERR));

            return undef;
        }

    }

    my $curr_seghdr = $self->{current_seghdr};

    if (scalar(@new_extent_info))
    {
        $self->_add_extent_to_segment_hdr(@new_extent_info);
    }
        
    $rowd = $self->_get_rowd(0);
    unless (defined($rowd))
    {
        return (undef);
    }

    return $blockinfo;
} # end nextfreeblock

sub currblock
{
    my $self = shift;
    return $self->{smf}->currblock(@_);
}

sub firstblock
{
    my $self = shift;
    return $self->{smf}->firstblock(@_);
}

sub nextblock
{
    my $self = shift;
    return $self->{smf}->nextblock(@_);
}

sub countblock
{
    my $self = shift;
    return $self->{smf}->countblock(@_);
}

sub hasblock
{
    my $self = shift;
    return $self->{smf}->hasblock(@_);
}

sub freetable
{
    my $self = shift;
    return $self->{smf}->freetable(@_);
}

sub flush
{
    my $self = shift;
    return $self->{smf}->flush(@_);
}



END {

}


1;  # don't forget to return a true value from the file

__END__

=head1 NAME

Genezzo::SpaceMan::SMExtent.pm - Extent Space Management

=head1 SYNOPSIS


=head1 DESCRIPTION

Maintain segment headers and extent headers for objects stored in
a file with information on space usage.  The set of space allocations
for an object in a file is called a *segment*.  Each segment is
composed of *extents*, groups of contiguous blocks.

allocate a new extent:

if have first extent (segment header)
  create X1A with current blockno, size.
else 
  update X1A with new extent info.

in first block of extent:
  create XHA with empty space usage bitvec
  create XHP, marked as position zero 

if allocate a new block:
  if 1st block of an extent, 
    goto allocate new extent
  else
    could mark prior block as used in XHA...

if free a block:
  clear bitvec in XHA

if freed all blocks in XHA
  update X1A

if X1A is too small:
need 2 rows.  pump out with free space at end.

seghd_allextents: status_flag extent:size:pct_used, 
                  extent:size:pct_used, extent:size:pct_used...
seghd_next: parent_seghead next_seghead:tot_size:pct_used

tot_size in human_num, eg 10K, 100G, 2P...

leapfrog:

seghd in extent 1, create a seghd in extent 2 when
you allocate it.  
when seghd in extent 1 fills, overflow to seghd in 
extent 2.  When allocate next new extent, update the
2nd seghead, and create a new seghd in the new extent.

x1a: extent:size:pct_used, extent:size:pct_used, ...
x1b: parent [child]

parent = self for 1st extent
fill in child when allocate 2nd extent...
child info tracks additional space usage in segment subhead, and
if use "human readable" numbers, can restrict to 4 char fixed size
0-999B, 1K-999K, 1M-999M 
marker for "subhead full" vs vacancy...
x1a: full_flag extent:size:pct_used, extent:size:pct_used, ...


if XHA bitvec is too long:
break out over multiple rows, over multiple blocks.    

xhd1: parent_xhd bitvec
xhd[N]: next_xhd
  
or maybe -- recursive split 

bitvec of blocks or subextents.
for extent of < 128 blocks, simple bitvec for each block.

for extent of 256 blocks
top bitvec of 2 subextents
each subextent has bitvec of 128 blocks

actually, could top out extent size at 1M, use 256 4K blocks per extent

xhd needs to track seghd/subhead info

xhp tracks extent position [0 to N-1] and
%used in extent header (ie 0 is 0%, 3 is 30%, 6 is 60%, and 9 is 90+%).

Note that block zero is a very similar to a segment header, though it
tracks the lists of extents associated with each object, and it
doesn't track percent usage.  However, if we have the case of a file
which is solely for one object, we could merge a good portion of block
zero and the segment header into a combined set of data structures.


=head1 FUNCTIONS

=over 4

=item currblock

return the current active block (insert high water mark) for an object.

Advanced: allow multiple active blocks for concurrent usage.

=item nextfreeblock

return the next unused block for an object, which would be one beyond
the current block in the current extent if possible, or else it
allocates a new extent.

Advanced: allow multiple "next blocks" for concurrent users.  Maintain
multiple freelists.  Use this call as an opportunity to probe extent
headers to update the segment header.

=item firstblock, nextblock

iterate over the set of *used* blocks for an object.  Ignores unused
blocks in last extent

=item countblock

count of all blocks associated with the object.  Includes allocated,
*unused* blocks, plus empty blocks (i.e. blocks with no rows).

=item hasblock 

check if block is associated with an object

=item freetable 

return all of an object's blocks to the freelist

=item flush 

write the contents of block zero to disk.  Need to handle case of
extent lists spread over multiple blocks.


=back


=head2 EXPORT

=head1 TODO

=over 4

=item  remove the seghdr/segnxt debugging tags

=item  need to coalesce adjacent free extents

=item  maintain multiple free lists for performance

=item  better indexing scheme - maybe a btree

=back



=head1 AUTHOR

Jeffrey I. Cohen, jcohen@genezzo.com

=head1 SEE ALSO

perl(1).

Copyright (c) 2006 Jeffrey I Cohen.  All rights reserved.

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

Address bug reports and comments to: jcohen@genezzo.com

For more information, please visit the Genezzo homepage 
at L<http://www.genezzo.com>

=cut
