#!/usr/local/bin/perl
##########################################################################
# Simple little perl script (perl 5 or better) to set uqlx data sizes for
# QDOS executables from Unix. Features automatic recognition of xtc68 data
# space. If you give an outfile/path, the infile is copied.
#
# Install somewhere on your path (i.e. /usr/local/bin) and chmod +x qcp
# 
# qcp [-x data_space] infile [outfile]
#
# You should give one of -x data or outfile.
#
# qcp -x 1776 /QL/exe/gs                (set gs data size)
# qcp ~/develop/qdos/gs262/gs /QL/exe   (copy and set data size for xtc68 image)
#
# n.b. symbolic links are very useful to reduce unix file names to meet
#      QDOS restrictions
# totally not (c) Jonathan Hudson
###########################################################################
require 5.000;
use Getopt::Std;
use POSIX;
use File::Basename;

getopts('x:');
($infile, $outfile) = @ARGV;

die "\$ xheader [-x datasize] infile [outpath]" 
    unless ($infile and ($outfile or $opt_x));

do
{ 
    my ($xtcc, $flag, $xlen);
    open(INF, $infile) || die;

    seek(INF, -8, SEEK_END);
    read INF, $xtcc, 8;
    ($flag,$xlen) = unpack "a4N", $xtcc;
    $opt_x = $xlen if ($flag eq 'XTcc');
    close INF;
} unless $opt_x;

if ($outfile)
{
    if(-d $outfile)
    {
	$dir = $outfile;
	$onam = basename ($infile);
    }
    else
    {
	($onam, $dir) = fileparse ($outfile);
    }
}
else
{
    ($onam, $dir) = fileparse ($infile);
}

$dir .= "/"  unless ($dir =~ /\/$/);

$outspec= $dir.$onam;
$secret = $dir .  ".-UQLX-";

if(-e $secret)
{
    open(UQLX, "+<$secret") || die "Secret dir: $!";

    for ($gotya = 0; !$gotya and (read (UQLX,$rec,64) == 64); )
    {
	($len,$access,$type,$dlen,$spare,$nlen,$name) = unpack "NccNNnA36",$rec;
	if($name eq $onam)
	{
	    seek UQLX, -64, SEEK_CUR;
	    $gotya = 1;
	}
    }
}
else
{
    open(UQLX, ">$secret") || die "Secret dir: $!";
}

$type = 1;
$dlen = $opt_x;
$len = 0x00000001;
$nlen = length($onam);

$rec = pack "NccNNna36\@64", $len,$access,$type,$dlen,$spare,$nlen,$onam;
syswrite UQLX,$rec,64;
close UQLX;

system "cp $infile $outspec" if $outfile;

