This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Also add all utilities for building from units to repo
[metaconfig.git] / bin / kitsend
1 #!/usr/bin/perl
2         eval 'exec perl -S $0 "$@"'
3                 if $running_under_some_shell;
4
5 # $Id: kitsend.SH 1 2006-08-24 12:32:52Z rmanfredi $
6 #
7 #  Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi
8 #  
9 #  You may redistribute only under the terms of the Artistic Licence,
10 #  as specified in the README file that comes with the distribution.
11 #  You may reuse parts of this distribution only within the terms of
12 #  that same Artistic Licence; a copy of which may be found at the root
13 #  of the source tree for dist 4.0.
14 #
15 # Original Author: Harlan Stenn <harlan@mumps.pfcs.com>
16 #
17 # $Log: kitsend.SH,v $
18 # Revision 3.0.1.2  1994/05/06  13:59:57  ram
19 # patch23: random code cleanup to follow pat tools style
20 # patch23: made configurable from dist profile
21 # patch23: now understands -V and -h options
22 # patch23: mails now flagged with a bulk precedence
23 # patch23: added X-Mailer header and now calls mailer via open()
24 #
25 # Revision 3.0.1.1  1993/08/19  06:42:15  ram
26 # patch1: leading config.sh searching was not aborting properly
27 #
28 # Revision 3.0  1993/08/18  12:04:25  ram
29 # Baseline for dist 3.0 netwide release.
30 #
31
32 $orgname='PROCURA B.V.';
33 $mailer='/usr/sbin/sendmail';
34 $version = '3.5';
35 $patchlevel = '0';
36
37 $progname = &profile;           # Read ~/.dist_profile
38 require 'getopts.pl';
39 &usage unless &Getopts('hV');
40
41 if ($opt_V) {
42         print STDERR "$progname $version PL$patchlevel\n";
43         exit 0;
44 } elsif ($opt_h) {
45         &usage;
46 }
47
48 $orgname = &tilda_expand($orgname);
49 chop($orgname = `cat $orgname`) if $orgname =~ m|^/|;
50
51 &readpackage;
52
53 while ($_ = shift) {
54         if (/^(kit)?[1-9][\d,-]*$/) {
55                 s/^kit//;
56                 push(@argv, $_);
57         }
58         else {
59                 push(@dest, $_);
60         }
61 }
62 $dest = join(' ',@dest);
63 &usage unless $dest;
64
65 @ARGV = @argv;
66
67 if (-f "$package.kit10") {
68         @filelist = <$package.kit[0-9][0-9]>;
69 }
70 else {
71         @filelist = <$package.kit[0-9]>;
72 }
73 pop(@filelist) =~ /(\d+)$/ && ($maxnum = $1 + 0);
74
75 if ($#ARGV < 0) {
76         $argv = "1-$maxnum";
77         @ARGV = $argv;
78 }
79 $argv = &rangeargs(@ARGV);
80 @ARGV = split(' ', $argv);
81
82 $argv =~ s/ $//;
83
84 if ($#ARGV < 0) {
85         die "$progname: no kits specified.\n";
86 } elsif ($#ARGV) {
87         print "$progname: sending $package $baserev kits $argv to $dest...\n";
88 } else {
89         print "$progname: sending $package $baserev kit $argv to $dest...\n";
90 }
91
92 fork && exit;
93
94 $opt = '-odq' if $mailer =~ /sendmail/;
95
96 until ($#ARGV < 0) {
97         $kitnum = shift;
98
99         # Provision for broken mailers...
100         @dest = split(' ', $dest);
101         while (@smalldest = splice(@dest, 0, 50)) {
102                 $to = join(', ', @smalldest);   # Sensible To: for sendmail
103                 $smalldest = join(' ', @smalldest);
104
105                 open(MAILER, "|$mailer $opt $smalldest") ||
106                         die "$progname: can't fork $mailer: $!\n";
107                 print MAILER
108 "To: $to
109 Subject: $package $baserev kit #$kitnum
110 Precedence: bulk
111 X-Mailer: dist [version $version PL$patchlevel]
112 Organization: $orgname
113
114 [There are $maxnum kits for $package version $baserev.]
115
116 ";
117                 $kitnum = "0$kitnum" if $kitnum < 10 && $maxnum >= 10;
118                 open(FILE,"$package.kit$kitnum") ||
119                         die "$progname: can't open $package.kit$kitnum: $!\n";
120                 while (<FILE>) {
121                         print MAILER;
122                 }
123                 close FILE;
124                 close MAILER;
125                 warn "$progname: ERROR mailing of $package.kit$kitnum to $dest\n" if $?;
126         }
127 }
128
129 sub usage {
130         print STDERR <<EOM;
131 Usage: $progname [-hV] [kits] dest
132   -h : print this message and exit
133   -V : print version number and exit
134 EOM
135         exit 1;
136 }
137
138 sub rangeargs {
139         local($result) = '';
140         local($min,$max,$_);
141         while ($#_ >= 0) {
142                 $_ = shift(@_);
143                 while (/^\s*\d/) {
144                         s/^\s*(\d+)//;
145                         $min = $1;
146                         if (s/^,//) {
147                                 $max = $min;
148                         }
149                         elsif (s/^-(\d*)//) {
150                                 $max = $1;
151                                 if ($max == 0 && $maxnum) {
152                                         $max = $maxnum;
153                                 }
154                                 s/^[^,],?//;
155                         }
156                         else {
157                                 $max = $min;
158                         }
159                         for ($i = $min; $i <= $max; ++$i) {
160                                 $result .= $i . ' ';
161                         }
162                 }
163         }
164         $result;
165 }
166
167 sub readpackage {
168         if (! -f '.package') {
169                 if (
170                         -f '../.package' ||
171                         -f '../../.package' ||
172                         -f '../../../.package' ||
173                         -f '../../../../.package'
174                 ) {
175                         die "Run in top level directory only.\n";
176                 } else {
177                         die "No .package file!  Run packinit.\n";
178                 }
179         }
180         open(PACKAGE,'.package');
181         while (<PACKAGE>) {
182                 next if /^:/;
183                 next if /^#/;
184                 if (($var,$val) = /^\s*(\w+)=(.*)/) {
185                         $val = "\"$val\"" unless $val =~ /^['"]/;
186                         eval "\$$var = $val;";
187                 }
188         }
189         close PACKAGE;
190 }
191
192 # Perform ~name expansion ala ksh...
193 # (banish csh from your vocabulary ;-)
194 sub tilda_expand {
195         local($path) = @_;
196         return $path unless $path =~ /^~/;
197         $path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e;                    # ~name
198         $path =~ s:^~:$ENV{'HOME'} || (getpwuid($<))[$[+7]:e;   # ~
199         $path;
200 }
201
202 # Set up profile components into %Profile, add any profile-supplied options
203 # into @ARGV and return the command invocation name.
204 sub profile {
205         local($profile) = &tilda_expand($ENV{'DIST'} || '~/.dist_profile');
206         local($me) = $0;                # Command name
207         $me =~ s|.*/(.*)|$1|;   # Keep only base name
208         return $me unless -s $profile;
209         local(*PROFILE);                # Local file descriptor
210         local($options) = '';   # Options we get back from profile
211         unless (open(PROFILE, $profile)) {
212                 warn "$me: cannot open $profile: $!\n";
213                 return;
214         }
215         local($_);
216         local($component);
217         while (<PROFILE>) {
218                 next if /^\s*#/;        # Skip comments
219                 next unless /^$me/o;
220                 if (s/^$me://o) {       # progname: options
221                         chop;
222                         $options .= $_; # Merge options if more than one line
223                 }
224                 elsif (s/^$me-([^:]+)://o) {    # progname-component: value
225                         $component = $1;
226                         chop;
227                         s/^\s+//;               # Trim leading and trailing spaces
228                         s/\s+$//;
229                         $Profile{$component} = $_;
230                 }
231         }
232         close PROFILE;
233         return unless $options;
234         require 'shellwords.pl';
235         local(@opts);
236         eval '@opts = &shellwords($options)';   # Protect against mismatched quotes
237         unshift(@ARGV, @opts);
238         return $me;                             # Return our invocation name
239 }
240