File Coverage

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

Criterion	Covered	Total	%
statement	145	183	79.2
branch	19	40	47.5
condition	7	9	77.7
subroutine	26	28	92.8
pod	10	10	100.0
total	207	270	76.6

# Paranoid::IO::FileMultiplexer::Block::BATHeader -- BAT Header Block
#
# $Id: lib/Paranoid/IO/FileMultiplexer/Block/BATHeader.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::BATHeader;

use 5.008;

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

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

use base qw(Paranoid::IO::FileMultiplexer::Block);

# Signature format:
#   PIOFMBAT Name Sequence
#   Z9       Z21  NNxx
#     40 bytes
#
# Data record format:
#   BlockNum
#   NN
#     8 bytes
use constant SIGNATURE => 'Z9Z21NNxx';
use constant SIG_LEN   => 40;
use constant SIG_TYPE  => 'PIOFMBAT';
use constant SEQ_POS   => 30;
use constant DATA_POS  => 40;
use constant DATAIDX   => 'NN';
use constant DATA_LEN  => 8;

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

sub new {

    # Purpose:  Creates a new BAT header object
    # Returns:  Object reference/undef
    # Usage:    $obj =
    #             Paranoid::IO::FileMultiplexer::Block::BATHeader->new($file,
    #             $blockNo, $blockSize, $strmName, $sequenceNo);

    my $class = shift;
    my $file  = shift;
    my $bnum  = shift;
    my $bsize = shift;
    my $sname = shift;
    my $seq   = shift;
    my $self;

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

    $self = __PACKAGE__->SUPER::new( $file, $bnum, $bsize );
    if ( defined $self ) {
        $$self{streamName} = $sname;
        $$self{data}       = [];       # array of data blockNums
        $$self{sequence}   = 0;        # sequence no of BAT
        $$self{maxData} = int( ( $$self{blockSize} - SIG_LEN ) / DATA_LEN );
    }

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

    return $self;
}

sub maxData {

    # Purpose:  Returns the max data blocks for the BAT
    # Returns:  Integer
    # Usage:    $max = $obj->maxData;

    my $self = shift;

    return $$self{maxData};
}

sub sequence {

    # Purpose:  Returns the current BAT sequence number
    # Returns:  Integer
    # Usage:    $seq = $obj->sequence;

    my $self = shift;

    return $$self{sequence};
}

sub dataBlocks {

    # Purpose:  Returns an array of data block nums
    # Returns:  Array
    # Usage:    @data = $obj->dataBlocks;

    my $self = shift;

    return @{ $$self{data} };
}

sub full {

    # Purpose:  Returns whether the BAT's array of data blocks is full
    # Returns:  Boolean
    # Usage:    $rv = $obj->full;

    my $self = shift;

    return $self->maxData == scalar $self->dataBlocks;
}

sub writeSig {

    # Purpose:  Writes the BAT signature to the file
    # Returns:  Boolean
    # Usage:    $rv = $obj->writeSig;

    my $self  = shift;
    my $file  = $$self{file};
    my $sname = $$self{streamName};
    my $seq   = $$self{sequence};
    my $rv    = 0;
    my $sig   = pack SIGNATURE, SIG_TYPE, $sname, quad2Longs($seq);

    subPreamble(PDLEVEL3);

    $rv = $self->bwrite($sig);

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

    return $rv;
}

sub readSig {

    # Purpose:  Reads the block signature from the file
    # Returns:  Boolean
    # Usage:    $rv = $obj->readSig;

    my $self = shift;
    my $file = $$self{file};
    my $rv   = 0;
    my ( $raw, $type, $sname, $seq, $lseq, $useq );

    subPreamble(PDLEVEL3);

    if ( pflock( $file, LOCK_SH ) ) {
        if ( $self->bread( \$raw, 0, SIG_LEN ) == SIG_LEN ) {
            $rv = 1;

            # Unpack the signature
            ( $type, $sname, $lseq, $useq ) = unpack SIGNATURE, $raw;

            # Validate contents
            #
            # Start with file type
            unless ( $type eq SIG_TYPE ) {
                $rv = 0;
                pdebug( 'Invalid BAT header type (%s)', PDLEVEL1, $type );
            }

            # stream name
            unless ( $sname eq $$self{streamName} ) {
                $rv = 0;
                pdebug( 'Invalid stream name (%s)', PDLEVEL1, $sname );
            }

            # Make sure seq is legitimate
            $seq = longs2Quad( $lseq, $useq );
            unless ( defined $seq ) {
                pdebug(
                    'this platform does not support 64b values for sequence',
                    PDLEVEL1
                    );
                $rv = 0;
            }
            unless ( $seq == $$self{sequence} ) {
                pdebug( 'Invalid sequence number for BAT (%s)',
                    PDLEVEL1, $seq );
                $rv = 0;
            }

            # Update internal values
            pdebug( 'BAT signature verification failure', PDLEVEL1 )
                unless $rv;

        } else {
            pdebug( 'failed to read BAT header signature', PDLEVEL1 );
        }

        pflock( $file, LOCK_UN );
    }

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

    return $rv;
}

