File Coverage

blib/lib/Paranoid/IO/FileMultiplexer/Block.pm

Criterion	Covered	Total	%
statement	117	133	87.9
branch	36	48	75.0
condition	15	21	71.4
subroutine	17	20	85.0
pod	9	9	100.0
total	194	231	83.9

# Paranoid::IO::FileMultiplexer::Block -- Block-level Allocator/Accessor
#
# $Id: lib/Paranoid/IO/FileMultiplexer/Block.pm, 2.10 2022/03/08 00:01:04 acorliss Exp $
#
# This software is free software.  Similar to Perl, you can redistribute it
# and/or modify it under the terms of either:
#
#   a)     the GNU General Public License
#           as published by the
#          Free Software Foundation ; either version 1
#          , or any later version
#          , or
#   b)     the Artistic License 2.0
#          ,
#
# subject to the following additional term:  No trademark rights to
# "Paranoid" have been or are conveyed under any of the above licenses.
# However, "Paranoid" may be used fairly to describe this unmodified
# software, in good faith, but not as a trademark.
#
# (c) 2005 - 2021, Arthur Corliss ([e-mail])
# (tm) 2008 - 2021, Paranoid Inc. (www.paranoid.com)
#
#####################################################################

#####################################################################
#
# Environment definitions
#
#####################################################################

package Paranoid::IO::FileMultiplexer::Block;

use 5.008;

use strict;
use warnings;
use vars qw($VERSION);
use base qw(Exporter);
use Paranoid qw(:all);
use Paranoid::IO qw(:all);
use Paranoid::Debug qw(:all);
use Fcntl qw(:DEFAULT :flock :mode :seek);

($VERSION) = ( q$Revision: 2.10 $ =~ /(\d+(?:\.\d+)+)/sm );

use constant MINBSIZE => 4_096;
use constant MAXBSIZE => 1_048_576;

#####################################################################
#
# Module code follows
#
#####################################################################

sub new {

    # Purpose:  Creates a block object
    # Returns:  Object reference or undef
    # Usage:    $obj = Paranoid::IO::FileMultiplexer::Block->new(
    #                   $filename, $bnum, $bsize);

    my $class = shift;
    my $file  = shift;
    my $bnum  = shift;
    my $bsize = shift;
    my $self  = {
        file      => $file,
        blockNum  => 0,
        blockSize => MINBSIZE,
        minPos    => 0,
        maxPos    => MINBSIZE - 1,
        };

    subPreamble( PDLEVEL3, '$$$', $file, $bnum, $bsize );

    bless $self, $class;

    # Check mandatory values
    $self = undef
        unless defined $bnum
            and defined $bsize
            and defined $file
            and length $file;
    pdebug( 'invalid or missing arguments', PDLEVEL1 )
        unless defined $self;

    if ( defined $self ) {

        # Make sure we only have positive values for the block number and size
        $$self{blockNum}  = int $bnum;
        $$self{blockSize} = int $bsize if defined $bsize;
        $$self{minPos}    = $$self{blockNum} * $$self{blockSize};
        $$self{maxPos}    = $$self{minPos} + $$self{blockSize} - 1;

        # Make sure block size is in range and a multiple of MINBSIZE
        $self = undef
            unless $$self{blockSize} >= MINBSIZE
                and $$self{blockSize} <= MAXBSIZE
                and $$self{blockSize} % MINBSIZE == 0;
        pdebug( 'invalid block size', PDLEVEL1 ) unless defined $self;
    }

    subPostamble( PDLEVEL3, '$', $self );

    return $self;
}

sub recalibrate {

    # Purpose:  Recalibrates min/max positions in the block based
    #           on block size.
    # Returns:  Boolean
    # Usage:    $rv = $obj->recalibrate;

    my $self = shift;

    $$self{minPos} = $$self{blockNum} * $$self{blockSize};
    $$self{maxPos} = $$self{minPos} + $$self{blockSize} - 1;

    return 1;
}

sub blockNum {

    # Purpose:  Returns the block number
    # Returns:  Integer
    # Usage:    $bn = $obj->blockNum;

    my $self = shift;
    return $$self{blockNum};
}

sub blockSize {

    # Purpose:  Returns the block size
    # Returns:  Integer
    # Usage:    $bs = $obj->blockSize;

    my $self = shift;
    return $$self{blockSize};
}

sub minPos {

    # Purpose:  Returns the min writable file position for the block
    # Returns:  Integer
    # Usage:    $minp = $obj->minPos;

    my $self = shift;
    return $$self{minPos};
}

sub maxPos {

    # Purpose:  Returns the max writable file position for the block
    # Returns:  Integer
    # Usage:    $maxp = $obj->maxPos;

    my $self = shift;
    return $$self{maxPos};
}

