Subversion Repositories w11

#!/usr/bin/perl -w

# $Id: tap2file 686 2015-06-04 21:08:08Z mueller $

#

# Copyright 2015- by Walter F.J. Mueller 

#

# This program is free software; you may redistribute and/or modify it under

# the terms of the GNU General Public License as published by the Free

# Software Foundation, either version 2, or at your option 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 complete details.

#

#  Revision History:

# Date         Rev Version  Comment

# 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", "help")

  or die "bad options";

sub close_ofile;

sub print_usage;

if (scalar(@ARGV) == 0 || exists $opts{help}) {

  print_usage;

  exit 0;

}

my $ifile = shift @ARGV;

exit 0 unless defined $ifile;

open(IFILE, "<$ifile") || die("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) {

    close_ofile;

    $nfile += 1;

    next;

  }

  if ($metabeg == 0xffffffff) {

    last;

  }

  unless (defined fileno OFILE) {

    $ofile = sprintf("%s%02d.dat", $pref,$nfile);

    open(OFILE, ">$ofile") || die("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 > $rlmin;

  }

  $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 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 "    --help       this message\n";

}