sub writeData {

    # Purpose:  Writes all the data block numbers to the file
    # Returns:  Boolean
    # Usage:    $rv = $obj->writeData;

    my $self = shift;
    my $file = $$self{file};
    my $rv   = 0;
    my ( $rec, $i, $pos, $maxbats );

    subPreamble(PDLEVEL3);

    # Hold an exclusive lock for the entire transaction
    if ( pflock( $file, LOCK_EX ) ) {

        # Calculate the maximum possible number of BATs
        $maxbats = int( ( $$self{blockSize} - SIG_LEN ) / DATA_LEN );

        $rv = 1;
        $i  = 0;
        foreach $rec ( @{ $$self{data} } ) {
            $pos = DATA_POS + $i * DATA_LEN;
            $rv  = 0
                unless $self->bwrite( pack( DATAIDX, quad2Longs($rec) ),
                $pos ) == DATA_LEN;
            $i++;
            last unless $rv;
        }

        pflock( $file, LOCK_UN );
    }

    pdebug( 'failed to write all data block numbers to the BAT header',
        PDLEVEL1 )
        unless $rv;

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

    return $rv;
}

sub readData {

    # Purpose:  Reads the data block numbers from the BAT header
    # Returns:  Boolean
    # Usage:    $rv = $obj->readData;

    my $self = shift;
    my $rv   = 1;
    my ( $raw, @sraw, $bn, $lbn, $ubn, $prev );
    my @data;

    subPreamble(PDLEVEL3);

    # Read the BATs section of the block
    if ( $self->bread( \$raw, DATA_POS ) ) {

        @sraw = unpack '(' . DATAIDX . ")$$self{maxData}", $raw;
        while (@sraw) {

            $lbn = shift @sraw;
            $ubn = shift @sraw;
            $bn  = longs2Quad( $lbn, $ubn );

            # Stop processing when it looks like we're not getting legitmate
            # values
            last unless defined $bn and $bn > $$self{blockNum};

            # Error out if block numbers aren't ascending
            unless ( !defined $prev or $bn > $prev ) {
                pdebug( 'data block number appearing out of sequence',
                    PDLEVEL1 );
                $rv = 0;
                last;
            }

            # Save entry
            push @data, $bn;
            $prev = $bn;
        }

        # Save everything extracted
        $$self{data} = [@data];
        pdebug( 'found %s data blocks', PDLEVEL4, scalar @data );

    } else {
        pdebug( 'failed to read list of data blocks from BAT header',
            PDLEVEL1 );
        $rv = 0;
    }

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

    return $rv;
}

sub addData {

    # Purpose:  Adds a data block number to the BAT header
    # Returns:  Boolean
    # Usage:    $rv = $obj->addData($bn);

    my $self = shift;
    my $bn   = shift;
    my $rv   = 1;
    my $n;

    subPreamble( PDLEVEL3, '$', $bn );

    if ( defined $bn and $bn > $$self{blockNum} ) {

        # Make sure we're not adding redundant entries
        if ( scalar grep { $_ eq $bn } @{ $$self{data} } ) {
            $rv = 0;
            pdebug( 'redundant entry for an existing data block', PDLEVEL1 );
        }

        # Make sure new data block is a higher block number than all previous
        # data blocks
        if ( scalar grep { $_ > $bn } @{ $$self{data} } ) {
            $rv = 0;
            pdebug( 'data block number is lower than previous blocks',
                PDLEVEL1 );
        }

        if ($rv) {

            # Write the block to the header
            push @{ $$self{data} }, $bn;
            $rv = 0
                unless $self->bwrite(
                pack( DATAIDX, quad2Longs($bn) ),
                DATA_POS + DATA_LEN * $#{ $$self{data} } ) == DATA_LEN;
        }

    } else {
        pdebug( 'invalid data block number (%s)', PDLEVEL1, $bn );
        $rv = 0;
    }

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

    return $rv;
}

1;

__END__