Mercurial > repo
view interps/clc-intercal/CLC-INTERCAL-Base-1.-94.-2/INTERCAL/Distribute.pm @ 12511:1c41c70a24da draft default tip
<int-e> mkx ../bin/tio//<<<"$@" sed \'s=.*##==\' | tr @- ++ | base64 -d 2>/dev/null | cat <(printf "\\x1f\\x8b\\x08\\x00\\x00\\x00\\x00\\x00\\x00\\x00") - | gzip -dq 2>/dev/null | LC_CTYPE=C sed -zE \'s=.*\\xFF\\xFF(.*)\\xFF\\xFF.*=\\1=\'
author | HackEso <hackeso@esolangs.org> |
---|---|
date | Sun, 04 Aug 2024 19:18:25 +0100 |
parents | 859f9b4339e6 |
children |
line wrap: on
line source
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"; }