|
996
|
1 package Language::INTERCAL::Distribute;
|
|
|
2
|
|
|
3 # Create dd/sh distribution
|
|
|
4
|
|
|
5 # This file is part of CLC-INTERCAL
|
|
|
6
|
|
|
7 # Copyright (c) 2006-2008 Claudio Calvelli, all rights reserved.
|
|
|
8
|
|
|
9 # CLC-INTERCAL is copyrighted software. However, permission to use, modify,
|
|
|
10 # and distribute it is granted provided that the conditions set out in the
|
|
|
11 # licence agreement are met. See files README and COPYING in the distribution.
|
|
|
12
|
|
|
13 use strict;
|
|
|
14 use vars qw($VERSION $PERVERSION);
|
|
|
15 my $preversion;
|
|
|
16 ($preversion, $VERSION) = ($PERVERSION = "CLC-INTERCAL/Base INTERCAL/Distribute.pm 1.-94.-2") =~ /^(.*\s)(\S+)$/;
|
|
|
17
|
|
|
18 sub makeddshdist {
|
|
|
19 @ARGV == 4 or die "Usage: makeddshdist TYPE FILELIST DISTFILE VERSION\n";
|
|
|
20 my ($type, $manifest, $distfile, $version) = @ARGV;
|
|
|
21
|
|
|
22 my $dtype = $type eq '' ? '' : "-$type";
|
|
|
23 my $stype = $type eq '' ? '' : "/$type";
|
|
|
24 open(MANIFEST, $manifest) or die "$manifest: $!\n";
|
|
|
25 my @files = ();
|
|
|
26 my $delim = "EOF";
|
|
|
27 while (<MANIFEST>) {
|
|
|
28 chomp;
|
|
|
29 next if /^META\.yml/; # crap added by Makefile.PL
|
|
|
30 s/\s+\S+$//;
|
|
|
31 -e $_;
|
|
|
32 my $x = -s _;
|
|
|
33 push @files, [$_, $x];
|
|
|
34 open (FILE, $_);
|
|
|
35 local $/ = undef;
|
|
|
36 my $f = <FILE>;
|
|
|
37 $delim .= 'X' while $f =~ /$delim/;
|
|
|
38 close FILE;
|
|
|
39 }
|
|
|
40 close MANIFEST;
|
|
|
41
|
|
|
42 my $preskip = length($preversion);
|
|
|
43
|
|
|
44 my $header = <<EOF;
|
|
|
45 #!/bin/sh
|
|
|
46
|
|
|
47 # THIS DD/SH PROGRAM IS A SELF-UNPACKING ARCHIVE - JUST RUN IT WITH:
|
|
|
48 # sh $distfile
|
|
|
49 # NOTE THAT THE PROGRAM ASSUMES THAT ITS OWN SOURCE CODE IS SEEKABLE: IF
|
|
|
50 # RUNNING FROM A COMPRESSED DISTRIBUTION UNCOMPRESS FIRST
|
|
|
51
|
|
|
52 STYPE='$stype'
|
|
|
53 DTYPE='$dtype'
|
|
|
54 PERVERSION='CLC-INTERCAL$stype distribution $version'
|
|
|
55 VERSION='$version'
|
|
|
56
|
|
|
57 dd 2>/dev/null <<E
|
|
|
58 Unpacking CLC-INTERCAL\$STYPE \$VERSION...
|
|
|
59 E
|
|
|
60
|
|
|
61 exec 3<"\$0"
|
|
|
62 dd of=/dev/null bs=XXXXXXXX count=1 <&3 2>/dev/null
|
|
|
63
|
|
|
64 EOF
|
|
|
65
|
|
|
66 my %path_made = ();
|
|
|
67 for my $f (@files) {
|
|
|
68 my ($name, $size) = @$f;
|
|
|
69 $name = 'CLC-INTERCAL$DTYPE-$VERSION/' . $name;
|
|
|
70 my @name = split('/+', $name);
|
|
|
71 pop @name;
|
|
|
72 my $dir = '';
|
|
|
73 while (@name) {
|
|
|
74 $dir .= '/' if $dir ne '';
|
|
|
75 $dir .= shift @name;
|
|
|
76 next if exists $path_made{$dir};
|
|
|
77 $header .= "dd 2>/dev/null <<E\n";
|
|
|
78 $header .= "$dir/\n";
|
|
|
79 $header .= "E\n";
|
|
|
80 $header .= "mkdir \"$dir\"\n";
|
|
|
81 $path_made{$dir} = 1;
|
|
|
82 }
|
|
|
83 $header .= "dd 2>/dev/null <<E\n";
|
|
|
84 $header .= "$name\n";
|
|
|
85 $header .= "E\n";
|
|
|
86 $header .= "dd of=\"$name\" bs=$size count=1 <&3 2>&1 | grep -v '[0-9] record' | grep -v 'bytes.*copied'\n";
|
|
|
87 $header .= "\n";
|
|
|
88 }
|
|
|
89
|
|
|
90 $header .= "exit 0\n\ndd of=/dev/null 2>/dev/null <<$delim\n";
|
|
|
91
|
|
|
92 my $n = length($header);
|
|
|
93 $n .= ' ' x (8 - length($n));
|
|
|
94 $header =~ s/XXXXXXXX/$n/;
|
|
|
95
|
|
|
96 open(DEST, "> $distfile") or die "$distfile: $!\n";
|
|
|
97
|
|
|
98 print DEST $header or die "$distfile: $!\n";
|
|
|
99
|
|
|
100 for my $f (@files) {
|
|
|
101 my ($name, $size) = @$f;
|
|
|
102 open(NAME, $name) or die "$name: $!\n";
|
|
|
103 my $b;
|
|
|
104 my $sz = 0;
|
|
|
105 while (read NAME, $b, 4096) {
|
|
|
106 print DEST $b or die "$distfile: $!\n";
|
|
|
107 $sz += length($b);
|
|
|
108 }
|
|
|
109 close NAME;
|
|
|
110 $sz == $size or die "$name: size $size -> $sz\n";
|
|
|
111 }
|
|
|
112
|
|
|
113 print DEST "$delim\n" or die "$distfile: $!\n";
|
|
|
114 close DEST or die "$distfile: $!\n";
|
|
|
115 }
|
|
|
116
|
