/usr/share/perl5/Language/INTERCAL/Distribute.pm is in clc-intercal 1:1.0~4pre1.-94.-2-4.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 | 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";
}
|