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 / kitpost
1 #!/usr/bin/perl
2         eval "exec perl -S $0 $*"
3                 if $running_under_some_shell;
4
5 # $Id: kitpost.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 # $Log: kitpost.SH,v $
16 # Revision 3.0.1.2  1994/10/29  15:48:26  ram
17 # patch36: don't use rootid as a variable, it is known by metaconfig
18 #
19 # Revision 3.0.1.1  1994/05/06  13:54:53  ram
20 # patch23: created
21 #
22
23 $inews='inews';
24 $mailer='/usr/sbin/sendmail';
25 $orgname='PROCURA B.V.';
26 $version = '3.5';
27 $patchlevel = '0';
28
29 $progname = &profile;   # Read ~/.dist_profile
30 require 'getopts.pl';
31 &usage unless $#ARGV >= 0;
32 &usage unless &Getopts("hrVm:D:H:");
33
34 if ($opt_V) {
35         print STDERR "$progname $version PL$patchlevel\n";
36         exit 0;
37 } elsif ($opt_h) {
38         &usage;
39 }
40
41 $RCSEXT = ',v' unless $RCSEXT;
42 if ($inews eq 'inews') {
43         $inews = '/usr/lib/news/inews' if -f '/usr/lib/news/inews';
44 }
45
46 chdir '..' if -d '../bugs';
47
48 &readpackage;
49
50 $orgname = &tilda_expand($orgname);
51 chop($orgname = `cat $orgname`) if $orgname =~ m|^/|;
52
53 if ($opt_r) {
54         $repost = ' (REPOST)';
55 }
56
57 while ($_ = shift) {
58         if (/^(kit)?[1-9][\d\-]*$/) {
59                 s/^kit//;
60                 push(@argv,$_);
61         } else {
62                 push(@ngroups,$_);
63         }
64 }
65 $ngroups = join(',',@ngroups) unless $#ngroups < 0;
66 $dest = $opt_m;
67 &usage unless $ngroups || $dest;
68
69 @ARGV = @argv;
70
71 if (-f "$package.kit10") {
72         @filelist = <$package.kit[0-9][0-9]>;
73 }
74 else {
75         @filelist = <$package.kit[0-9]>;
76 }
77 pop(@filelist) =~ /(\d+)$/ && ($maxnum = $1 + 0);
78
79 if ($#ARGV < 0) {
80         $argv = "1-$maxnum";
81         @ARGV = $argv;
82 }
83
84 $argv = &rangeargs(@ARGV);
85 @ARGV = split(' ', $argv);
86
87 $argv =~ s/ $//;
88
89 if ($#ARGV < 0) {
90         print STDERR "$progname: no kits specified.\n";
91         &usage;
92 } else {
93         local($s) = $#ARGV ? 's' : '';
94         print "$progname: posting $package $baserev kit$s $argv to $ngroups...\n"
95                 if $ngroups;
96         print "$progname: mailing $package $baserev kit$s $argv to $dest...\n"
97                 if $dest;
98 }
99
100 $desc = "$opt_D, " if $opt_D;
101
102 fork && exit;
103
104 # Compute a suitable root message ID that all parts will reference, so that
105 # threaded news readers will correctly process them.
106 # Unfortunately, this works only when all kits are sent.
107 ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
108         localtime(time);
109 $mon++;
110 $rootmid = "$year$mon$mday$hour$min$sec.AA$$";
111 $first = $maxnum >= 10 ? "01" : "1";
112 $rootmsgid = "<$rootmid.P$first.$maintloc>";
113
114 until ($#ARGV < 0) {
115         $kitnum = shift;
116         $kitnum = "0$kitnum" if $kitnum < 10 && $maxnum >= 10;
117         open(FILE, "$package.kit$kitnum") ||
118                 die "$progname: can't open $package.kit$kitnum: $!\n";
119         if ($ngroups) {
120                 open(INEWS,"|$inews -h") || die "$progname: can't fork $inews: $!\n";
121         }
122         if ($dest) {
123                 $opt = '-odq' if $mailer =~ /sendmail/;
124                 $dest =~ s/,/ /g;
125                 ($to = $dest) =~ s/\s+/, /g;
126                 open(MAILER,"|$mailer $opt $dest") ||
127                         die "$progname: can't fork $mailer: $!\n";
128         }
129
130         $msg_id = "<$rootmid.P$kitnum.$maintloc>";
131         $msg_id = $rootmsgid if $kitnum == 1;
132         $msg_id .= "\nReferences: $rootmsgid" if $kitnum != 1;
133
134         print INEWS "Newsgroups: $ngroups\n";
135         print MAILER "To: $to\n";
136 $head = <<EOH;
137 Subject: $package $baserev - ${desc}part$kitnum/$maxnum$repost
138 Message-ID: $msg_id
139 Organization: $orgname
140
141 Submitted-by: $maintname <$maintloc>
142 Archive-name: $package-$baserev/part$kitnum
143 Environment: UNIX
144
145 EOH
146         print INEWS $head;
147         print MAILER $head;
148
149         if ($kitnum == 1 && $opt_H) {
150                 open(HEAD, $opt_H) || warn "$progname: can't open $opt_H: $!\n";
151                 while (<HEAD>) {
152                         print INEWS;
153                         print MAILER;
154                 }
155                 close HEAD;
156         }
157
158         while (<FILE>) {
159                 print INEWS;
160                 print MAILER;
161         }
162         close FILE;
163         close INEWS;
164         die "$progname: could not post part$kitnum.\n" if $ngroups && $?;
165         close MAILER;
166         die "$progname: could not send part$kitnum.\n" if $dest && $?;
167 }
168
169 sub usage {
170         print STDERR <<EOM;
171 Usage: $progname [-hrV] [-H file] [-D desc] [-m dest1,dest2] [kits] [newsgroups]
172   -h : print this message and exit
173   -m : set-up recipients for (additional) mailing
174   -r : signals a repost
175   -D : specify description string for subject line
176   -H : specify file to be used as header for first part
177   -V : print version number and exit
178 EOM
179         exit 1;
180 }
181
182 sub rangeargs {
183         local($result) = '';
184         local($min,$max,$_);
185         while ($#_ >= 0) {
186                 $_ = shift(@_);
187                 while (/^\s*\d/) {
188                         s/^\s*(\d+)//;
189                         $min = $1;
190                         if (s/^,//) {
191                                 $max = $min;
192                         }
193                         elsif (s/^-(\d*)//) {
194                                 $max = $1;
195                                 if ($max == 0 && $maxnum) {
196                                         $max = $maxnum;
197                                 }
198                                 s/^[^,],?//;
199                         }
200                         else {
201                                 $max = $min;
202                         }
203                         for ($i = $min; $i <= $max; ++$i) {
204                                 $result .= $i . ' ';
205                         }
206                 }
207         }
208         $result;
209 }
210
211 sub readpackage {
212         if (! -f '.package') {
213                 if (
214                         -f '../.package' ||
215                         -f '../../.package' ||
216                         -f '../../../.package' ||
217                         -f '../../../../.package'
218                 ) {
219                         die "Run in top level directory only.\n";
220                 } else {
221                         die "No .package file!  Run packinit.\n";
222                 }
223         }
224         open(PACKAGE,'.package');
225         while (<PACKAGE>) {
226                 next if /^:/;
227                 next if /^#/;
228                 if (($var,$val) = /^\s*(\w+)=(.*)/) {
229                         $val = "\"$val\"" unless $val =~ /^['"]/;
230                         eval "\$$var = $val;";
231                 }
232         }
233         close PACKAGE;
234 }
235
236 # Perform ~name expansion ala ksh...
237 # (banish csh from your vocabulary ;-)
238 sub tilda_expand {
239         local($path) = @_;
240         return $path unless $path =~ /^~/;
241         $path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e;                    # ~name
242         $path =~ s:^~:$ENV{'HOME'} || (getpwuid($<))[$[+7]:e;   # ~
243         $path;
244 }
245
246 # Set up profile components into %Profile, add any profile-supplied options
247 # into @ARGV and return the command invocation name.
248 sub profile {
249         local($profile) = &tilda_expand($ENV{'DIST'} || '~/.dist_profile');
250         local($me) = $0;                # Command name
251         $me =~ s|.*/(.*)|$1|;   # Keep only base name
252         return $me unless -s $profile;
253         local(*PROFILE);                # Local file descriptor
254         local($options) = '';   # Options we get back from profile
255         unless (open(PROFILE, $profile)) {
256                 warn "$me: cannot open $profile: $!\n";
257                 return;
258         }
259         local($_);
260         local($component);
261         while (<PROFILE>) {
262                 next if /^\s*#/;        # Skip comments
263                 next unless /^$me/o;
264                 if (s/^$me://o) {       # progname: options
265                         chop;
266                         $options .= $_; # Merge options if more than one line
267                 }
268                 elsif (s/^$me-([^:]+)://o) {    # progname-component: value
269                         $component = $1;
270                         chop;
271                         s/^\s+//;               # Trim leading and trailing spaces
272                         s/\s+$//;
273                         $Profile{$component} = $_;
274                 }
275         }
276         close PROFILE;
277         return unless $options;
278         require 'shellwords.pl';
279         local(@opts);
280         eval '@opts = &shellwords($options)';   # Protect against mismatched quotes
281         unshift(@ARGV, @opts);
282         return $me;                             # Return our invocation name
283 }
284