package Language::INTERCAL::Distribute;

# Create dd/sh distribution

# This file is part of CLC-INTERCAL

# Copyright (c) 2006-2008 Claudio Calvelli, all rights reserved.

# CLC-INTERCAL is copyrighted software. However, permission to use, modify,
# and distribute it is granted provided that the conditions set out in the
# licence agreement are met. See files README and COPYING in the distribution.

use strict;
use vars qw($VERSION $PERVERSION);
my $preversion;
($preversion, $VERSION) = ($PERVERSION = "CLC-INTERCAL/Base INTERCAL/Distribute.pm 1.-94.-2") =~ /^(.*\s)(\S+)$/;

sub makeddshdist {
    @ARGV == 4 or die "Usage: makeddshdist TYPE FILELIST DISTFILE VERSION\n";
    my ($type, $manifest, $distfile, $version) = @ARGV;

    my $dtype = $type eq '' ? '' : "-$type";
    my $stype = $type eq '' ? '' : "/$type";
    open(MANIFEST, $manifest) or die "$manifest: $!\n";
    my @files = ();
    my $delim = "EOF";
    while (<MANIFEST>) {
	chomp;
	next if /^META\.yml/; # crap added by Makefile.PL
	s/\s+\S+$//;
	-e $_;
	my $x = -s _;
	push @files, [$_, $x];
	open (FILE, $_);
	local $/ = undef;
	my $f = <FILE>;
	$delim .= 'X' while $f =~ /$delim/;
	close FILE;
    }
    close MANIFEST;

    my $preskip = length($preversion);

    my $header = <<EOF;
#!/bin/sh

# THIS DD/SH PROGRAM IS A SELF-UNPACKING ARCHIVE - JUST RUN IT WITH:
#	sh $distfile
# NOTE THAT THE PROGRAM ASSUMES THAT ITS OWN SOURCE CODE IS SEEKABLE: IF
# RUNNING FROM A COMPRESSED DISTRIBUTION UNCOMPRESS FIRST

STYPE='$stype'
DTYPE='$dtype'
PERVERSION='CLC-INTERCAL$stype distribution $version'
VERSION='$version'

dd 2>/dev/null <<E
Unpacking CLC-INTERCAL\$STYPE \$VERSION...
E

exec 3<"\$0"
dd of=/dev/null bs=XXXXXXXX count=1 <&3 2>/dev/null

EOF

    my %path_made = ();
    for my $f (@files) {
	my ($name, $size) = @$f;
	$name = 'CLC-INTERCAL$DTYPE-$VERSION/' . $name;
	my @name = split('/+', $name);
	pop @name;
	my $dir = '';
	while (@name) {
	    $dir .= '/' if $dir ne '';
	    $dir .= shift @name;
	    next if exists $path_made{$dir};
	    $header .= "dd 2>/dev/null <<E\n";
	    $header .= "$dir/\n";
	    $header .= "E\n";
	    $header .= "mkdir \"$dir\"\n";
	    $path_made{$dir} = 1;
	}
	$header .= "dd 2>/dev/null <<E\n";
	$header .= "$name\n";
	$header .= "E\n";
	$header .= "dd of=\"$name\" bs=$size count=1 <&3 2>&1 | grep -v '[0-9] record' | grep -v 'bytes.*copied'\n";
	$header .= "\n";
    }

    $header .= "exit 0\n\ndd of=/dev/null 2>/dev/null <<$delim\n";

    my $n = length($header);
    $n .= ' ' x (8 - length($n));
    $header =~ s/XXXXXXXX/$n/;

    open(DEST, "> $distfile") or die "$distfile: $!\n";

    print DEST $header or die "$distfile: $!\n";

    for my $f (@files) {
	my ($name, $size) = @$f;
	open(NAME, $name) or die "$name: $!\n";
	my $b;
	my $sz = 0;
	while (read NAME, $b, 4096) {
	    print DEST $b or die "$distfile: $!\n";
	    $sz += length($b);
	}
	close NAME;
	$sz == $size or die "$name: size $size -> $sz\n";
    }

    print DEST "$delim\n" or die "$distfile: $!\n";
    close DEST or die "$distfile: $!\n";
}