File Coverage

blib/lib/MVS/VBFile.pm

Criterion	Covered	Total	%
statement	75	82	91.4
branch	36	48	75.0
condition	5	8	62.5
subroutine	10	10	100.0
pod	5	6	83.3
total	131	154	85.0

package MVS::VBFile;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
use Carp;

require Exporter;

@ISA = qw(Exporter);
@EXPORT = qw(vbget);
@EXPORT_OK = qw(vbget vbopen vbput vbclose vb_blocks_written);
$VERSION = '0.05';

%EXPORT_TAGS = ( all => [ @EXPORT_OK ] );

my $blib = 0;  # Bytes left in block
$MVS::VBFile::bdws = 0;
$MVS::VBFile::keep_rdw = 0;

%MVS::VBFile::outblock = ();
%MVS::VBFile::blksizes = ();
%MVS::VBFile::blocks_written = ();

#--- vbget gets a single record; if called in array context (the user
#--- wants all records in a single array), it calls vbget_array.
#
sub vbget {
 my $FH = shift;  # Filehandle
 if (wantarray) {
    return vbget_array($FH);
 }

 my ($bdw, $rdw, $reclen, $v_record, $n);
 if ($blib == 0 && $MVS::VBFile::bdws) {
	#--- Beginning of a block: read the Block Descriptor Word
	#--- if we've been told to.
    $n = read($FH, $bdw, 4);
    if ($n < 4) {  # End of file
       return undef();
    }
    $blib = unpack("n2", substr($bdw, 0,2)) - 4;
 }
	#--- Now read the Record Descriptor Word
 $n = read($FH, $rdw, 4);
 if ($n < 4) {
    return undef() if ! $MVS::VBFile::bdws;  # End of file
    Carp::carp "vbget: Unexpected end of file";
    return undef();
 }
 $reclen = unpack("n2", substr($rdw, 0,2)) - 4;

 $n = read($FH, $v_record, $reclen);
 if ($n != $reclen) {
    Carp::carp "vbget: Unexpected end of file";
 }
 $blib = $blib - ($reclen + 4)  if $MVS::VBFile::bdws;
 $v_record = $rdw.$v_record  if $MVS::VBFile::keep_rdw;

 return $v_record;
}

#--- Get all records in a single array.
#
sub vbget_array {
 my $FH = shift;  # Filehandle
 my ($bdw, $rdw, $reclen, $v_record, $n);
 my @out = ();

 while (1) {
    if ($blib == 0 && $MVS::VBFile::bdws) {
	#--- Beginning of a block: read the Block Descriptor Word
	#--- if we've been told to.
       $n = read($FH, $bdw, 4);
       if ($n < 4) {  # End of file
          return @out;
       }
       $blib = unpack("n2", substr($bdw, 0,2)) - 4;
    }
	#--- Now read the Record Descriptor Word
    $n = read($FH, $rdw, 4);
    if ($n < 4) {
       return @out if ! $MVS::VBFile::bdws;  # End of file
       Carp::carp "vbget: Unexpected end of file";
       return @out;
    }
    $reclen = unpack("n2", substr($rdw, 0,2)) - 4;

    $n = read($FH, $v_record, $reclen);
    if ($n != $reclen) {
       Carp::carp "vbget: Unexpected end of file";
       return @out;
    }
    $blib = $blib - ($reclen + 4)  if $MVS::VBFile::bdws;
    $v_record = $rdw.$v_record  if $MVS::VBFile::keep_rdw;

    push @out, $v_record;
 }
}

#---------------------------------------
#  OUTPUT: vbopen, vbput, vbclose
#---------------------------------------

#--- vbopen: pretty much the same as open() except that it also sets
#--- the blksize for the file.
#
sub vbopen {
 my ($FH, $expr, $blksize) = @_;
 $blksize ||= 32760;
 $blksize = 32760 if $blksize < 9;
 $blksize = 32760 if $blksize > 262_144;

 $MVS::VBFile::blksizes{ $FH } = $blksize;
 $MVS::VBFile::outblock{$FH} = pack('x4');  # Start with a dummy BDW
 $MVS::VBFile::blocks_written{$FH} = 0;
 return open($FH, $expr);
}

#--- vbput puts a single logical record.  When a block is filled up,
#--- write the block and start a new one.
#
sub vbput {
 my ($FH, $record) = @_;
 Carp::croak "vbput: No filehandle specified" unless $FH;
 Carp::croak "vbput: No record specified" unless $record;
 my $blksize = $MVS::VBFile::blksizes{ $FH };

 my $L = length($record) + 4;
 if ($L + length($MVS::VBFile::outblock{$FH}) > $blksize) {
    _put_block($FH);
    $MVS::VBFile::outblock{$FH} = pack('x4');  # Start with a dummy BDW
 }
 my $rdw = pack("n x2",$L);
 $MVS::VBFile::outblock{$FH} .= $rdw.$record;
}

sub _put_block {
 my $FH = shift;
 my $outrec = $MVS::VBFile::outblock{$FH};

 substr($outrec,0,4) = pack("n x2",length($outrec));

 print $FH $outrec  or Carp::croak "Error in vbput: $!";
 $MVS::VBFile::blocks_written{$FH}++;
}

#--- vbclose: close the output file, but first write out the last
#--- block if necessary.
#
sub vbclose {
 my $FH = shift;
 Carp::croak "vbput: No filehandle specified" unless $FH;

 _put_block($FH)  if length($MVS::VBFile::outblock{$FH}) > 4;

 return close($FH);
}

sub vb_blocks_written {
 my $FH = shift;
 Carp::croak "vb_blocks_written: No filehandle specified" unless $FH;
 return $MVS::VBFile::blocks_written{ $FH };
}

1;

__END__