sub allocate {

    # Purpose:  Writes a new block to disk
    # Returns:  Boolean
    # Usage:    $rv = $obj->allocate;

    my $self   = shift;
    my $file   = $$self{file};
    my $minPos = $$self{minPos};
    my $maxPos = $$self{maxPos};
    my $rv     = 0;

    subPreamble(PDLEVEL3);

    if ( pflock( $$self{file}, LOCK_EX ) ) {

        # Seek and write a null byte at the end of the block
        pdebug( 'end of file should be at %s', PDLEVEL4, $minPos );
        pseek( $file, 0, SEEK_END );
        if ( ptell($file) == $minPos ) {
            pseek( $file, $maxPos, SEEK_SET );
            $rv = pwrite( $file, pack 'x' );
        } else {
            pdebug('block already allocated');
        }

        pflock( $$self{file}, LOCK_UN );
    }

    subPostamble( PDLEVEL3, '$', $rv );

    return $rv;
}

sub bread {

    # Purpose:  Reads the contents of the entire block. or a specified range
    # Returns:  Integer (bytes read) or undef on error
    # Usage:    $bytesRead = $obj->bread(\$content);
    # Usage:    $bytesRead = $obj->bread(\$content, $start);
    # Usage:    $bytesRead = $obj->bread(\$content, undef, $bytes);
    # Usage:    $bytesRead = $obj->bread(\$content, $start, $bytes);

    my $self  = shift;
    my $cref  = shift;
    my $start = shift;
    my $bytes = shift;
    my $file  = $$self{file};
    my $bsize = $$self{blockSize};
    my $minp  = $$self{minPos};
    my $maxp  = $$self{maxPos};
    my $rv    = PTRUE_ZERO;

    subPreamble( PDLEVEL3, '$;$$', $cref, $start, $bytes );

    # NOTE:  This method intentionally allows reads of a length greater than
    # the block size, but it will only return content from within the block
    # boundaries.

    # Error out if we were not given a valid scalar ref
    unless ( defined $cref and ref($cref) eq 'SCALAR' ) {
        $rv = undef;
        pdebug( 'invalid argument for content ref', PDLEVEL1 );
    }

    # Set start to beginning of block if not specified
    $start = 0 unless defined $start;

    # Set default bytes if not specified
    $bytes = $bsize - $start unless defined $bytes;

    # Make sure start is in range
    if ( $minp + $start > $maxp ) {
        pdebug( 'starting position is out of range', PDLEVEL1 );
        $rv = undef;
    }

    if ($rv) {

        # Make sure we limit read to our block
        $bytes = ( $maxp + 1 ) - ( $minp + $start )
            if ( $minp + $start + $bytes ) > ( $maxp + 1 );

        # Perform the read
        if ( pseek( $file, $minp + $start, SEEK_SET ) ) {
            $rv = pread( $file, $$cref, $bytes );
        } else {
            $rv = undef;
        }
    }

    subPostamble( PDLEVEL3, '$', $rv );

    return $rv;
}

sub bwrite {

# Purpose:  Writes the contents of the entire block. or a specified range
# Returns:  Integer (bytes written) or undef on error
# Usage:    $bytesWritten = $obj->bwrite($content);
# Usage:    $bytesWritten = $obj->bwrite($content, $start );
# Usage:    $bytesWritten = $obj->bwrite($content, $start, $length );
# Usage:    $bytesWritten = $obj->bwrite($content, $start, $length, $offset );

    my $self    = shift;
    my $content = shift;
    my $start   = shift;
    my $length  = shift;
    my $offset  = shift;
    my $file    = $$self{file};
    my $bsize   = $$self{blockSize};
    my $minp    = $$self{minPos};
    my $maxp    = $$self{maxPos};
    my $rv      = PTRUE_ZERO;
    my $cdata   = defined $content ? ( length $content ) . ' bytes' : undef;
    my $blkLeft;

    subPreamble( PDLEVEL3, '$;$$$', $cdata, $start, $length, $offset );

    # NOTE:  This method intentionally allows writes of a length greater than
    # the block size, but it will only write content from within the block
    # boundaries.

    # Error out if we were not given a valid scalar ref
    unless ( defined $content and length $content ) {
        $rv = undef;
        pdebug( 'invalid argument for content', PDLEVEL1 );
    }

    # Set start to beginning of block if not specified
    $start = 0 unless defined $start;

    # Set offset to zero if not specified
    $offset = 0 unless defined $offset;

    # Set length to max content length available if not defined
    $length  = length($content) - $offset unless defined $length;
    $blkLeft = $bsize - $start;
    $length  = $blkLeft if $blkLeft < $length;

    # Make sure start is in range
    if ( $minp + $start > $maxp ) {
        pdebug( 'starting position is out of range', PDLEVEL1 );
        $rv = undef;
    }

    if ($rv) {

        # Perform the write
        if ( pseek( $file, $minp + $start, SEEK_SET ) ) {
            $rv = pwrite( $file, $content, $length, $offset );
        } else {
            $rv = undef;
        }
    }

    subPostamble( PDLEVEL3, '$', $rv );

    return $rv;
}

1;

__END__