tap2file

#!/usr/bin/perl -w
# $Id: tap2file 1189 2019-07-13 16:41:07Z mueller $
# SPDX-License-Identifier: GPL-3.0-or-later
# Copyright 2015-2019 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
#
#  Revision History:
# Date         Rev Version  Comment
# 2019-07-13  1189   1.0.4  drop superfluous exists for $opts
# 2019-07-08  1180   1.0.3  BUGFIX in rlmax calculation; add -v option
# 2018-12-18  1089   1.0.2  add and use bailout
# 2015-06-03   686   1.0.1  add print_usage; cleanups
# 2015-05-24   684   1.0    Initial version
#
# Expand a simh tape container file (.tap) to a set of files
#
# Usage:  tap2file [--pref=pref] file
#
use 5.14.0;                                 # require Perl 5.14 or higher
use strict;                                 # require strict checking

use Getopt::Long;

my %opts = ();

GetOptions(\%opts, "pref=s", "v", "help")
  or bailout("bad command options");

if (scalar(@ARGV) == 0 || $opts{help}) {
  print_usage();
  exit 0;
}

my $ifile = shift @ARGV;
exit 0 unless defined $ifile;

open(IFILE, "<$ifile") or bailout("Can't open '$ifile': $!");

my $basename = $ifile;
$basename = $1 if $ifile =~ m|.*/(.*)|;
my $fstem = $basename;
$fstem = $1 if $basename =~ m|(.*)\..*|;

my $pref = (exists $opts{pref}) ? $opts{pref} : "${fstem}_";

my $nfile = 0;
my $nrec  = 0;
my $rlmin = 0;
my $rlmax = 0;
my $ofile = "";

my $block;
my $nb;

while ($nb = read(IFILE, $block, 4)) {
  my $metabeg = unpack("V", $block);

  if ($metabeg == 0x00000000) {
    printf "%4d,%5d : ---EOF---\n",$nfile,$nrec if $opts{v};
    close_ofile();
    $nfile += 1;
    next;
  }
  if ($metabeg == 0xffffffff) {
    printf "%4d,%5d : ---EOT---\n",$nfile,$nrec if $opts{v};
    last;
  }

  unless (defined fileno OFILE) {
    $ofile = sprintf("%s%02d.dat", $pref,$nfile);
    open(OFILE, ">$ofile") or bailout("Can't open '$ofile': $!");
  }

  $nb = read(IFILE, $block, $metabeg);
  print OFILE $block;
  if ($nrec == 0) {
    $rlmin = $metabeg;
    $rlmax = $metabeg;
  } else {
    $rlmin = $metabeg if $metabeg < $rlmin;
    $rlmax = $metabeg if $metabeg > $rlmax;
  }
  if ($opts{v}) {
    printf "%4d,%5d : %6d :",$nfile,$nrec,$metabeg;
    foreach (unpack("C16", $block)) {printf " %2.2x", $_};
    print " ..." if $metabeg > 16;
    print "\n";
  }
  $nrec += 1;

  $nb = read(IFILE, $block, 4);
  my $metaend = unpack("V", $block);
  if ($nb != 4 || not defined $metaend) {
    printf "bad meta tag:  beg=%8.8x\n", $metabeg;
    last;
  }
  if ($metaend != $metabeg) {
    printf "bad meta tags: beg=%8.8x end=%8.8x\n", $metabeg,$metaend;
    last;
  }
}

close_ofile();
exit 0;

# ----------------------------------------------------------------------------
sub close_ofile {
  return unless (defined fileno OFILE);
  close(OFILE);
  if ($rlmin == $rlmax) {
    printf "%s: %6d records, length %5d\n",
    $ofile, $nrec, $rlmin;
  } else {
    printf "%s: %6d records, length min=%5d, max=%5d\n",
    $ofile, $nrec, $rlmin, $rlmax;
  }
  $nrec  = 0;
  $rlmin = 0;
  $rlmax = 0;
}

#-------------------------------------------------------------------------------

sub bailout {
  my ($msg) = @_;
  print STDERR "tap2file-F: $msg\n";
  exit 1;
}

# ----------------------------------------------------------------------------
sub print_usage {
  print "usage: tap2file [options] ifile\n";
  print "  ifile    input tap file\n";
  print "  Options\n";
  print "    --pref=p     use p as prefix for generated files\n";
  print "    --v          verbose, trace each record\n";
  print "    --help       this message\n";
}